From 90926211445ad701514bb0e7ff5133d156d5454c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 Apr 2024 10:12:33 +0200 Subject: [PATCH 1/3] refactor comments for FORD --- src/stdlib_linalg_blas.fypp | 178 +- src/stdlib_linalg_blas_aux.fypp | 34 +- src/stdlib_linalg_blas_c.fypp | 184 +- src/stdlib_linalg_blas_d.fypp | 190 +-- src/stdlib_linalg_blas_q.fypp | 140 +- src/stdlib_linalg_blas_s.fypp | 192 +-- src/stdlib_linalg_blas_w.fypp | 130 +- src/stdlib_linalg_blas_z.fypp | 182 +- src/stdlib_linalg_lapack.fypp | 1934 ++++++++++----------- src/stdlib_linalg_lapack_aux.fypp | 122 +- src/stdlib_linalg_lapack_c.fypp | 2554 ++++++++++++++-------------- src/stdlib_linalg_lapack_d.fypp | 2642 ++++++++++++++--------------- src/stdlib_linalg_lapack_q.fypp | 1852 ++++++++++---------- src/stdlib_linalg_lapack_s.fypp | 2618 ++++++++++++++-------------- src/stdlib_linalg_lapack_w.fypp | 1792 +++++++++---------- src/stdlib_linalg_lapack_z.fypp | 2574 ++++++++++++++-------------- 16 files changed, 8659 insertions(+), 8659 deletions(-) diff --git a/src/stdlib_linalg_blas.fypp b/src/stdlib_linalg_blas.fypp index 8c5bdb60e..e7327830c 100644 --- a/src/stdlib_linalg_blas.fypp +++ b/src/stdlib_linalg_blas.fypp @@ -15,8 +15,8 @@ module stdlib_linalg_blas implicit none(type,external) public - !> AXPY: constant times a vector plus a vector. interface axpy + !> AXPY constant times a vector plus a vector. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine caxpy(n,ca,cx,incx,cy,incy) import sp,dp,qp,ilp,lk @@ -71,8 +71,8 @@ module stdlib_linalg_blas - !> COPY: copies a vector x to a vector y. interface copy + !> COPY copies a vector x to a vector y. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ccopy(n,cx,incx,cy,incy) import sp,dp,qp,ilp,lk @@ -127,9 +127,9 @@ module stdlib_linalg_blas - !> DOT: forms the dot product of two vectors. - !> uses unrolled loops for increments equal to one. interface dot + !> DOT forms the dot product of two vectors. + !> uses unrolled loops for increments equal to one. #ifdef STDLIB_EXTERNAL_BLAS pure real(dp) function ddot(n,dx,incx,dy,incy) import sp,dp,qp,ilp,lk @@ -157,9 +157,9 @@ module stdlib_linalg_blas - !> DOTC: forms the dot product of two complex vectors - !> DOTC = X^H * Y interface dotc + !> DOTC forms the dot product of two complex vectors + !> DOTC = X^H * Y #ifdef STDLIB_EXTERNAL_BLAS pure complex(sp) function cdotc(n,cx,incx,cy,incy) import sp,dp,qp,ilp,lk @@ -187,9 +187,9 @@ module stdlib_linalg_blas - !> DOTU: forms the dot product of two complex vectors - !> DOTU = X^T * Y interface dotu + !> DOTU forms the dot product of two complex vectors + !> DOTU = X^T * Y #ifdef STDLIB_EXTERNAL_BLAS pure complex(sp) function cdotu(n,cx,incx,cy,incy) import sp,dp,qp,ilp,lk @@ -217,12 +217,12 @@ module stdlib_linalg_blas - !> GBMV: performs one of the matrix-vector operations + interface gbmv + !> GBMV performs one of the matrix-vector operations !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or !> y := alpha*A**H*x + beta*y, !> where alpha and beta are scalars, x and y are vectors and A is an !> m by n band matrix, with kl sub-diagonals and ku super-diagonals. - interface gbmv #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -281,13 +281,13 @@ module stdlib_linalg_blas - !> GEMM: performs one of the matrix-matrix operations + interface gemm + !> GEMM performs one of the matrix-matrix operations !> C := alpha*op( A )*op( B ) + beta*C, !> where op( X ) is one of !> op( X ) = X or op( X ) = X**T or op( X ) = X**H, !> alpha and beta are scalars, and A, B and C are matrices, with op( A ) !> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. - interface gemm #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) import sp,dp,qp,ilp,lk @@ -346,12 +346,12 @@ module stdlib_linalg_blas - !> GEMV: performs one of the matrix-vector operations + interface gemv + !> GEMV performs one of the matrix-vector operations !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or !> y := alpha*A**H*x + beta*y, !> where alpha and beta are scalars, x and y are vectors and A is an !> m by n matrix. - interface gemv #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -410,11 +410,11 @@ module stdlib_linalg_blas - !> GER: performs the rank 1 operation + interface ger + !> GER performs the rank 1 operation !> A := alpha*x*y**T + A, !> where alpha is a scalar, x is an m element vector, y is an n element !> vector and A is an m by n matrix. - interface ger #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dger(m,n,alpha,x,incx,y,incy,a,lda) import sp,dp,qp,ilp,lk @@ -444,11 +444,11 @@ module stdlib_linalg_blas - !> GERC: performs the rank 1 operation + interface gerc + !> GERC performs the rank 1 operation !> A := alpha*x*y**H + A, !> where alpha is a scalar, x is an m element vector, y is an n element !> vector and A is an m by n matrix. - interface gerc #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cgerc(m,n,alpha,x,incx,y,incy,a,lda) import sp,dp,qp,ilp,lk @@ -478,11 +478,11 @@ module stdlib_linalg_blas - !> GERU: performs the rank 1 operation + interface geru + !> GERU performs the rank 1 operation !> A := alpha*x*y**T + A, !> where alpha is a scalar, x is an m element vector, y is an n element !> vector and A is an m by n matrix. - interface geru #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cgeru(m,n,alpha,x,incx,y,incy,a,lda) import sp,dp,qp,ilp,lk @@ -512,11 +512,11 @@ module stdlib_linalg_blas - !> HBMV: performs the matrix-vector operation + interface hbmv + !> HBMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n hermitian band matrix, with k super-diagonals. - interface hbmv #ifdef STDLIB_EXTERNAL_BLAS pure subroutine chbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -548,13 +548,13 @@ module stdlib_linalg_blas - !> HEMM: performs one of the matrix-matrix operations + interface hemm + !> HEMM performs one of the matrix-matrix operations !> C := alpha*A*B + beta*C, !> or !> C := alpha*B*A + beta*C, !> where alpha and beta are scalars, A is an hermitian matrix and B and !> C are m by n matrices. - interface hemm #ifdef STDLIB_EXTERNAL_BLAS pure subroutine chemm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) import sp,dp,qp,ilp,lk @@ -586,11 +586,11 @@ module stdlib_linalg_blas - !> HEMV: performs the matrix-vector operation + interface hemv + !> HEMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n hermitian matrix. - interface hemv #ifdef STDLIB_EXTERNAL_BLAS pure subroutine chemv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -622,11 +622,11 @@ module stdlib_linalg_blas - !> HER: performs the hermitian rank 1 operation + interface her + !> HER performs the hermitian rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n hermitian matrix. - interface her #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cher(uplo,n,alpha,x,incx,a,lda) import sp,dp,qp,ilp,lk @@ -660,11 +660,11 @@ module stdlib_linalg_blas - !> HER2: performs the hermitian rank 2 operation + interface her2 + !> HER2 performs the hermitian rank 2 operation !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, !> where alpha is a scalar, x and y are n element vectors and A is an n !> by n hermitian matrix. - interface her2 #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cher2(uplo,n,alpha,x,incx,y,incy,a,lda) import sp,dp,qp,ilp,lk @@ -696,14 +696,14 @@ module stdlib_linalg_blas - !> HER2K: performs one of the hermitian rank 2k operations + interface her2k + !> HER2K performs one of the hermitian rank 2k operations !> C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C, !> or !> C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C, !> where alpha and beta are scalars with beta real, C is an n by n !> hermitian matrix and A and B are n by k matrices in the first case !> and k by n matrices in the second case. - interface her2k #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cher2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) import sp,dp,qp,ilp,lk @@ -737,14 +737,14 @@ module stdlib_linalg_blas - !> HERK: performs one of the hermitian rank k operations + interface herk + !> HERK performs one of the hermitian rank k operations !> C := alpha*A*A**H + beta*C, !> or !> C := alpha*A**H*A + beta*C, !> where alpha and beta are real scalars, C is an n by n hermitian !> matrix and A is an n by k matrix in the first case and a k by n !> matrix in the second case. - interface herk #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cherk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) import sp,dp,qp,ilp,lk @@ -778,11 +778,11 @@ module stdlib_linalg_blas - !> HPMV: performs the matrix-vector operation + interface hpmv + !> HPMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n hermitian matrix, supplied in packed form. - interface hpmv #ifdef STDLIB_EXTERNAL_BLAS pure subroutine chpmv(uplo,n,alpha,ap,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -814,11 +814,11 @@ module stdlib_linalg_blas - !> HPR: performs the hermitian rank 1 operation + interface hpr + !> HPR performs the hermitian rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n hermitian matrix, supplied in packed form. - interface hpr #ifdef STDLIB_EXTERNAL_BLAS pure subroutine chpr(uplo,n,alpha,x,incx,ap) import sp,dp,qp,ilp,lk @@ -852,11 +852,11 @@ module stdlib_linalg_blas - !> HPR2: performs the hermitian rank 2 operation + interface hpr2 + !> HPR2 performs the hermitian rank 2 operation !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, !> where alpha is a scalar, x and y are n element vectors and A is an !> n by n hermitian matrix, supplied in packed form. - interface hpr2 #ifdef STDLIB_EXTERNAL_BLAS pure subroutine chpr2(uplo,n,alpha,x,incx,y,incy,ap) import sp,dp,qp,ilp,lk @@ -888,12 +888,12 @@ module stdlib_linalg_blas + interface nrm2 !> ! !> - !> NRM2: returns the euclidean norm of a vector via the function + !> NRM2 returns the euclidean norm of a vector via the function !> name, so that !> NRM2 := sqrt( x'*x ) - interface nrm2 #ifdef STDLIB_EXTERNAL_BLAS pure real(dp) function dnrm2( n, x, incx ) import sp,dp,qp,ilp,lk @@ -921,8 +921,8 @@ module stdlib_linalg_blas - !> ROT: applies a plane rotation. interface rot + !> ROT applies a plane rotation. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine drot(n,dx,incx,dy,incy,c,s) import sp,dp,qp,ilp,lk @@ -952,6 +952,7 @@ module stdlib_linalg_blas + interface rotg !> ! !> !> The computation uses the formulas @@ -967,7 +968,6 @@ module stdlib_linalg_blas !> the same as in SROTG when |a| > |b|. When |b| >= |a|, the !> sign of c and s will be different from those computed by SROTG !> if the signs of a and b are not the same. - interface rotg #ifdef STDLIB_EXTERNAL_BLAS pure subroutine crotg( a, b, c, s ) import sp,dp,qp,ilp,lk @@ -1022,6 +1022,7 @@ module stdlib_linalg_blas + interface rotm !> APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX !> (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN !> (DY**T) @@ -1033,7 +1034,6 @@ module stdlib_linalg_blas !> H=( ) ( ) ( ) ( ) !> (DH21 DH22), (DH21 1._dp), (-1._dp DH22), (0._dp 1._dp). !> SEE ROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. - interface rotm #ifdef STDLIB_EXTERNAL_BLAS pure subroutine drotm(n,dx,incx,dy,incy,dparam) import sp,dp,qp,ilp,lk @@ -1063,6 +1063,7 @@ module stdlib_linalg_blas + interface rotmg !> CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS !> THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(DD1)*DX1,SQRT(DD2) DY2)**T. !> WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. @@ -1076,7 +1077,6 @@ module stdlib_linalg_blas !> THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE !> INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE !> OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. - interface rotmg #ifdef STDLIB_EXTERNAL_BLAS pure subroutine drotmg(dd1,dd2,dx1,dy1,dparam) import sp,dp,qp,ilp,lk @@ -1106,11 +1106,11 @@ module stdlib_linalg_blas - !> SBMV: performs the matrix-vector operation + interface sbmv + !> SBMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric band matrix, with k super-diagonals. - interface sbmv #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dsbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -1142,8 +1142,8 @@ module stdlib_linalg_blas - !> SCAL: scales a vector by a constant. interface scal + !> SCAL scales a vector by a constant. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cscal(n,ca,cx,incx) import sp,dp,qp,ilp,lk @@ -1198,13 +1198,13 @@ module stdlib_linalg_blas + interface sdot !> Compute the inner product of two vectors with extended !> precision accumulation and result. !> Returns D.P. dot product accumulated in D.P., for S.P. SX and SY - !> SDOT: = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY), + !> SDOT = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY), !> where LX = 1 if INCX >= 0, else LX = 1+(1-N)*INCX, and LY is !> defined in a similar way using INCY. - interface sdot #ifdef STDLIB_EXTERNAL_BLAS pure real(dp) function dsdot(n,sx,incx,sy,incy) import sp,dp,qp,ilp,lk @@ -1222,11 +1222,11 @@ module stdlib_linalg_blas - !> SPMV: performs the matrix-vector operation + interface spmv + !> SPMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix, supplied in packed form. - interface spmv #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dspmv(uplo,n,alpha,ap,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -1258,11 +1258,11 @@ module stdlib_linalg_blas - !> SPR: performs the symmetric rank 1 operation + interface spr + !> SPR performs the symmetric rank 1 operation !> A := alpha*x*x**T + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n symmetric matrix, supplied in packed form. - interface spr #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dspr(uplo,n,alpha,x,incx,ap) import sp,dp,qp,ilp,lk @@ -1294,11 +1294,11 @@ module stdlib_linalg_blas - !> SPR2: performs the symmetric rank 2 operation + interface spr2 + !> SPR2 performs the symmetric rank 2 operation !> A := alpha*x*y**T + alpha*y*x**T + A, !> where alpha is a scalar, x and y are n element vectors and A is an !> n by n symmetric matrix, supplied in packed form. - interface spr2 #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dspr2(uplo,n,alpha,x,incx,y,incy,ap) import sp,dp,qp,ilp,lk @@ -1330,10 +1330,10 @@ module stdlib_linalg_blas - !> SROT: applies a plane rotation, where the cos and sin (c and s) are real + interface srot + !> SROT applies a plane rotation, where the cos and sin (c and s) are real !> and the vectors cx and cy are complex. !> jack dongarra, linpack, 3/11/78. - interface srot #ifdef STDLIB_EXTERNAL_BLAS pure subroutine csrot( n, cx, incx, cy, incy, c, s ) import sp,dp,qp,ilp,lk @@ -1349,8 +1349,8 @@ module stdlib_linalg_blas - !> SSCAL: scales a complex vector by a real constant. interface sscal + !> SSCAL scales a complex vector by a real constant. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine csscal(n,sa,cx,incx) import sp,dp,qp,ilp,lk @@ -1366,8 +1366,8 @@ module stdlib_linalg_blas - !> SWAP: interchanges two vectors. interface swap + !> SWAP interchanges two vectors. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cswap(n,cx,incx,cy,incy) import sp,dp,qp,ilp,lk @@ -1418,13 +1418,13 @@ module stdlib_linalg_blas - !> SYMM: performs one of the matrix-matrix operations + interface symm + !> SYMM performs one of the matrix-matrix operations !> C := alpha*A*B + beta*C, !> or !> C := alpha*B*A + beta*C, !> where alpha and beta are scalars, A is a symmetric matrix and B and !> C are m by n matrices. - interface symm #ifdef STDLIB_EXTERNAL_BLAS pure subroutine csymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) import sp,dp,qp,ilp,lk @@ -1483,11 +1483,11 @@ module stdlib_linalg_blas - !> SYMV: performs the matrix-vector operation + interface symv + !> SYMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix. - interface symv #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dsymv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -1519,11 +1519,11 @@ module stdlib_linalg_blas - !> SYR: performs the symmetric rank 1 operation + interface syr + !> SYR performs the symmetric rank 1 operation !> A := alpha*x*x**T + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n symmetric matrix. - interface syr #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dsyr(uplo,n,alpha,x,incx,a,lda) import sp,dp,qp,ilp,lk @@ -1555,11 +1555,11 @@ module stdlib_linalg_blas - !> SYR2: performs the symmetric rank 2 operation + interface syr2 + !> SYR2 performs the symmetric rank 2 operation !> A := alpha*x*y**T + alpha*y*x**T + A, !> where alpha is a scalar, x and y are n element vectors and A is an n !> by n symmetric matrix. - interface syr2 #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dsyr2(uplo,n,alpha,x,incx,y,incy,a,lda) import sp,dp,qp,ilp,lk @@ -1591,14 +1591,14 @@ module stdlib_linalg_blas - !> SYR2K: performs one of the symmetric rank 2k operations + interface syr2k + !> SYR2K performs one of the symmetric rank 2k operations !> C := alpha*A*B**T + alpha*B*A**T + beta*C, !> or !> C := alpha*A**T*B + alpha*B**T*A + beta*C, !> where alpha and beta are scalars, C is an n by n symmetric matrix !> and A and B are n by k matrices in the first case and k by n !> matrices in the second case. - interface syr2k #ifdef STDLIB_EXTERNAL_BLAS pure subroutine csyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) import sp,dp,qp,ilp,lk @@ -1657,14 +1657,14 @@ module stdlib_linalg_blas - !> SYRK: performs one of the symmetric rank k operations + interface syrk + !> SYRK performs one of the symmetric rank k operations !> C := alpha*A*A**T + beta*C, !> or !> C := alpha*A**T*A + beta*C, !> where alpha and beta are scalars, C is an n by n symmetric matrix !> and A is an n by k matrix in the first case and a k by n matrix !> in the second case. - interface syrk #ifdef STDLIB_EXTERNAL_BLAS pure subroutine csyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) import sp,dp,qp,ilp,lk @@ -1723,11 +1723,11 @@ module stdlib_linalg_blas - !> TBMV: performs one of the matrix-vector operations + interface tbmv + !> TBMV performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, or x := A**H*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular band matrix, with ( k + 1 ) diagonals. - interface tbmv #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctbmv(uplo,trans,diag,n,k,a,lda,x,incx) import sp,dp,qp,ilp,lk @@ -1786,14 +1786,14 @@ module stdlib_linalg_blas - !> TBSV: solves one of the systems of equations + interface tbsv + !> TBSV solves one of the systems of equations !> A*x = b, or A**T*x = b, or A**H*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular band matrix, with ( k + 1 ) !> diagonals. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - interface tbsv #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctbsv(uplo,trans,diag,n,k,a,lda,x,incx) import sp,dp,qp,ilp,lk @@ -1852,11 +1852,11 @@ module stdlib_linalg_blas - !> TPMV: performs one of the matrix-vector operations + interface tpmv + !> TPMV performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, or x := A**H*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular matrix, supplied in packed form. - interface tpmv #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctpmv(uplo,trans,diag,n,ap,x,incx) import sp,dp,qp,ilp,lk @@ -1915,13 +1915,13 @@ module stdlib_linalg_blas - !> TPSV: solves one of the systems of equations + interface tpsv + !> TPSV solves one of the systems of equations !> A*x = b, or A**T*x = b, or A**H*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular matrix, supplied in packed form. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - interface tpsv #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctpsv(uplo,trans,diag,n,ap,x,incx) import sp,dp,qp,ilp,lk @@ -1980,12 +1980,12 @@ module stdlib_linalg_blas - !> TRMM: performs one of the matrix-matrix operations + interface trmm + !> TRMM performs one of the matrix-matrix operations !> B := alpha*op( A )*B, or B := alpha*B*op( A ) !> where alpha is a scalar, B is an m by n matrix, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. - interface trmm #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) import sp,dp,qp,ilp,lk @@ -2044,11 +2044,11 @@ module stdlib_linalg_blas - !> TRMV: performs one of the matrix-vector operations + interface trmv + !> TRMV performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, or x := A**H*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular matrix. - interface trmv #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctrmv(uplo,trans,diag,n,a,lda,x,incx) import sp,dp,qp,ilp,lk @@ -2107,13 +2107,13 @@ module stdlib_linalg_blas - !> TRSM: solves one of the matrix equations + interface trsm + !> TRSM solves one of the matrix equations !> op( A )*X = alpha*B, or X*op( A ) = alpha*B, !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. !> The matrix X is overwritten on B. - interface trsm #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) import sp,dp,qp,ilp,lk @@ -2172,13 +2172,13 @@ module stdlib_linalg_blas - !> TRSV: solves one of the systems of equations + interface trsv + !> TRSV solves one of the systems of equations !> A*x = b, or A**T*x = b, or A**H*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular matrix. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - interface trsv #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctrsv(uplo,trans,diag,n,a,lda,x,incx) import sp,dp,qp,ilp,lk diff --git a/src/stdlib_linalg_blas_aux.fypp b/src/stdlib_linalg_blas_aux.fypp index 20e024487..52703829d 100644 --- a/src/stdlib_linalg_blas_aux.fypp +++ b/src/stdlib_linalg_blas_aux.fypp @@ -28,9 +28,9 @@ module stdlib_linalg_blas_aux contains - !> DCABS1: computes |Re(.)| + |Im(.)| of a double complex number pure real(dp) function stdlib_dcabs1(z) + !> DCABS1 computes |Re(.)| + |Im(.)| of a double complex number ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43,9 +43,9 @@ module stdlib_linalg_blas_aux return end function stdlib_dcabs1 - !> ISAMAX: finds the index of the first element having maximum absolute value. pure integer(ilp) function stdlib_isamax(n,sx,incx) + !> ISAMAX finds the index of the first element having maximum absolute value. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -88,9 +88,9 @@ module stdlib_linalg_blas_aux return end function stdlib_isamax - !> IZAMAX: finds the index of the first element having maximum |Re(.)| + |Im(.)| pure integer(ilp) function stdlib_izamax(n,zx,incx) + !> IZAMAX finds the index of the first element having maximum |Re(.)| + |Im(.)| ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -131,10 +131,10 @@ module stdlib_linalg_blas_aux return end function stdlib_izamax - !> LSAME: returns .TRUE. if CA is the same letter as CB regardless of - !> case. pure logical(lk) function stdlib_lsame(ca,cb) + !> LSAME returns .TRUE. if CA is the same letter as CB regardless of + !> case. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -178,9 +178,9 @@ module stdlib_linalg_blas_aux ! return end function stdlib_lsame - !> SCABS1: computes |Re(.)| + |Im(.)| of a complex number pure real(sp) function stdlib_scabs1(z) + !> SCABS1 computes |Re(.)| + |Im(.)| of a complex number ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -193,13 +193,13 @@ module stdlib_linalg_blas_aux return end function stdlib_scabs1 - !> XERBLA: is an error handler for the LAPACK routines. + + pure subroutine stdlib_xerbla( srname, info ) + !> XERBLA is an error handler for the LAPACK routines. !> It is called by an LAPACK routine if an input parameter has an !> invalid value. A message is printed and execution stops. !> Installers may consider modifying the STOP statement in order to !> call system-specific exception-handling facilities. - - pure subroutine stdlib_xerbla( srname, info ) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -214,7 +214,9 @@ module stdlib_linalg_blas_aux end subroutine stdlib_xerbla - !> XERBLA_ARRAY: assists other languages in calling XERBLA, the LAPACK + + pure subroutine stdlib_xerbla_array(srname_array, srname_len, info) + !> XERBLA_ARRAY assists other languages in calling XERBLA, the LAPACK !> and BLAS error handler. Rather than taking a Fortran string argument !> as the function's name, XERBLA_ARRAY takes an array of single !> characters along with the array's length. XERBLA_ARRAY then copies @@ -230,8 +232,6 @@ module stdlib_linalg_blas_aux !> } !> Providing XERBLA_ARRAY is not necessary for intercepting LAPACK !> errors. XERBLA_ARRAY calls XERBLA. - - pure subroutine stdlib_xerbla_array(srname_array, srname_len, info) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -257,9 +257,9 @@ module stdlib_linalg_blas_aux #:if WITH_QP - !> DCABS1: computes |Re(.)| + |Im(.)| of a double complex number pure real(qp) function stdlib_qcabs1(z) + !> DCABS1: computes |Re(.)| + |Im(.)| of a double complex number ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -275,9 +275,9 @@ module stdlib_linalg_blas_aux #:if WITH_QP - !> IDAMAX: finds the index of the first element having maximum absolute value. pure integer(ilp) function stdlib_iqamax(n,dx,incx) + !> IDAMAX: finds the index of the first element having maximum absolute value. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -323,9 +323,9 @@ module stdlib_linalg_blas_aux #:if WITH_QP - !> IZAMAX: finds the index of the first element having maximum |Re(.)| + |Im(.)| pure integer(ilp) function stdlib_iwamax(n,zx,incx) + !> IZAMAX: finds the index of the first element having maximum |Re(.)| + |Im(.)| ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -367,9 +367,9 @@ module stdlib_linalg_blas_aux end function stdlib_iwamax #:endif - !> ICAMAX: finds the index of the first element having maximum |Re(.)| + |Im(.)| pure integer(ilp) function stdlib_icamax(n,cx,incx) + !> ICAMAX finds the index of the first element having maximum |Re(.)| + |Im(.)| ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -410,9 +410,9 @@ module stdlib_linalg_blas_aux return end function stdlib_icamax - !> IDAMAX: finds the index of the first element having maximum absolute value. pure integer(ilp) function stdlib_idamax(n,dx,incx) + !> IDAMAX finds the index of the first element having maximum absolute value. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_blas_c.fypp b/src/stdlib_linalg_blas_c.fypp index 68890f8d4..8a0be884a 100644 --- a/src/stdlib_linalg_blas_c.fypp +++ b/src/stdlib_linalg_blas_c.fypp @@ -84,9 +84,9 @@ module stdlib_linalg_blas_c contains - !> CAXPY: constant times a vector plus a vector. pure subroutine stdlib_caxpy(n,ca,cx,incx,cy,incy) + !> CAXPY constant times a vector plus a vector. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -122,9 +122,9 @@ module stdlib_linalg_blas_c return end subroutine stdlib_caxpy - !> CCOPY: copies a vector x to a vector y. pure subroutine stdlib_ccopy(n,cx,incx,cy,incy) + !> CCOPY copies a vector x to a vector y. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -158,10 +158,10 @@ module stdlib_linalg_blas_c return end subroutine stdlib_ccopy - !> CDOTC: forms the dot product of two complex vectors - !> CDOTC = X^H * Y pure complex(sp) function stdlib_cdotc(n,cx,incx,cy,incy) + !> CDOTC forms the dot product of two complex vectors + !> CDOTC = X^H * Y ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -200,10 +200,10 @@ module stdlib_linalg_blas_c return end function stdlib_cdotc - !> CDOTU: forms the dot product of two complex vectors - !> CDOTU = X^T * Y pure complex(sp) function stdlib_cdotu(n,cx,incx,cy,incy) + !> CDOTU forms the dot product of two complex vectors + !> CDOTU = X^T * Y ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -240,13 +240,13 @@ module stdlib_linalg_blas_c return end function stdlib_cdotu - !> CGBMV: performs one of the matrix-vector operations + + pure subroutine stdlib_cgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) + !> CGBMV performs one of the matrix-vector operations !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or !> y := alpha*A**H*x + beta*y, !> where alpha and beta are scalars, x and y are vectors and A is an !> m by n band matrix, with kl sub-diagonals and ku super-diagonals. - - pure subroutine stdlib_cgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -412,14 +412,14 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cgbmv - !> CGEMM: performs one of the matrix-matrix operations + + pure subroutine stdlib_cgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) + !> CGEMM performs one of the matrix-matrix operations !> C := alpha*op( A )*op( B ) + beta*C, !> where op( X ) is one of !> op( X ) = X or op( X ) = X**T or op( X ) = X**H, !> alpha and beta are scalars, and A, B and C are matrices, with op( A ) !> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. - - pure subroutine stdlib_cgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -661,13 +661,13 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cgemm - !> CGEMV: performs one of the matrix-vector operations + + pure subroutine stdlib_cgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) + !> CGEMV performs one of the matrix-vector operations !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or !> y := alpha*A**H*x + beta*y, !> where alpha and beta are scalars, x and y are vectors and A is an !> m by n matrix. - - pure subroutine stdlib_cgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -822,12 +822,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cgemv - !> CGERC: performs the rank 1 operation + + pure subroutine stdlib_cgerc(m,n,alpha,x,incx,y,incy,a,lda) + !> CGERC performs the rank 1 operation !> A := alpha*x*y**H + A, !> where alpha is a scalar, x is an m element vector, y is an n element !> vector and A is an m by n matrix. - - pure subroutine stdlib_cgerc(m,n,alpha,x,incx,y,incy,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -901,12 +901,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cgerc - !> CGERU: performs the rank 1 operation + + pure subroutine stdlib_cgeru(m,n,alpha,x,incx,y,incy,a,lda) + !> CGERU performs the rank 1 operation !> A := alpha*x*y**T + A, !> where alpha is a scalar, x is an m element vector, y is an n element !> vector and A is an m by n matrix. - - pure subroutine stdlib_cgeru(m,n,alpha,x,incx,y,incy,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -980,12 +980,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cgeru - !> CHBMV: performs the matrix-vector operation + + pure subroutine stdlib_chbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) + !> CHBMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n hermitian band matrix, with k super-diagonals. - - pure subroutine stdlib_chbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1143,14 +1143,14 @@ module stdlib_linalg_blas_c return end subroutine stdlib_chbmv - !> CHEMM: performs one of the matrix-matrix operations + + pure subroutine stdlib_chemm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) + !> CHEMM performs one of the matrix-matrix operations !> C := alpha*A*B + beta*C, !> or !> C := alpha*B*A + beta*C, !> where alpha and beta are scalars, A is an hermitian matrix and B and !> C are m by n matrices. - - pure subroutine stdlib_chemm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1293,12 +1293,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_chemm - !> CHEMV: performs the matrix-vector operation + + pure subroutine stdlib_chemv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) + !> CHEMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n hermitian matrix. - - pure subroutine stdlib_chemv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1446,12 +1446,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_chemv - !> CHER: performs the hermitian rank 1 operation + + pure subroutine stdlib_cher(uplo,n,alpha,x,incx,a,lda) + !> CHER performs the hermitian rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n hermitian matrix. - - pure subroutine stdlib_cher(uplo,n,alpha,x,incx,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1561,12 +1561,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cher - !> CHER2: performs the hermitian rank 2 operation + + pure subroutine stdlib_cher2(uplo,n,alpha,x,incx,y,incy,a,lda) + !> CHER2 performs the hermitian rank 2 operation !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, !> where alpha is a scalar, x and y are n element vectors and A is an n !> by n hermitian matrix. - - pure subroutine stdlib_cher2(uplo,n,alpha,x,incx,y,incy,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1700,15 +1700,15 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cher2 - !> CHER2K: performs one of the hermitian rank 2k operations + + pure subroutine stdlib_cher2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) + !> CHER2K performs one of the hermitian rank 2k operations !> C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C, !> or !> C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C, !> where alpha and beta are scalars with beta real, C is an n by n !> hermitian matrix and A and B are n by k matrices in the first case !> and k by n matrices in the second case. - - pure subroutine stdlib_cher2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1909,15 +1909,15 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cher2k - !> CHERK: performs one of the hermitian rank k operations + + pure subroutine stdlib_cherk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) + !> CHERK 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. - - pure subroutine stdlib_cherk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2105,12 +2105,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cherk - !> CHPMV: performs the matrix-vector operation + + pure subroutine stdlib_chpmv(uplo,n,alpha,ap,x,incx,beta,y,incy) + !> CHPMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n hermitian matrix, supplied in packed form. - - pure subroutine stdlib_chpmv(uplo,n,alpha,ap,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2264,12 +2264,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_chpmv - !> CHPR: performs the hermitian rank 1 operation + + pure subroutine stdlib_chpr(uplo,n,alpha,x,incx,ap) + !> CHPR performs the hermitian rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n hermitian matrix, supplied in packed form. - - pure subroutine stdlib_chpr(uplo,n,alpha,x,incx,ap) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2386,12 +2386,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_chpr - !> CHPR2: performs the hermitian rank 2 operation + + pure subroutine stdlib_chpr2(uplo,n,alpha,x,incx,y,incy,ap) + !> CHPR2 performs the hermitian rank 2 operation !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, !> where alpha is a scalar, x and y are n element vectors and A is an !> n by n hermitian matrix, supplied in packed form. - - pure subroutine stdlib_chpr2(uplo,n,alpha,x,incx,y,incy,ap) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2531,6 +2531,8 @@ module stdlib_linalg_blas_c return end subroutine stdlib_chpr2 + + pure subroutine stdlib_crotg( a, b, c, s ) !> ! !> !> The computation uses the formulas @@ -2546,8 +2548,6 @@ module stdlib_linalg_blas_c !> the same as in SROTG when |a| > |b|. When |b| >= |a|, the !> sign of c and s will be different from those computed by SROTG !> if the signs of a and b are not the same. - - pure subroutine stdlib_crotg( a, b, c, s ) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2648,9 +2648,9 @@ module stdlib_linalg_blas_c return end subroutine stdlib_crotg - !> CSCAL: scales a vector by a constant. pure subroutine stdlib_cscal(n,ca,cx,incx) + !> CSCAL scales a vector by a constant. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2678,11 +2678,11 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cscal - !> CSROT: applies a plane rotation, where the cos and sin (c and s) are real - !> and the vectors cx and cy are complex. - !> jack dongarra, linpack, 3/11/78. pure subroutine stdlib_csrot( n, cx, incx, cy, incy, c, s ) + !> CSROT applies a plane rotation, where the cos and sin (c and s) are real + !> and the vectors cx and cy are complex. + !> jack dongarra, linpack, 3/11/78. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2722,9 +2722,9 @@ module stdlib_linalg_blas_c return end subroutine stdlib_csrot - !> CSSCAL: scales a complex vector by a real constant. pure subroutine stdlib_csscal(n,sa,cx,incx) + !> CSSCAL scales a complex vector by a real constant. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2754,9 +2754,9 @@ module stdlib_linalg_blas_c return end subroutine stdlib_csscal - !> CSWAP: interchanges two vectors. pure subroutine stdlib_cswap(n,cx,incx,cy,incy) + !> CSWAP interchanges two vectors. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2794,14 +2794,14 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cswap - !> CSYMM: performs one of the matrix-matrix operations + + pure subroutine stdlib_csymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) + !> CSYMM performs one of the matrix-matrix operations !> C := alpha*A*B + beta*C, !> or !> C := alpha*B*A + beta*C, !> where alpha and beta are scalars, A is a symmetric matrix and B and !> C are m by n matrices. - - pure subroutine stdlib_csymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2942,15 +2942,15 @@ module stdlib_linalg_blas_c return end subroutine stdlib_csymm - !> CSYR2K: performs one of the symmetric rank 2k operations + + pure subroutine stdlib_csyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) + !> CSYR2K performs one of the symmetric rank 2k operations !> C := alpha*A*B**T + alpha*B*A**T + beta*C, !> or !> C := alpha*A**T*B + alpha*B**T*A + beta*C, !> where alpha and beta are scalars, C is an n by n symmetric matrix !> and A and B are n by k matrices in the first case and k by n !> matrices in the second case. - - pure subroutine stdlib_csyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3118,15 +3118,15 @@ module stdlib_linalg_blas_c return end subroutine stdlib_csyr2k - !> CSYRK: performs one of the symmetric rank k operations + + pure subroutine stdlib_csyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) + !> CSYRK performs one of the symmetric rank k operations !> C := alpha*A*A**T + beta*C, !> or !> C := alpha*A**T*A + beta*C, !> where alpha and beta are scalars, C is an n by n symmetric matrix !> and A is an n by k matrix in the first case and a k by n matrix !> in the second case. - - pure subroutine stdlib_csyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3286,12 +3286,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_csyrk - !> CTBMV: performs one of the matrix-vector operations + + pure subroutine stdlib_ctbmv(uplo,trans,diag,n,k,a,lda,x,incx) + !> CTBMV performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, or x := A**H*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular band matrix, with ( k + 1 ) diagonals. - - pure subroutine stdlib_ctbmv(uplo,trans,diag,n,k,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3500,15 +3500,15 @@ module stdlib_linalg_blas_c return end subroutine stdlib_ctbmv - !> CTBSV: solves one of the systems of equations + + pure subroutine stdlib_ctbsv(uplo,trans,diag,n,k,a,lda,x,incx) + !> CTBSV solves one of the systems of equations !> A*x = b, or A**T*x = b, or A**H*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular band matrix, with ( k + 1 ) !> diagonals. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_ctbsv(uplo,trans,diag,n,k,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3717,12 +3717,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_ctbsv - !> CTPMV: performs one of the matrix-vector operations + + pure subroutine stdlib_ctpmv(uplo,trans,diag,n,ap,x,incx) + !> CTPMV performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, or x := A**H*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular matrix, supplied in packed form. - - pure subroutine stdlib_ctpmv(uplo,trans,diag,n,ap,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3934,14 +3934,14 @@ module stdlib_linalg_blas_c return end subroutine stdlib_ctpmv - !> CTPSV: solves one of the systems of equations + + pure subroutine stdlib_ctpsv(uplo,trans,diag,n,ap,x,incx) + !> CTPSV solves one of the systems of equations !> A*x = b, or A**T*x = b, or A**H*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular matrix, supplied in packed form. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_ctpsv(uplo,trans,diag,n,ap,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4153,13 +4153,13 @@ module stdlib_linalg_blas_c return end subroutine stdlib_ctpsv - !> CTRMM: performs one of the matrix-matrix operations + + pure subroutine stdlib_ctrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) + !> CTRMM performs one of the matrix-matrix operations !> B := alpha*op( A )*B, or B := alpha*B*op( A ) !> where alpha is a scalar, B is an m by n matrix, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. - - pure subroutine stdlib_ctrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4395,12 +4395,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_ctrmm - !> CTRMV: performs one of the matrix-vector operations + + pure subroutine stdlib_ctrmv(uplo,trans,diag,n,a,lda,x,incx) + !> CTRMV performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, or x := A**H*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular matrix. - - pure subroutine stdlib_ctrmv(uplo,trans,diag,n,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4592,14 +4592,14 @@ module stdlib_linalg_blas_c return end subroutine stdlib_ctrmv - !> CTRSM: solves one of the matrix equations + + pure subroutine stdlib_ctrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) + !> CTRSM solves one of the matrix equations !> op( A )*X = alpha*B, or X*op( A ) = alpha*B, !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. !> The matrix X is overwritten on B. - - pure subroutine stdlib_ctrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4857,14 +4857,14 @@ module stdlib_linalg_blas_c return end subroutine stdlib_ctrsm - !> CTRSV: solves one of the systems of equations + + pure subroutine stdlib_ctrsv(uplo,trans,diag,n,a,lda,x,incx) + !> CTRSV solves one of the systems of equations !> A*x = b, or A**T*x = b, or A**H*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular matrix. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_ctrsv(uplo,trans,diag,n,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_blas_d.fypp b/src/stdlib_linalg_blas_d.fypp index 125ad603c..7812c89af 100644 --- a/src/stdlib_linalg_blas_d.fypp +++ b/src/stdlib_linalg_blas_d.fypp @@ -86,9 +86,9 @@ module stdlib_linalg_blas_d contains - !> DASUM: takes the sum of the absolute values. pure real(dp) function stdlib_dasum(n,dx,incx) + !> DASUM takes the sum of the absolute values. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -134,10 +134,10 @@ module stdlib_linalg_blas_d return end function stdlib_dasum - !> DAXPY: constant times a vector plus a vector. - !> uses unrolled loops for increments equal to one. pure subroutine stdlib_daxpy(n,da,dx,incx,dy,incy) + !> DAXPY constant times a vector plus a vector. + !> uses unrolled loops for increments equal to one. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -187,10 +187,10 @@ module stdlib_linalg_blas_d return end subroutine stdlib_daxpy - !> DCOPY: copies a vector, x, to a vector, y. - !> uses unrolled loops for increments equal to 1. pure subroutine stdlib_dcopy(n,dx,incx,dy,incy) + !> DCOPY copies a vector, x, to a vector, y. + !> uses unrolled loops for increments equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -241,10 +241,10 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dcopy - !> DDOT: forms the dot product of two vectors. - !> uses unrolled loops for increments equal to one. pure real(dp) function stdlib_ddot(n,dx,incx,dy,incy) + !> DDOT forms the dot product of two vectors. + !> uses unrolled loops for increments equal to one. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -296,12 +296,12 @@ module stdlib_linalg_blas_d return end function stdlib_ddot - !> DGBMV: performs one of the matrix-vector operations + + pure subroutine stdlib_dgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) + !> DGBMV performs one of the matrix-vector operations !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, !> where alpha and beta are scalars, x and y are vectors and A is an !> m by n band matrix, with kl sub-diagonals and ku super-diagonals. - - pure subroutine stdlib_dgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -451,14 +451,14 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dgbmv - !> DGEMM: performs one of the matrix-matrix operations + + pure subroutine stdlib_dgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) + !> DGEMM performs one of the matrix-matrix operations !> C := alpha*op( A )*op( B ) + beta*C, !> where op( X ) is one of !> op( X ) = X or op( X ) = X**T, !> alpha and beta are scalars, and A, B and C are matrices, with op( A ) !> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. - - pure subroutine stdlib_dgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -614,12 +614,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dgemm - !> DGEMV: performs one of the matrix-vector operations + + pure subroutine stdlib_dgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) + !> DGEMV performs one of the matrix-vector operations !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, !> where alpha and beta are scalars, x and y are vectors and A is an !> m by n matrix. - - pure subroutine stdlib_dgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -758,12 +758,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dgemv - !> DGER: performs the rank 1 operation + + pure subroutine stdlib_dger(m,n,alpha,x,incx,y,incy,a,lda) + !> DGER performs the rank 1 operation !> A := alpha*x*y**T + A, !> where alpha is a scalar, x is an m element vector, y is an n element !> vector and A is an m by n matrix. - - pure subroutine stdlib_dger(m,n,alpha,x,incx,y,incy,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -837,13 +837,13 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dger + + pure function stdlib_dnrm2( n, x, incx ) !> ! !> - !> DNRM2: returns the euclidean norm of a vector via the function + !> DNRM2 returns the euclidean norm of a vector via the function !> name, so that !> DNRM2 := sqrt( x'*x ) - - pure function stdlib_dnrm2( n, x, incx ) real(dp) :: stdlib_dnrm2 ! -- reference blas level1 routine (version 3.9.1_dp) -- ! -- reference blas is a software package provided by univ. of tennessee, -- @@ -927,9 +927,9 @@ module stdlib_linalg_blas_d return end function stdlib_dnrm2 - !> DROT: applies a plane rotation. pure subroutine stdlib_drot(n,dx,incx,dy,incy,c,s) + !> DROT applies a plane rotation. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -968,6 +968,8 @@ module stdlib_linalg_blas_d return end subroutine stdlib_drot + + pure subroutine stdlib_drotg( a, b, c, s ) !> ! !> !> The computation uses the formulas @@ -984,8 +986,6 @@ module stdlib_linalg_blas_d !> If z = 1, set c = 0, s = 1. !> If |z| < 1, set c = sqrt(1 - z**2) and s = z. !> If |z| > 1, set c = 1/z and s = sqrt( 1 - c**2). - - pure subroutine stdlib_drotg( a, b, c, s ) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1031,6 +1031,8 @@ module stdlib_linalg_blas_d return end subroutine stdlib_drotg + + pure subroutine stdlib_drotm(n,dx,incx,dy,incy,dparam) !> APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX !> (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN !> (DY**T) @@ -1042,8 +1044,6 @@ module stdlib_linalg_blas_d !> H=( ) ( ) ( ) ( ) !> (DH21 DH22), (DH21 1._dp), (-1._dp DH22), (0._dp 1._dp). !> SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. - - pure subroutine stdlib_drotm(n,dx,incx,dy,incy,dparam) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1138,6 +1138,8 @@ module stdlib_linalg_blas_d return end subroutine stdlib_drotm + + pure subroutine stdlib_drotmg(dd1,dd2,dx1,dy1,dparam) !> CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS !> THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(DD1)*DX1,SQRT(DD2) DY2)**T. !> WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. @@ -1151,8 +1153,6 @@ module stdlib_linalg_blas_d !> THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE !> INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE !> OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. - - pure subroutine stdlib_drotmg(dd1,dd2,dx1,dy1,dparam) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1304,12 +1304,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_drotmg - !> DSBMV: performs the matrix-vector operation + + pure subroutine stdlib_dsbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) + !> DSBMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric band matrix, with k super-diagonals. - - pure subroutine stdlib_dsbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1466,10 +1466,10 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dsbmv - !> DSCAL: scales a vector by a constant. - !> uses unrolled loops for increment equal to 1. pure subroutine stdlib_dscal(n,da,dx,incx) + !> DSCAL scales a vector by a constant. + !> uses unrolled loops for increment equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1512,14 +1512,14 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dscal + + pure real(dp) function stdlib_dsdot(n,sx,incx,sy,incy) !> Compute the inner product of two vectors with extended !> precision accumulation and result. !> Returns D.P. dot product accumulated in D.P., for S.P. SX and SY - !> DSDOT: = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY), + !> DSDOT = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY), !> where LX = 1 if INCX >= 0, else LX = 1+(1-N)*INCX, and LY is !> defined in a similar way using INCY. - - pure real(dp) function stdlib_dsdot(n,sx,incx,sy,incy) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1559,12 +1559,12 @@ module stdlib_linalg_blas_d return end function stdlib_dsdot - !> DSPMV: performs the matrix-vector operation + + pure subroutine stdlib_dspmv(uplo,n,alpha,ap,x,incx,beta,y,incy) + !> DSPMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix, supplied in packed form. - - pure subroutine stdlib_dspmv(uplo,n,alpha,ap,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1715,12 +1715,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dspmv - !> DSPR: performs the symmetric rank 1 operation + + pure subroutine stdlib_dspr(uplo,n,alpha,x,incx,ap) + !> DSPR performs the symmetric rank 1 operation !> A := alpha*x*x**T + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n symmetric matrix, supplied in packed form. - - pure subroutine stdlib_dspr(uplo,n,alpha,x,incx,ap) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1822,12 +1822,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dspr - !> DSPR2: performs the symmetric rank 2 operation + + pure subroutine stdlib_dspr2(uplo,n,alpha,x,incx,y,incy,ap) + !> DSPR2 performs the symmetric rank 2 operation !> A := alpha*x*y**T + alpha*y*x**T + A, !> where alpha is a scalar, x and y are n element vectors and A is an !> n by n symmetric matrix, supplied in packed form. - - pure subroutine stdlib_dspr2(uplo,n,alpha,x,incx,y,incy,ap) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1949,10 +1949,10 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dspr2 - !> DSWAP: interchanges two vectors. - !> uses unrolled loops for increments equal to 1. pure subroutine stdlib_dswap(n,dx,incx,dy,incy) + !> DSWAP interchanges two vectors. + !> uses unrolled loops for increments equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2009,14 +2009,14 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dswap - !> DSYMM: performs one of the matrix-matrix operations + + pure subroutine stdlib_dsymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) + !> DSYMM performs one of the matrix-matrix operations !> C := alpha*A*B + beta*C, !> or !> C := alpha*B*A + beta*C, !> where alpha and beta are scalars, A is a symmetric matrix and B and !> C are m by n matrices. - - pure subroutine stdlib_dsymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2156,12 +2156,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dsymm - !> DSYMV: performs the matrix-vector operation + + pure subroutine stdlib_dsymv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) + !> DSYMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix. - - pure subroutine stdlib_dsymv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2308,12 +2308,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dsymv - !> DSYR: performs the symmetric rank 1 operation + + pure subroutine stdlib_dsyr(uplo,n,alpha,x,incx,a,lda) + !> DSYR performs the symmetric rank 1 operation !> A := alpha*x*x**T + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n symmetric matrix. - - pure subroutine stdlib_dsyr(uplo,n,alpha,x,incx,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2411,12 +2411,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dsyr - !> DSYR2: performs the symmetric rank 2 operation + + pure subroutine stdlib_dsyr2(uplo,n,alpha,x,incx,y,incy,a,lda) + !> DSYR2 performs the symmetric rank 2 operation !> A := alpha*x*y**T + alpha*y*x**T + A, !> where alpha is a scalar, x and y are n element vectors and A is an n !> by n symmetric matrix. - - pure subroutine stdlib_dsyr2(uplo,n,alpha,x,incx,y,incy,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2534,15 +2534,15 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dsyr2 - !> DSYR2K: performs one of the symmetric rank 2k operations + + pure subroutine stdlib_dsyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) + !> DSYR2K performs one of the symmetric rank 2k operations !> C := alpha*A*B**T + alpha*B*A**T + beta*C, !> or !> C := alpha*A**T*B + alpha*B**T*A + beta*C, !> where alpha and beta are scalars, C is an n by n symmetric matrix !> and A and B are n by k matrices in the first case and k by n !> matrices in the second case. - - pure subroutine stdlib_dsyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2709,15 +2709,15 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dsyr2k - !> DSYRK: performs one of the symmetric rank k operations + + pure subroutine stdlib_dsyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) + !> DSYRK performs one of the symmetric rank k operations !> C := alpha*A*A**T + beta*C, !> or !> C := alpha*A**T*A + beta*C, !> where alpha and beta are scalars, C is an n by n symmetric matrix !> and A is an n by k matrix in the first case and a k by n matrix !> in the second case. - - pure subroutine stdlib_dsyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2876,12 +2876,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dsyrk - !> DTBMV: performs one of the matrix-vector operations + + pure subroutine stdlib_dtbmv(uplo,trans,diag,n,k,a,lda,x,incx) + !> DTBMV performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular band matrix, with ( k + 1 ) diagonals. - - pure subroutine stdlib_dtbmv(uplo,trans,diag,n,k,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3059,15 +3059,15 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dtbmv - !> DTBSV: solves one of the systems of equations + + pure subroutine stdlib_dtbsv(uplo,trans,diag,n,k,a,lda,x,incx) + !> DTBSV solves one of the systems of equations !> A*x = b, or A**T*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular band matrix, with ( k + 1 ) !> diagonals. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_dtbsv(uplo,trans,diag,n,k,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3245,12 +3245,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dtbsv - !> DTPMV: performs one of the matrix-vector operations + + pure subroutine stdlib_dtpmv(uplo,trans,diag,n,ap,x,incx) + !> DTPMV performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular matrix, supplied in packed form. - - pure subroutine stdlib_dtpmv(uplo,trans,diag,n,ap,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3427,14 +3427,14 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dtpmv - !> DTPSV: solves one of the systems of equations + + pure subroutine stdlib_dtpsv(uplo,trans,diag,n,ap,x,incx) + !> DTPSV solves one of the systems of equations !> A*x = b, or A**T*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular matrix, supplied in packed form. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_dtpsv(uplo,trans,diag,n,ap,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3611,13 +3611,13 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dtpsv - !> DTRMM: performs one of the matrix-matrix operations + + pure subroutine stdlib_dtrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) + !> DTRMM performs one of the matrix-matrix operations !> B := alpha*op( A )*B, or B := alpha*B*op( A ), !> where alpha is a scalar, B is an m by n matrix, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T. - - pure subroutine stdlib_dtrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3817,12 +3817,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dtrmm - !> DTRMV: performs one of the matrix-vector operations + + pure subroutine stdlib_dtrmv(uplo,trans,diag,n,a,lda,x,incx) + !> DTRMV performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular matrix. - - pure subroutine stdlib_dtrmv(uplo,trans,diag,n,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3983,14 +3983,14 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dtrmv - !> DTRSM: solves one of the matrix equations + + pure subroutine stdlib_dtrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) + !> DTRSM solves one of the matrix equations !> op( A )*X = alpha*B, or X*op( A ) = alpha*B, !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T. !> The matrix X is overwritten on B. - - pure subroutine stdlib_dtrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4214,14 +4214,14 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dtrsm - !> DTRSV: solves one of the systems of equations + + pure subroutine stdlib_dtrsv(uplo,trans,diag,n,a,lda,x,incx) + !> DTRSV solves one of the systems of equations !> A*x = b, or A**T*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular matrix. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_dtrsv(uplo,trans,diag,n,a,lda,x,incx) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4382,10 +4382,10 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dtrsv - !> DZASUM: takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and - !> returns a double precision result. pure real(dp) function stdlib_dzasum(n,zx,incx) + !> DZASUM takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and + !> returns a double precision result. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4416,13 +4416,13 @@ module stdlib_linalg_blas_d return end function stdlib_dzasum + + pure function stdlib_dznrm2( n, x, incx ) !> ! !> - !> DZNRM2: returns the euclidean norm of a vector via the function + !> DZNRM2 returns the euclidean norm of a vector via the function !> name, so that !> DZNRM2 := sqrt( x**H*x ) - - pure function stdlib_dznrm2( n, x, incx ) real(dp) :: stdlib_dznrm2 ! -- reference blas level1 routine (version 3.9.1_dp) -- ! -- reference blas is a software package provided by univ. of tennessee, -- diff --git a/src/stdlib_linalg_blas_q.fypp b/src/stdlib_linalg_blas_q.fypp index b7209fd35..94b0b6750 100644 --- a/src/stdlib_linalg_blas_q.fypp +++ b/src/stdlib_linalg_blas_q.fypp @@ -89,9 +89,9 @@ module stdlib_linalg_blas_q contains - !> DASUM: takes the sum of the absolute values. pure real(qp) function stdlib_qasum(n,dx,incx) + !> DASUM: takes the sum of the absolute values. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -137,10 +137,10 @@ module stdlib_linalg_blas_q return end function stdlib_qasum - !> DAXPY: constant times a vector plus a vector. - !> uses unrolled loops for increments equal to one. pure subroutine stdlib_qaxpy(n,da,dx,incx,dy,incy) + !> DAXPY: constant times a vector plus a vector. + !> uses unrolled loops for increments equal to one. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -190,10 +190,10 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qaxpy - !> DCOPY: copies a vector, x, to a vector, y. - !> uses unrolled loops for increments equal to 1. pure subroutine stdlib_qcopy(n,dx,incx,dy,incy) + !> DCOPY: copies a vector, x, to a vector, y. + !> uses unrolled loops for increments equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -244,10 +244,10 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qcopy - !> DDOT: forms the dot product of two vectors. - !> uses unrolled loops for increments equal to one. pure real(qp) function stdlib_qdot(n,dx,incx,dy,incy) + !> DDOT: forms the dot product of two vectors. + !> uses unrolled loops for increments equal to one. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -299,12 +299,12 @@ module stdlib_linalg_blas_q return end function stdlib_qdot + + pure subroutine stdlib_qgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) !> DGBMV: performs one of the matrix-vector operations !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, !> where alpha and beta are scalars, x and y are vectors and A is an !> m by n band matrix, with kl sub-diagonals and ku super-diagonals. - - pure subroutine stdlib_qgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -454,14 +454,14 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qgbmv + + pure subroutine stdlib_qgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) !> DGEMM: performs one of the matrix-matrix operations !> C := alpha*op( A )*op( B ) + beta*C, !> where op( X ) is one of !> op( X ) = X or op( X ) = X**T, !> alpha and beta are scalars, and A, B and C are matrices, with op( A ) !> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. - - pure subroutine stdlib_qgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -617,12 +617,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qgemm + + pure subroutine stdlib_qgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) !> DGEMV: performs one of the matrix-vector operations !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, !> where alpha and beta are scalars, x and y are vectors and A is an !> m by n matrix. - - pure subroutine stdlib_qgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -761,12 +761,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qgemv + + pure subroutine stdlib_qger(m,n,alpha,x,incx,y,incy,a,lda) !> DGER: performs the rank 1 operation !> A := alpha*x*y**T + A, !> where alpha is a scalar, x is an m element vector, y is an n element !> vector and A is an m by n matrix. - - pure subroutine stdlib_qger(m,n,alpha,x,incx,y,incy,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -840,13 +840,13 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qger + + pure function stdlib_qnrm2( n, x, incx ) !> ! !> !> DNRM2: returns the euclidean norm of a vector via the function !> name, so that !> DNRM2 := sqrt( x'*x ) - - pure function stdlib_qnrm2( n, x, incx ) real(qp) :: stdlib_qnrm2 ! -- reference blas level1 routine (version 3.9.1_qp) -- ! -- reference blas is a software package provided by univ. of tennessee, -- @@ -930,9 +930,9 @@ module stdlib_linalg_blas_q return end function stdlib_qnrm2 - !> DROT: applies a plane rotation. pure subroutine stdlib_qrot(n,dx,incx,dy,incy,c,s) + !> DROT: applies a plane rotation. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -971,6 +971,8 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qrot + + pure subroutine stdlib_qrotg( a, b, c, s ) !> ! !> !> The computation uses the formulas @@ -987,8 +989,6 @@ module stdlib_linalg_blas_q !> If z = 1, set c = 0, s = 1. !> If |z| < 1, set c = sqrt(1 - z**2) and s = z. !> If |z| > 1, set c = 1/z and s = sqrt( 1 - c**2). - - pure subroutine stdlib_qrotg( a, b, c, s ) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1034,6 +1034,8 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qrotg + + pure subroutine stdlib_qrotm(n,dx,incx,dy,incy,dparam) !> APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX !> (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN !> (DY**T) @@ -1045,8 +1047,6 @@ module stdlib_linalg_blas_q !> H=( ) ( ) ( ) ( ) !> (DH21 DH22), (DH21 1._qp), (-1._qp DH22), (0._qp 1._qp). !> SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. - - pure subroutine stdlib_qrotm(n,dx,incx,dy,incy,dparam) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1141,6 +1141,8 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qrotm + + pure subroutine stdlib_qrotmg(dd1,dd2,dx1,dy1,dparam) !> CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS !> THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(DD1)*DX1,SQRT(DD2) DY2)**T. !> WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. @@ -1154,8 +1156,6 @@ module stdlib_linalg_blas_q !> THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE !> INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE !> OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. - - pure subroutine stdlib_qrotmg(dd1,dd2,dx1,dy1,dparam) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1307,12 +1307,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qrotmg + + pure subroutine stdlib_qsbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) !> DSBMV: performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric band matrix, with k super-diagonals. - - pure subroutine stdlib_qsbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1469,10 +1469,10 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qsbmv - !> DSCAL: scales a vector by a constant. - !> uses unrolled loops for increment equal to 1. pure subroutine stdlib_qscal(n,da,dx,incx) + !> DSCAL: scales a vector by a constant. + !> uses unrolled loops for increment equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1515,14 +1515,14 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qscal + + pure real(qp) function stdlib_qsdot(n,sx,incx,sy,incy) !> Compute the inner product of two vectors with extended !> precision accumulation and result. !> Returns D.P. dot product accumulated in D.P., for S.P. SX and SY !> DSDOT: = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY), !> where LX = 1 if INCX >= 0, else LX = 1+(1-N)*INCX, and LY is !> defined in a similar way using INCY. - - pure real(qp) function stdlib_qsdot(n,sx,incx,sy,incy) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1562,12 +1562,12 @@ module stdlib_linalg_blas_q return end function stdlib_qsdot + + pure subroutine stdlib_qspmv(uplo,n,alpha,ap,x,incx,beta,y,incy) !> DSPMV: performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix, supplied in packed form. - - pure subroutine stdlib_qspmv(uplo,n,alpha,ap,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1718,12 +1718,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qspmv + + pure subroutine stdlib_qspr(uplo,n,alpha,x,incx,ap) !> DSPR: performs the symmetric rank 1 operation !> A := alpha*x*x**T + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n symmetric matrix, supplied in packed form. - - pure subroutine stdlib_qspr(uplo,n,alpha,x,incx,ap) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1825,12 +1825,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qspr + + pure subroutine stdlib_qspr2(uplo,n,alpha,x,incx,y,incy,ap) !> DSPR2: performs the symmetric rank 2 operation !> A := alpha*x*y**T + alpha*y*x**T + A, !> where alpha is a scalar, x and y are n element vectors and A is an !> n by n symmetric matrix, supplied in packed form. - - pure subroutine stdlib_qspr2(uplo,n,alpha,x,incx,y,incy,ap) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1952,10 +1952,10 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qspr2 - !> DSWAP: interchanges two vectors. - !> uses unrolled loops for increments equal to 1. pure subroutine stdlib_qswap(n,dx,incx,dy,incy) + !> DSWAP: interchanges two vectors. + !> uses unrolled loops for increments equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2012,14 +2012,14 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qswap + + pure subroutine stdlib_qsymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) !> DSYMM: performs one of the matrix-matrix operations !> C := alpha*A*B + beta*C, !> or !> C := alpha*B*A + beta*C, !> where alpha and beta are scalars, A is a symmetric matrix and B and !> C are m by n matrices. - - pure subroutine stdlib_qsymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2159,12 +2159,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qsymm + + pure subroutine stdlib_qsymv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) !> DSYMV: performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix. - - pure subroutine stdlib_qsymv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2311,12 +2311,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qsymv + + pure subroutine stdlib_qsyr(uplo,n,alpha,x,incx,a,lda) !> DSYR: performs the symmetric rank 1 operation !> A := alpha*x*x**T + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n symmetric matrix. - - pure subroutine stdlib_qsyr(uplo,n,alpha,x,incx,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2414,12 +2414,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qsyr + + pure subroutine stdlib_qsyr2(uplo,n,alpha,x,incx,y,incy,a,lda) !> DSYR2: performs the symmetric rank 2 operation !> A := alpha*x*y**T + alpha*y*x**T + A, !> where alpha is a scalar, x and y are n element vectors and A is an n !> by n symmetric matrix. - - pure subroutine stdlib_qsyr2(uplo,n,alpha,x,incx,y,incy,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2537,6 +2537,8 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qsyr2 + + pure subroutine stdlib_qsyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) !> DSYR2K: performs one of the symmetric rank 2k operations !> C := alpha*A*B**T + alpha*B*A**T + beta*C, !> or @@ -2544,8 +2546,6 @@ module stdlib_linalg_blas_q !> where alpha and beta are scalars, C is an n by n symmetric matrix !> and A and B are n by k matrices in the first case and k by n !> matrices in the second case. - - pure subroutine stdlib_qsyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2712,6 +2712,8 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qsyr2k + + pure subroutine stdlib_qsyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) !> DSYRK: performs one of the symmetric rank k operations !> C := alpha*A*A**T + beta*C, !> or @@ -2719,8 +2721,6 @@ module stdlib_linalg_blas_q !> where alpha and beta are scalars, C is an n by n symmetric matrix !> and A is an n by k matrix in the first case and a k by n matrix !> in the second case. - - pure subroutine stdlib_qsyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2879,12 +2879,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qsyrk + + pure subroutine stdlib_qtbmv(uplo,trans,diag,n,k,a,lda,x,incx) !> DTBMV: performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular band matrix, with ( k + 1 ) diagonals. - - pure subroutine stdlib_qtbmv(uplo,trans,diag,n,k,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3062,6 +3062,8 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qtbmv + + pure subroutine stdlib_qtbsv(uplo,trans,diag,n,k,a,lda,x,incx) !> DTBSV: solves one of the systems of equations !> A*x = b, or A**T*x = b, !> where b and x are n element vectors and A is an n by n unit, or @@ -3069,8 +3071,6 @@ module stdlib_linalg_blas_q !> diagonals. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_qtbsv(uplo,trans,diag,n,k,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3248,12 +3248,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qtbsv + + pure subroutine stdlib_qtpmv(uplo,trans,diag,n,ap,x,incx) !> DTPMV: performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular matrix, supplied in packed form. - - pure subroutine stdlib_qtpmv(uplo,trans,diag,n,ap,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3430,14 +3430,14 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qtpmv + + pure subroutine stdlib_qtpsv(uplo,trans,diag,n,ap,x,incx) !> DTPSV: solves one of the systems of equations !> A*x = b, or A**T*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular matrix, supplied in packed form. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_qtpsv(uplo,trans,diag,n,ap,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3614,13 +3614,13 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qtpsv + + pure subroutine stdlib_qtrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) !> DTRMM: performs one of the matrix-matrix operations !> B := alpha*op( A )*B, or B := alpha*B*op( A ), !> where alpha is a scalar, B is an m by n matrix, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T. - - pure subroutine stdlib_qtrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3820,12 +3820,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qtrmm + + pure subroutine stdlib_qtrmv(uplo,trans,diag,n,a,lda,x,incx) !> DTRMV: performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular matrix. - - pure subroutine stdlib_qtrmv(uplo,trans,diag,n,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3986,14 +3986,14 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qtrmv + + pure subroutine stdlib_qtrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) !> DTRSM: solves one of the matrix equations !> op( A )*X = alpha*B, or X*op( A ) = alpha*B, !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T. !> The matrix X is overwritten on B. - - pure subroutine stdlib_qtrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4217,14 +4217,14 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qtrsm + + pure subroutine stdlib_qtrsv(uplo,trans,diag,n,a,lda,x,incx) !> DTRSV: solves one of the systems of equations !> A*x = b, or A**T*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular matrix. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_qtrsv(uplo,trans,diag,n,a,lda,x,incx) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4385,10 +4385,10 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qtrsv - !> DZASUM: takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and - !> returns a quad precision result. pure real(qp) function stdlib_qzasum(n,zx,incx) + !> DZASUM: takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and + !> returns a quad precision result. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4419,13 +4419,13 @@ module stdlib_linalg_blas_q return end function stdlib_qzasum + + pure function stdlib_qznrm2( n, x, incx ) !> ! !> !> DZNRM2: returns the euclidean norm of a vector via the function !> name, so that !> DZNRM2 := sqrt( x**H*x ) - - pure function stdlib_qznrm2( n, x, incx ) real(qp) :: stdlib_qznrm2 ! -- reference blas level1 routine (version 3.9.1_qp) -- ! -- reference blas is a software package provided by univ. of tennessee, -- diff --git a/src/stdlib_linalg_blas_s.fypp b/src/stdlib_linalg_blas_s.fypp index 504af9d3a..e94087a05 100644 --- a/src/stdlib_linalg_blas_s.fypp +++ b/src/stdlib_linalg_blas_s.fypp @@ -84,10 +84,10 @@ module stdlib_linalg_blas_s contains - !> SASUM: takes the sum of the absolute values. - !> uses unrolled loops for increment equal to one. pure real(sp) function stdlib_sasum(n,sx,incx) + !> SASUM takes the sum of the absolute values. + !> uses unrolled loops for increment equal to one. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -133,10 +133,10 @@ module stdlib_linalg_blas_s return end function stdlib_sasum - !> SAXPY: constant times a vector plus a vector. - !> uses unrolled loops for increments equal to one. pure subroutine stdlib_saxpy(n,sa,sx,incx,sy,incy) + !> SAXPY constant times a vector plus a vector. + !> uses unrolled loops for increments equal to one. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -186,10 +186,10 @@ module stdlib_linalg_blas_s return end subroutine stdlib_saxpy - !> SCASUM: takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and - !> returns a single precision result. pure real(sp) function stdlib_scasum(n,cx,incx) + !> SCASUM takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and + !> returns a single precision result. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -222,13 +222,13 @@ module stdlib_linalg_blas_s return end function stdlib_scasum + + pure function stdlib_scnrm2( n, x, incx ) !> ! !> - !> SCNRM2: returns the euclidean norm of a vector via the function + !> SCNRM2 returns the euclidean norm of a vector via the function !> name, so that !> SCNRM2 := sqrt( x**H*x ) - - pure function stdlib_scnrm2( n, x, incx ) real(sp) :: stdlib_scnrm2 ! -- reference blas level1 routine (version 3.9.1_sp) -- ! -- reference blas is a software package provided by univ. of tennessee, -- @@ -321,10 +321,10 @@ module stdlib_linalg_blas_s return end function stdlib_scnrm2 - !> SCOPY: copies a vector, x, to a vector, y. - !> uses unrolled loops for increments equal to 1. pure subroutine stdlib_scopy(n,sx,incx,sy,incy) + !> SCOPY copies a vector, x, to a vector, y. + !> uses unrolled loops for increments equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -375,10 +375,10 @@ module stdlib_linalg_blas_s return end subroutine stdlib_scopy - !> SDOT: forms the dot product of two vectors. - !> uses unrolled loops for increments equal to one. pure real(sp) function stdlib_sdot(n,sx,incx,sy,incy) + !> SDOT forms the dot product of two vectors. + !> uses unrolled loops for increments equal to one. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -430,14 +430,14 @@ module stdlib_linalg_blas_s return end function stdlib_sdot + + pure real(sp) function stdlib_sdsdot(n,sb,sx,incx,sy,incy) !> Compute the inner product of two vectors with extended !> precision accumulation. !> Returns S.P. result with dot product accumulated in D.P. - !> SDSDOT: = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY), + !> SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY), !> where LX = 1 if INCX >= 0, else LX = 1+(1-N)*INCX, and LY is !> defined in a similar way using INCY. - - pure real(sp) function stdlib_sdsdot(n,sb,sx,incx,sy,incy) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -478,12 +478,12 @@ module stdlib_linalg_blas_s return end function stdlib_sdsdot - !> SGBMV: performs one of the matrix-vector operations + + pure subroutine stdlib_sgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) + !> SGBMV performs one of the matrix-vector operations !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, !> where alpha and beta are scalars, x and y are vectors and A is an !> m by n band matrix, with kl sub-diagonals and ku super-diagonals. - - pure subroutine stdlib_sgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -633,14 +633,14 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sgbmv - !> SGEMM: performs one of the matrix-matrix operations + + pure subroutine stdlib_sgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) + !> SGEMM performs one of the matrix-matrix operations !> C := alpha*op( A )*op( B ) + beta*C, !> where op( X ) is one of !> op( X ) = X or op( X ) = X**T, !> alpha and beta are scalars, and A, B and C are matrices, with op( A ) !> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. - - pure subroutine stdlib_sgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -796,12 +796,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sgemm - !> SGEMV: performs one of the matrix-vector operations + + pure subroutine stdlib_sgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) + !> SGEMV performs one of the matrix-vector operations !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, !> where alpha and beta are scalars, x and y are vectors and A is an !> m by n matrix. - - pure subroutine stdlib_sgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -940,12 +940,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sgemv - !> SGER: performs the rank 1 operation + + pure subroutine stdlib_sger(m,n,alpha,x,incx,y,incy,a,lda) + !> SGER performs the rank 1 operation !> A := alpha*x*y**T + A, !> where alpha is a scalar, x is an m element vector, y is an n element !> vector and A is an m by n matrix. - - pure subroutine stdlib_sger(m,n,alpha,x,incx,y,incy,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1019,13 +1019,13 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sger + + pure function stdlib_snrm2( n, x, incx ) !> ! !> - !> SNRM2: returns the euclidean norm of a vector via the function + !> SNRM2 returns the euclidean norm of a vector via the function !> name, so that !> SNRM2 := sqrt( x'*x ). - - pure function stdlib_snrm2( n, x, incx ) real(sp) :: stdlib_snrm2 ! -- reference blas level1 routine (version 3.9.1_sp) -- ! -- reference blas is a software package provided by univ. of tennessee, -- @@ -1109,9 +1109,9 @@ module stdlib_linalg_blas_s return end function stdlib_snrm2 - !> applies a plane rotation. pure subroutine stdlib_srot(n,sx,incx,sy,incy,c,s) + !> applies a plane rotation. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1150,6 +1150,8 @@ module stdlib_linalg_blas_s return end subroutine stdlib_srot + + pure subroutine stdlib_srotg( a, b, c, s ) !> ! !> !> The computation uses the formulas @@ -1166,8 +1168,6 @@ module stdlib_linalg_blas_s !> If z = 1, set c = 0, s = 1. !> If |z| < 1, set c = sqrt(1 - z**2) and s = z. !> If |z| > 1, set c = 1/z and s = sqrt( 1 - c**2). - - pure subroutine stdlib_srotg( a, b, c, s ) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1213,6 +1213,8 @@ module stdlib_linalg_blas_s return end subroutine stdlib_srotg + + pure subroutine stdlib_srotm(n,sx,incx,sy,incy,sparam) !> APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX !> (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN !> (SX**T) @@ -1224,8 +1226,6 @@ module stdlib_linalg_blas_s !> H=( ) ( ) ( ) ( ) !> (SH21 SH22), (SH21 1._sp), (-1._sp SH22), (0._sp 1._sp). !> SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM. - - pure subroutine stdlib_srotm(n,sx,incx,sy,incy,sparam) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1320,6 +1320,8 @@ module stdlib_linalg_blas_s return end subroutine stdlib_srotm + + pure subroutine stdlib_srotmg(sd1,sd2,sx1,sy1,sparam) !> CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS !> THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(SD1)*SX1,SQRT(SD2) SY2)**T. !> WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. @@ -1333,8 +1335,6 @@ module stdlib_linalg_blas_s !> THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE !> INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE !> OF SD1 AND SD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. - - pure subroutine stdlib_srotmg(sd1,sd2,sx1,sy1,sparam) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1486,12 +1486,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_srotmg - !> SSBMV: performs the matrix-vector operation + + pure subroutine stdlib_ssbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) + !> SSBMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric band matrix, with k super-diagonals. - - pure subroutine stdlib_ssbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1648,10 +1648,10 @@ module stdlib_linalg_blas_s return end subroutine stdlib_ssbmv - !> SSCAL: scales a vector by a constant. - !> uses unrolled loops for increment equal to 1. pure subroutine stdlib_sscal(n,sa,sx,incx) + !> SSCAL scales a vector by a constant. + !> uses unrolled loops for increment equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1694,12 +1694,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sscal - !> SSPMV: performs the matrix-vector operation + + pure subroutine stdlib_sspmv(uplo,n,alpha,ap,x,incx,beta,y,incy) + !> SSPMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix, supplied in packed form. - - pure subroutine stdlib_sspmv(uplo,n,alpha,ap,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1850,12 +1850,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sspmv - !> SSPR: performs the symmetric rank 1 operation + + pure subroutine stdlib_sspr(uplo,n,alpha,x,incx,ap) + !> SSPR performs the symmetric rank 1 operation !> A := alpha*x*x**T + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n symmetric matrix, supplied in packed form. - - pure subroutine stdlib_sspr(uplo,n,alpha,x,incx,ap) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1957,12 +1957,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sspr - !> SSPR2: performs the symmetric rank 2 operation + + pure subroutine stdlib_sspr2(uplo,n,alpha,x,incx,y,incy,ap) + !> SSPR2 performs the symmetric rank 2 operation !> A := alpha*x*y**T + alpha*y*x**T + A, !> where alpha is a scalar, x and y are n element vectors and A is an !> n by n symmetric matrix, supplied in packed form. - - pure subroutine stdlib_sspr2(uplo,n,alpha,x,incx,y,incy,ap) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2084,10 +2084,10 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sspr2 - !> SSWAP: interchanges two vectors. - !> uses unrolled loops for increments equal to 1. pure subroutine stdlib_sswap(n,sx,incx,sy,incy) + !> SSWAP interchanges two vectors. + !> uses unrolled loops for increments equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2144,14 +2144,14 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sswap - !> SSYMM: performs one of the matrix-matrix operations + + pure subroutine stdlib_ssymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) + !> SSYMM performs one of the matrix-matrix operations !> C := alpha*A*B + beta*C, !> or !> C := alpha*B*A + beta*C, !> where alpha and beta are scalars, A is a symmetric matrix and B and !> C are m by n matrices. - - pure subroutine stdlib_ssymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2291,12 +2291,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_ssymm - !> SSYMV: performs the matrix-vector operation + + pure subroutine stdlib_ssymv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) + !> SSYMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix. - - pure subroutine stdlib_ssymv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2443,12 +2443,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_ssymv - !> SSYR: performs the symmetric rank 1 operation + + pure subroutine stdlib_ssyr(uplo,n,alpha,x,incx,a,lda) + !> SSYR performs the symmetric rank 1 operation !> A := alpha*x*x**T + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n symmetric matrix. - - pure subroutine stdlib_ssyr(uplo,n,alpha,x,incx,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2546,12 +2546,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_ssyr - !> SSYR2: performs the symmetric rank 2 operation + + pure subroutine stdlib_ssyr2(uplo,n,alpha,x,incx,y,incy,a,lda) + !> SSYR2 performs the symmetric rank 2 operation !> A := alpha*x*y**T + alpha*y*x**T + A, !> where alpha is a scalar, x and y are n element vectors and A is an n !> by n symmetric matrix. - - pure subroutine stdlib_ssyr2(uplo,n,alpha,x,incx,y,incy,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2669,15 +2669,15 @@ module stdlib_linalg_blas_s return end subroutine stdlib_ssyr2 - !> SSYR2K: performs one of the symmetric rank 2k operations + + pure subroutine stdlib_ssyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) + !> SSYR2K performs one of the symmetric rank 2k operations !> C := alpha*A*B**T + alpha*B*A**T + beta*C, !> or !> C := alpha*A**T*B + alpha*B**T*A + beta*C, !> where alpha and beta are scalars, C is an n by n symmetric matrix !> and A and B are n by k matrices in the first case and k by n !> matrices in the second case. - - pure subroutine stdlib_ssyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2844,15 +2844,15 @@ module stdlib_linalg_blas_s return end subroutine stdlib_ssyr2k - !> SSYRK: performs one of the symmetric rank k operations + + pure subroutine stdlib_ssyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) + !> SSYRK performs one of the symmetric rank k operations !> C := alpha*A*A**T + beta*C, !> or !> C := alpha*A**T*A + beta*C, !> where alpha and beta are scalars, C is an n by n symmetric matrix !> and A is an n by k matrix in the first case and a k by n matrix !> in the second case. - - pure subroutine stdlib_ssyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3011,12 +3011,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_ssyrk - !> STBMV: performs one of the matrix-vector operations + + pure subroutine stdlib_stbmv(uplo,trans,diag,n,k,a,lda,x,incx) + !> STBMV performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular band matrix, with ( k + 1 ) diagonals. - - pure subroutine stdlib_stbmv(uplo,trans,diag,n,k,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3194,15 +3194,15 @@ module stdlib_linalg_blas_s return end subroutine stdlib_stbmv - !> STBSV: solves one of the systems of equations + + pure subroutine stdlib_stbsv(uplo,trans,diag,n,k,a,lda,x,incx) + !> STBSV solves one of the systems of equations !> A*x = b, or A**T*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular band matrix, with ( k + 1 ) !> diagonals. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_stbsv(uplo,trans,diag,n,k,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3380,12 +3380,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_stbsv - !> STPMV: performs one of the matrix-vector operations + + pure subroutine stdlib_stpmv(uplo,trans,diag,n,ap,x,incx) + !> STPMV performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular matrix, supplied in packed form. - - pure subroutine stdlib_stpmv(uplo,trans,diag,n,ap,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3562,14 +3562,14 @@ module stdlib_linalg_blas_s return end subroutine stdlib_stpmv - !> STPSV: solves one of the systems of equations + + pure subroutine stdlib_stpsv(uplo,trans,diag,n,ap,x,incx) + !> STPSV solves one of the systems of equations !> A*x = b, or A**T*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular matrix, supplied in packed form. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_stpsv(uplo,trans,diag,n,ap,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3746,13 +3746,13 @@ module stdlib_linalg_blas_s return end subroutine stdlib_stpsv - !> STRMM: performs one of the matrix-matrix operations + + pure subroutine stdlib_strmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) + !> STRMM performs one of the matrix-matrix operations !> B := alpha*op( A )*B, or B := alpha*B*op( A ), !> where alpha is a scalar, B is an m by n matrix, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T. - - pure subroutine stdlib_strmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3952,12 +3952,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_strmm - !> STRMV: performs one of the matrix-vector operations + + pure subroutine stdlib_strmv(uplo,trans,diag,n,a,lda,x,incx) + !> STRMV performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular matrix. - - pure subroutine stdlib_strmv(uplo,trans,diag,n,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4118,14 +4118,14 @@ module stdlib_linalg_blas_s return end subroutine stdlib_strmv - !> STRSM: solves one of the matrix equations + + pure subroutine stdlib_strsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) + !> STRSM solves one of the matrix equations !> op( A )*X = alpha*B, or X*op( A ) = alpha*B, !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T. !> The matrix X is overwritten on B. - - pure subroutine stdlib_strsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4349,14 +4349,14 @@ module stdlib_linalg_blas_s return end subroutine stdlib_strsm - !> STRSV: solves one of the systems of equations + + pure subroutine stdlib_strsv(uplo,trans,diag,n,a,lda,x,incx) + !> STRSV solves one of the systems of equations !> A*x = b, or A**T*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular matrix. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_strsv(uplo,trans,diag,n,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_blas_w.fypp b/src/stdlib_linalg_blas_w.fypp index 841dd9aee..3b55f4cab 100644 --- a/src/stdlib_linalg_blas_w.fypp +++ b/src/stdlib_linalg_blas_w.fypp @@ -89,9 +89,9 @@ module stdlib_linalg_blas_w contains - !> ZAXPY: constant times a vector plus a vector. pure subroutine stdlib_waxpy(n,za,zx,incx,zy,incy) + !> ZAXPY: constant times a vector plus a vector. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -127,9 +127,9 @@ module stdlib_linalg_blas_w return end subroutine stdlib_waxpy - !> ZCOPY: copies a vector, x, to a vector, y. pure subroutine stdlib_wcopy(n,zx,incx,zy,incy) + !> ZCOPY: copies a vector, x, to a vector, y. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -163,10 +163,10 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wcopy - !> ZDOTC: forms the dot product of two complex vectors - !> ZDOTC = X^H * Y pure complex(qp) function stdlib_wdotc(n,zx,incx,zy,incy) + !> ZDOTC: forms the dot product of two complex vectors + !> ZDOTC = X^H * Y ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -205,10 +205,10 @@ module stdlib_linalg_blas_w return end function stdlib_wdotc - !> ZDOTU: forms the dot product of two complex vectors - !> ZDOTU = X^T * Y pure complex(qp) function stdlib_wdotu(n,zx,incx,zy,incy) + !> ZDOTU: forms the dot product of two complex vectors + !> ZDOTU = X^T * Y ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -245,11 +245,11 @@ module stdlib_linalg_blas_w return end function stdlib_wdotu + + pure subroutine stdlib_wdrot( n, zx, incx, zy, incy, c, s ) !> Applies a plane rotation, where the cos and sin (c and s) are real !> and the vectors cx and cy are complex. !> jack dongarra, linpack, 3/11/78. - - pure subroutine stdlib_wdrot( n, zx, incx, zy, incy, c, s ) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -289,9 +289,9 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wdrot - !> ZDSCAL: scales a vector by a constant. pure subroutine stdlib_wdscal(n,da,zx,incx) + !> ZDSCAL: scales a vector by a constant. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -321,13 +321,13 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wdscal + + pure subroutine stdlib_wgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) !> ZGBMV: performs one of the matrix-vector operations !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or !> y := alpha*A**H*x + beta*y, !> where alpha and beta are scalars, x and y are vectors and A is an !> m by n band matrix, with kl sub-diagonals and ku super-diagonals. - - pure subroutine stdlib_wgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -493,14 +493,14 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wgbmv + + pure subroutine stdlib_wgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) !> ZGEMM: performs one of the matrix-matrix operations !> C := alpha*op( A )*op( B ) + beta*C, !> where op( X ) is one of !> op( X ) = X or op( X ) = X**T or op( X ) = X**H, !> alpha and beta are scalars, and A, B and C are matrices, with op( A ) !> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. - - pure subroutine stdlib_wgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -742,13 +742,13 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wgemm + + pure subroutine stdlib_wgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) !> ZGEMV: performs one of the matrix-vector operations !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or !> y := alpha*A**H*x + beta*y, !> where alpha and beta are scalars, x and y are vectors and A is an !> m by n matrix. - - pure subroutine stdlib_wgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -903,12 +903,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wgemv + + pure subroutine stdlib_wgerc(m,n,alpha,x,incx,y,incy,a,lda) !> ZGERC: performs the rank 1 operation !> A := alpha*x*y**H + A, !> where alpha is a scalar, x is an m element vector, y is an n element !> vector and A is an m by n matrix. - - pure subroutine stdlib_wgerc(m,n,alpha,x,incx,y,incy,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -982,12 +982,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wgerc + + pure subroutine stdlib_wgeru(m,n,alpha,x,incx,y,incy,a,lda) !> ZGERU: performs the rank 1 operation !> A := alpha*x*y**T + A, !> where alpha is a scalar, x is an m element vector, y is an n element !> vector and A is an m by n matrix. - - pure subroutine stdlib_wgeru(m,n,alpha,x,incx,y,incy,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1061,12 +1061,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wgeru + + pure subroutine stdlib_whbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) !> ZHBMV: performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n hermitian band matrix, with k super-diagonals. - - pure subroutine stdlib_whbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1224,14 +1224,14 @@ module stdlib_linalg_blas_w return end subroutine stdlib_whbmv + + pure subroutine stdlib_whemm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) !> ZHEMM: performs one of the matrix-matrix operations !> C := alpha*A*B + beta*C, !> or !> C := alpha*B*A + beta*C, !> where alpha and beta are scalars, A is an hermitian matrix and B and !> C are m by n matrices. - - pure subroutine stdlib_whemm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1374,12 +1374,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_whemm + + pure subroutine stdlib_whemv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) !> ZHEMV: performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n hermitian matrix. - - pure subroutine stdlib_whemv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1527,12 +1527,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_whemv + + pure subroutine stdlib_wher(uplo,n,alpha,x,incx,a,lda) !> ZHER: performs the hermitian rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n hermitian matrix. - - pure subroutine stdlib_wher(uplo,n,alpha,x,incx,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1642,12 +1642,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wher + + pure subroutine stdlib_wher2(uplo,n,alpha,x,incx,y,incy,a,lda) !> ZHER2: performs the hermitian rank 2 operation !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, !> where alpha is a scalar, x and y are n element vectors and A is an n !> by n hermitian matrix. - - pure subroutine stdlib_wher2(uplo,n,alpha,x,incx,y,incy,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1781,6 +1781,8 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wher2 + + pure subroutine stdlib_wher2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) !> ZHER2K: performs one of the hermitian rank 2k operations !> C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C, !> or @@ -1788,8 +1790,6 @@ module stdlib_linalg_blas_w !> where alpha and beta are scalars with beta real, C is an n by n !> hermitian matrix and A and B are n by k matrices in the first case !> and k by n matrices in the second case. - - pure subroutine stdlib_wher2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1990,6 +1990,8 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wher2k + + pure subroutine stdlib_wherk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) !> ZHERK: performs one of the hermitian rank k operations !> C := alpha*A*A**H + beta*C, !> or @@ -1997,8 +1999,6 @@ module stdlib_linalg_blas_w !> 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. - - pure subroutine stdlib_wherk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2186,12 +2186,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wherk + + pure subroutine stdlib_whpmv(uplo,n,alpha,ap,x,incx,beta,y,incy) !> ZHPMV: performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n hermitian matrix, supplied in packed form. - - pure subroutine stdlib_whpmv(uplo,n,alpha,ap,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2345,12 +2345,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_whpmv + + pure subroutine stdlib_whpr(uplo,n,alpha,x,incx,ap) !> ZHPR: performs the hermitian rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n hermitian matrix, supplied in packed form. - - pure subroutine stdlib_whpr(uplo,n,alpha,x,incx,ap) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2467,12 +2467,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_whpr + + pure subroutine stdlib_whpr2(uplo,n,alpha,x,incx,y,incy,ap) !> ZHPR2: performs the hermitian rank 2 operation !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, !> where alpha is a scalar, x and y are n element vectors and A is an !> n by n hermitian matrix, supplied in packed form. - - pure subroutine stdlib_whpr2(uplo,n,alpha,x,incx,y,incy,ap) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2612,6 +2612,8 @@ module stdlib_linalg_blas_w return end subroutine stdlib_whpr2 + + pure subroutine stdlib_wrotg( a, b, c, s ) !> ! !> !> The computation uses the formulas @@ -2627,8 +2629,6 @@ module stdlib_linalg_blas_w !> the same as in DROTG when |a| > |b|. When |b| >= |a|, the !> sign of c and s will be different from those computed by DROTG !> if the signs of a and b are not the same. - - pure subroutine stdlib_wrotg( a, b, c, s ) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2729,9 +2729,9 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wrotg - !> ZSCAL: scales a vector by a constant. pure subroutine stdlib_wscal(n,za,zx,incx) + !> ZSCAL: scales a vector by a constant. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2759,9 +2759,9 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wscal - !> ZSWAP: interchanges two vectors. pure subroutine stdlib_wswap(n,zx,incx,zy,incy) + !> ZSWAP: interchanges two vectors. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2799,14 +2799,14 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wswap + + pure subroutine stdlib_wsymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) !> ZSYMM: performs one of the matrix-matrix operations !> C := alpha*A*B + beta*C, !> or !> C := alpha*B*A + beta*C, !> where alpha and beta are scalars, A is a symmetric matrix and B and !> C are m by n matrices. - - pure subroutine stdlib_wsymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2947,6 +2947,8 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wsymm + + pure subroutine stdlib_wsyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) !> ZSYR2K: performs one of the symmetric rank 2k operations !> C := alpha*A*B**T + alpha*B*A**T + beta*C, !> or @@ -2954,8 +2956,6 @@ module stdlib_linalg_blas_w !> where alpha and beta are scalars, C is an n by n symmetric matrix !> and A and B are n by k matrices in the first case and k by n !> matrices in the second case. - - pure subroutine stdlib_wsyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3123,6 +3123,8 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wsyr2k + + pure subroutine stdlib_wsyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) !> ZSYRK: performs one of the symmetric rank k operations !> C := alpha*A*A**T + beta*C, !> or @@ -3130,8 +3132,6 @@ module stdlib_linalg_blas_w !> where alpha and beta are scalars, C is an n by n symmetric matrix !> and A is an n by k matrix in the first case and a k by n matrix !> in the second case. - - pure subroutine stdlib_wsyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3291,12 +3291,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wsyrk + + pure subroutine stdlib_wtbmv(uplo,trans,diag,n,k,a,lda,x,incx) !> ZTBMV: performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, or x := A**H*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular band matrix, with ( k + 1 ) diagonals. - - pure subroutine stdlib_wtbmv(uplo,trans,diag,n,k,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3505,6 +3505,8 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wtbmv + + pure subroutine stdlib_wtbsv(uplo,trans,diag,n,k,a,lda,x,incx) !> ZTBSV: solves one of the systems of equations !> A*x = b, or A**T*x = b, or A**H*x = b, !> where b and x are n element vectors and A is an n by n unit, or @@ -3512,8 +3514,6 @@ module stdlib_linalg_blas_w !> diagonals. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_wtbsv(uplo,trans,diag,n,k,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3722,12 +3722,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wtbsv + + pure subroutine stdlib_wtpmv(uplo,trans,diag,n,ap,x,incx) !> ZTPMV: performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, or x := A**H*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular matrix, supplied in packed form. - - pure subroutine stdlib_wtpmv(uplo,trans,diag,n,ap,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3939,14 +3939,14 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wtpmv + + pure subroutine stdlib_wtpsv(uplo,trans,diag,n,ap,x,incx) !> ZTPSV: solves one of the systems of equations !> A*x = b, or A**T*x = b, or A**H*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular matrix, supplied in packed form. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_wtpsv(uplo,trans,diag,n,ap,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4158,13 +4158,13 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wtpsv + + pure subroutine stdlib_wtrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) !> ZTRMM: performs one of the matrix-matrix operations !> B := alpha*op( A )*B, or B := alpha*B*op( A ) !> where alpha is a scalar, B is an m by n matrix, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. - - pure subroutine stdlib_wtrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4400,12 +4400,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wtrmm + + pure subroutine stdlib_wtrmv(uplo,trans,diag,n,a,lda,x,incx) !> ZTRMV: performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, or x := A**H*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular matrix. - - pure subroutine stdlib_wtrmv(uplo,trans,diag,n,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4597,14 +4597,14 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wtrmv + + pure subroutine stdlib_wtrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) !> ZTRSM: solves one of the matrix equations !> op( A )*X = alpha*B, or X*op( A ) = alpha*B, !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. !> The matrix X is overwritten on B. - - pure subroutine stdlib_wtrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4862,14 +4862,14 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wtrsm + + pure subroutine stdlib_wtrsv(uplo,trans,diag,n,a,lda,x,incx) !> ZTRSV: solves one of the systems of equations !> A*x = b, or A**T*x = b, or A**H*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular matrix. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_wtrsv(uplo,trans,diag,n,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_blas_z.fypp b/src/stdlib_linalg_blas_z.fypp index 00e4e3181..d0b344ec2 100644 --- a/src/stdlib_linalg_blas_z.fypp +++ b/src/stdlib_linalg_blas_z.fypp @@ -86,9 +86,9 @@ module stdlib_linalg_blas_z contains - !> ZAXPY: constant times a vector plus a vector. pure subroutine stdlib_zaxpy(n,za,zx,incx,zy,incy) + !> ZAXPY constant times a vector plus a vector. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -124,9 +124,9 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zaxpy - !> ZCOPY: copies a vector, x, to a vector, y. pure subroutine stdlib_zcopy(n,zx,incx,zy,incy) + !> ZCOPY copies a vector, x, to a vector, y. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -160,10 +160,10 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zcopy - !> ZDOTC: forms the dot product of two complex vectors - !> ZDOTC = X^H * Y pure complex(dp) function stdlib_zdotc(n,zx,incx,zy,incy) + !> ZDOTC forms the dot product of two complex vectors + !> ZDOTC = X^H * Y ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -202,10 +202,10 @@ module stdlib_linalg_blas_z return end function stdlib_zdotc - !> ZDOTU: forms the dot product of two complex vectors - !> ZDOTU = X^T * Y pure complex(dp) function stdlib_zdotu(n,zx,incx,zy,incy) + !> ZDOTU forms the dot product of two complex vectors + !> ZDOTU = X^T * Y ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -242,11 +242,11 @@ module stdlib_linalg_blas_z return end function stdlib_zdotu + + pure subroutine stdlib_zdrot( n, zx, incx, zy, incy, c, s ) !> Applies a plane rotation, where the cos and sin (c and s) are real !> and the vectors cx and cy are complex. !> jack dongarra, linpack, 3/11/78. - - pure subroutine stdlib_zdrot( n, zx, incx, zy, incy, c, s ) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -286,9 +286,9 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zdrot - !> ZDSCAL: scales a vector by a constant. pure subroutine stdlib_zdscal(n,da,zx,incx) + !> ZDSCAL scales a vector by a constant. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -318,13 +318,13 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zdscal - !> ZGBMV: performs one of the matrix-vector operations + + pure subroutine stdlib_zgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) + !> ZGBMV performs one of the matrix-vector operations !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or !> y := alpha*A**H*x + beta*y, !> where alpha and beta are scalars, x and y are vectors and A is an !> m by n band matrix, with kl sub-diagonals and ku super-diagonals. - - pure subroutine stdlib_zgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -490,14 +490,14 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zgbmv - !> ZGEMM: performs one of the matrix-matrix operations + + pure subroutine stdlib_zgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) + !> ZGEMM performs one of the matrix-matrix operations !> C := alpha*op( A )*op( B ) + beta*C, !> where op( X ) is one of !> op( X ) = X or op( X ) = X**T or op( X ) = X**H, !> alpha and beta are scalars, and A, B and C are matrices, with op( A ) !> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. - - pure subroutine stdlib_zgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -739,13 +739,13 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zgemm - !> ZGEMV: performs one of the matrix-vector operations + + pure subroutine stdlib_zgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) + !> ZGEMV performs one of the matrix-vector operations !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or !> y := alpha*A**H*x + beta*y, !> where alpha and beta are scalars, x and y are vectors and A is an !> m by n matrix. - - pure subroutine stdlib_zgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -900,12 +900,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zgemv - !> ZGERC: performs the rank 1 operation + + pure subroutine stdlib_zgerc(m,n,alpha,x,incx,y,incy,a,lda) + !> ZGERC performs the rank 1 operation !> A := alpha*x*y**H + A, !> where alpha is a scalar, x is an m element vector, y is an n element !> vector and A is an m by n matrix. - - pure subroutine stdlib_zgerc(m,n,alpha,x,incx,y,incy,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -979,12 +979,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zgerc - !> ZGERU: performs the rank 1 operation + + pure subroutine stdlib_zgeru(m,n,alpha,x,incx,y,incy,a,lda) + !> ZGERU performs the rank 1 operation !> A := alpha*x*y**T + A, !> where alpha is a scalar, x is an m element vector, y is an n element !> vector and A is an m by n matrix. - - pure subroutine stdlib_zgeru(m,n,alpha,x,incx,y,incy,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1058,12 +1058,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zgeru - !> ZHBMV: performs the matrix-vector operation + + pure subroutine stdlib_zhbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) + !> ZHBMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n hermitian band matrix, with k super-diagonals. - - pure subroutine stdlib_zhbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1221,14 +1221,14 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zhbmv - !> ZHEMM: performs one of the matrix-matrix operations + + pure subroutine stdlib_zhemm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) + !> ZHEMM performs one of the matrix-matrix operations !> C := alpha*A*B + beta*C, !> or !> C := alpha*B*A + beta*C, !> where alpha and beta are scalars, A is an hermitian matrix and B and !> C are m by n matrices. - - pure subroutine stdlib_zhemm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1371,12 +1371,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zhemm - !> ZHEMV: performs the matrix-vector operation + + pure subroutine stdlib_zhemv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) + !> ZHEMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n hermitian matrix. - - pure subroutine stdlib_zhemv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1524,12 +1524,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zhemv - !> ZHER: performs the hermitian rank 1 operation + + pure subroutine stdlib_zher(uplo,n,alpha,x,incx,a,lda) + !> ZHER performs the hermitian rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n hermitian matrix. - - pure subroutine stdlib_zher(uplo,n,alpha,x,incx,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1639,12 +1639,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zher - !> ZHER2: performs the hermitian rank 2 operation + + pure subroutine stdlib_zher2(uplo,n,alpha,x,incx,y,incy,a,lda) + !> ZHER2 performs the hermitian rank 2 operation !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, !> where alpha is a scalar, x and y are n element vectors and A is an n !> by n hermitian matrix. - - pure subroutine stdlib_zher2(uplo,n,alpha,x,incx,y,incy,a,lda) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1778,15 +1778,15 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zher2 - !> ZHER2K: performs one of the hermitian rank 2k operations + + pure subroutine stdlib_zher2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) + !> ZHER2K performs one of the hermitian rank 2k operations !> C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C, !> or !> C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C, !> where alpha and beta are scalars with beta real, C is an n by n !> hermitian matrix and A and B are n by k matrices in the first case !> and k by n matrices in the second case. - - pure subroutine stdlib_zher2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1987,15 +1987,15 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zher2k - !> ZHERK: performs one of the hermitian rank k operations + + pure subroutine stdlib_zherk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) + !> ZHERK 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. - - pure subroutine stdlib_zherk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2183,12 +2183,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zherk - !> ZHPMV: performs the matrix-vector operation + + pure subroutine stdlib_zhpmv(uplo,n,alpha,ap,x,incx,beta,y,incy) + !> ZHPMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n hermitian matrix, supplied in packed form. - - pure subroutine stdlib_zhpmv(uplo,n,alpha,ap,x,incx,beta,y,incy) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2342,12 +2342,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zhpmv - !> ZHPR: performs the hermitian rank 1 operation + + pure subroutine stdlib_zhpr(uplo,n,alpha,x,incx,ap) + !> ZHPR performs the hermitian rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a real scalar, x is an n element vector and A is an !> n by n hermitian matrix, supplied in packed form. - - pure subroutine stdlib_zhpr(uplo,n,alpha,x,incx,ap) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2464,12 +2464,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zhpr - !> ZHPR2: performs the hermitian rank 2 operation + + pure subroutine stdlib_zhpr2(uplo,n,alpha,x,incx,y,incy,ap) + !> ZHPR2 performs the hermitian rank 2 operation !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, !> where alpha is a scalar, x and y are n element vectors and A is an !> n by n hermitian matrix, supplied in packed form. - - pure subroutine stdlib_zhpr2(uplo,n,alpha,x,incx,y,incy,ap) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2609,6 +2609,8 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zhpr2 + + pure subroutine stdlib_zrotg( a, b, c, s ) !> ! !> !> The computation uses the formulas @@ -2624,8 +2626,6 @@ module stdlib_linalg_blas_z !> the same as in DROTG when |a| > |b|. When |b| >= |a|, the !> sign of c and s will be different from those computed by DROTG !> if the signs of a and b are not the same. - - pure subroutine stdlib_zrotg( a, b, c, s ) ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2726,9 +2726,9 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zrotg - !> ZSCAL: scales a vector by a constant. pure subroutine stdlib_zscal(n,za,zx,incx) + !> ZSCAL scales a vector by a constant. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2756,9 +2756,9 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zscal - !> ZSWAP: interchanges two vectors. pure subroutine stdlib_zswap(n,zx,incx,zy,incy) + !> ZSWAP interchanges two vectors. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2796,14 +2796,14 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zswap - !> ZSYMM: performs one of the matrix-matrix operations + + pure subroutine stdlib_zsymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) + !> ZSYMM performs one of the matrix-matrix operations !> C := alpha*A*B + beta*C, !> or !> C := alpha*B*A + beta*C, !> where alpha and beta are scalars, A is a symmetric matrix and B and !> C are m by n matrices. - - pure subroutine stdlib_zsymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2944,15 +2944,15 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zsymm - !> ZSYR2K: performs one of the symmetric rank 2k operations + + pure subroutine stdlib_zsyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) + !> ZSYR2K performs one of the symmetric rank 2k operations !> C := alpha*A*B**T + alpha*B*A**T + beta*C, !> or !> C := alpha*A**T*B + alpha*B**T*A + beta*C, !> where alpha and beta are scalars, C is an n by n symmetric matrix !> and A and B are n by k matrices in the first case and k by n !> matrices in the second case. - - pure subroutine stdlib_zsyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3120,15 +3120,15 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zsyr2k - !> ZSYRK: performs one of the symmetric rank k operations + + pure subroutine stdlib_zsyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) + !> ZSYRK performs one of the symmetric rank k operations !> C := alpha*A*A**T + beta*C, !> or !> C := alpha*A**T*A + beta*C, !> where alpha and beta are scalars, C is an n by n symmetric matrix !> and A is an n by k matrix in the first case and a k by n matrix !> in the second case. - - pure subroutine stdlib_zsyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3288,12 +3288,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zsyrk - !> ZTBMV: performs one of the matrix-vector operations + + pure subroutine stdlib_ztbmv(uplo,trans,diag,n,k,a,lda,x,incx) + !> ZTBMV performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, or x := A**H*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular band matrix, with ( k + 1 ) diagonals. - - pure subroutine stdlib_ztbmv(uplo,trans,diag,n,k,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3502,15 +3502,15 @@ module stdlib_linalg_blas_z return end subroutine stdlib_ztbmv - !> ZTBSV: solves one of the systems of equations + + pure subroutine stdlib_ztbsv(uplo,trans,diag,n,k,a,lda,x,incx) + !> ZTBSV solves one of the systems of equations !> A*x = b, or A**T*x = b, or A**H*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular band matrix, with ( k + 1 ) !> diagonals. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_ztbsv(uplo,trans,diag,n,k,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3719,12 +3719,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_ztbsv - !> ZTPMV: performs one of the matrix-vector operations + + pure subroutine stdlib_ztpmv(uplo,trans,diag,n,ap,x,incx) + !> ZTPMV performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, or x := A**H*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular matrix, supplied in packed form. - - pure subroutine stdlib_ztpmv(uplo,trans,diag,n,ap,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3936,14 +3936,14 @@ module stdlib_linalg_blas_z return end subroutine stdlib_ztpmv - !> ZTPSV: solves one of the systems of equations + + pure subroutine stdlib_ztpsv(uplo,trans,diag,n,ap,x,incx) + !> ZTPSV solves one of the systems of equations !> A*x = b, or A**T*x = b, or A**H*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular matrix, supplied in packed form. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_ztpsv(uplo,trans,diag,n,ap,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4155,13 +4155,13 @@ module stdlib_linalg_blas_z return end subroutine stdlib_ztpsv - !> ZTRMM: performs one of the matrix-matrix operations + + pure subroutine stdlib_ztrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) + !> ZTRMM performs one of the matrix-matrix operations !> B := alpha*op( A )*B, or B := alpha*B*op( A ) !> where alpha is a scalar, B is an m by n matrix, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. - - pure subroutine stdlib_ztrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4397,12 +4397,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_ztrmm - !> ZTRMV: performs one of the matrix-vector operations + + pure subroutine stdlib_ztrmv(uplo,trans,diag,n,a,lda,x,incx) + !> ZTRMV performs one of the matrix-vector operations !> x := A*x, or x := A**T*x, or x := A**H*x, !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular matrix. - - pure subroutine stdlib_ztrmv(uplo,trans,diag,n,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4594,14 +4594,14 @@ module stdlib_linalg_blas_z return end subroutine stdlib_ztrmv - !> ZTRSM: solves one of the matrix equations + + pure subroutine stdlib_ztrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) + !> ZTRSM solves one of the matrix equations !> op( A )*X = alpha*B, or X*op( A ) = alpha*B, !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. !> The matrix X is overwritten on B. - - pure subroutine stdlib_ztrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4859,14 +4859,14 @@ module stdlib_linalg_blas_z return end subroutine stdlib_ztrsm - !> ZTRSV: solves one of the systems of equations + + pure subroutine stdlib_ztrsv(uplo,trans,diag,n,a,lda,x,incx) + !> ZTRSV solves one of the systems of equations !> A*x = b, or A**T*x = b, or A**H*x = b, !> where b and x are n element vectors and A is an n by n unit, or !> non-unit, upper or lower triangular matrix. !> No test for singularity or near-singularity is included in this !> routine. Such tests must be performed before calling this routine. - - pure subroutine stdlib_ztrsv(uplo,trans,diag,n,a,lda,x,incx) ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_lapack.fypp b/src/stdlib_linalg_lapack.fypp index 46c299ec7..868647d76 100644 --- a/src/stdlib_linalg_lapack.fypp +++ b/src/stdlib_linalg_lapack.fypp @@ -16,7 +16,8 @@ module stdlib_linalg_lapack implicit none(type,external) public - !> BBCSD: computes the CS decomposition of a unitary matrix in + interface bbcsd + !> BBCSD computes the CS decomposition of a unitary matrix in !> bidiagonal-block form, !> [ B11 | B12 0 0 ] !> [ 0 | 0 -I 0 ] @@ -37,7 +38,6 @@ module stdlib_linalg_lapack !> 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. - interface bbcsd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cbbcsd( 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,& @@ -118,7 +118,8 @@ module stdlib_linalg_lapack - !> BDSDC: computes the singular value decomposition (SVD) of a real + 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 @@ -134,7 +135,6 @@ module stdlib_linalg_lapack !> 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. - interface bdsdc #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dbdsdc( uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq,work, iwork, & info ) @@ -170,7 +170,8 @@ module stdlib_linalg_lapack - !> BDSQR: computes the singular values and, optionally, the right and/or + 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 @@ -194,7 +195,6 @@ module stdlib_linalg_lapack !> 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. - interface bdsqr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, & rwork, info ) @@ -263,7 +263,8 @@ module stdlib_linalg_lapack - !> DISNA: computes the reciprocal condition numbers for the eigenvectors + 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 @@ -276,7 +277,6 @@ module stdlib_linalg_lapack !> the error bound. !> DISNA may also be used to compute error bounds for eigenvectors of !> the generalized symmetric definite eigenproblem. - interface disna #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ddisna( job, m, n, d, sep, info ) import sp,dp,qp,ilp,lk @@ -310,11 +310,11 @@ module stdlib_linalg_lapack - !> GBBRD: reduces a complex general m-by-n band matrix A to real upper + 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. - interface gbbrd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, & c, ldc, work, rwork, info ) @@ -383,13 +383,13 @@ module stdlib_linalg_lapack - !> GBCON: estimates the reciprocal of the condition number of a complex + 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)) ). - interface gbcon #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, rwork, & info ) @@ -460,7 +460,8 @@ module stdlib_linalg_lapack - !> GBEQU: computes row and column scalings intended to equilibrate an + 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 @@ -469,7 +470,6 @@ module stdlib_linalg_lapack !> 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. - interface gbequ #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) @@ -532,7 +532,8 @@ module stdlib_linalg_lapack - !> GBEQUB: computes row and column scalings intended to equilibrate an + 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 @@ -547,7 +548,6 @@ module stdlib_linalg_lapack !> 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). - interface gbequb #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) @@ -610,10 +610,10 @@ module stdlib_linalg_lapack - !> GBRFS: improves the computed solution to a system of linear + 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. - interface gbrfs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, & x, ldx, ferr, berr, work, rwork,info ) @@ -686,7 +686,8 @@ module stdlib_linalg_lapack - !> GBSV: computes the solution to a complex system of linear equations + 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 @@ -694,7 +695,6 @@ module stdlib_linalg_lapack !> 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. - interface gbsv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -749,10 +749,10 @@ module stdlib_linalg_lapack - !> GBTRF: computes an LU factorization of a complex m-by-n band matrix A + 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. - interface gbtrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) import sp,dp,qp,ilp,lk @@ -807,11 +807,11 @@ module stdlib_linalg_lapack - !> GBTRS: solves a system of linear equations + 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. - interface gbtrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) @@ -878,10 +878,10 @@ module stdlib_linalg_lapack - !> GEBAK: forms the right or left eigenvectors of a complex general + 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. - interface gebak #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) import sp,dp,qp,ilp,lk @@ -944,7 +944,8 @@ module stdlib_linalg_lapack - !> GEBAL: balances a general complex matrix A. This involves, first, + 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 @@ -952,7 +953,6 @@ module stdlib_linalg_lapack !> 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. - interface gebal #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgebal( job, n, a, lda, ilo, ihi, scale, info ) import sp,dp,qp,ilp,lk @@ -1015,10 +1015,10 @@ module stdlib_linalg_lapack - !> GEBRD: reduces a general complex M-by-N matrix A to upper or lower + 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. - interface gebrd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -1079,13 +1079,13 @@ module stdlib_linalg_lapack - !> GECON: estimates the reciprocal of the condition number of a general + 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)) ). - interface gecon #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgecon( norm, n, a, lda, anorm, rcond, work, rwork,info ) import sp,dp,qp,ilp,lk @@ -1154,7 +1154,8 @@ module stdlib_linalg_lapack - !> GEEQU: computes row and column scalings intended to equilibrate an + 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 @@ -1163,7 +1164,6 @@ module stdlib_linalg_lapack !> 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. - interface geequ #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) import sp,dp,qp,ilp,lk @@ -1222,7 +1222,8 @@ module stdlib_linalg_lapack - !> GEEQUB: computes row and column scalings intended to equilibrate an + 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 @@ -1237,7 +1238,6 @@ module stdlib_linalg_lapack !> 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). - interface geequb #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) import sp,dp,qp,ilp,lk @@ -1296,7 +1296,8 @@ module stdlib_linalg_lapack - !> GEES: computes for an N-by-N complex nonsymmetric matrix A, the + 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 @@ -1304,7 +1305,6 @@ module stdlib_linalg_lapack !> 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. - interface gees #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgees( jobvs, sort, select, n, a, lda, sdim, w, vs,ldvs, work, lwork, & rwork, bwork, info ) @@ -1381,7 +1381,8 @@ module stdlib_linalg_lapack - !> GEEV: computes for an N-by-N complex nonsymmetric matrix A, the + 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) @@ -1391,7 +1392,6 @@ module stdlib_linalg_lapack !> 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. - interface geev #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgeev( jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr,work, lwork, & rwork, info ) @@ -1460,9 +1460,9 @@ module stdlib_linalg_lapack - !> GEHRD: reduces a complex general matrix A to upper Hessenberg form H by - !> an unitary similarity transformation: Q**H * A * Q = H . interface gehrd + !> GEHRD reduces a complex general matrix A to upper Hessenberg form H by + !> an unitary similarity transformation: Q**H * A * Q = H . #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -1521,7 +1521,8 @@ module stdlib_linalg_lapack - !> GEJSV: computes the singular value decomposition (SVD) of a complex M-by-N + 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 @@ -1531,7 +1532,6 @@ module stdlib_linalg_lapack !> 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. - interface gejsv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, & ldu, v, ldv,cwork, lwork, rwork, lrwork, iwork, info ) @@ -1600,13 +1600,13 @@ module stdlib_linalg_lapack - !> GELQ: computes an LQ factorization of a complex M-by-N matrix A: + 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. - interface gelq #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgelq( m, n, a, lda, t, tsize, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -1665,13 +1665,13 @@ module stdlib_linalg_lapack - !> GELQF: computes an LQ factorization of a complex M-by-N matrix A: + 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. - interface gelqf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgelqf( m, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -1730,9 +1730,9 @@ module stdlib_linalg_lapack - !> GELQT: computes a blocked LQ factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. interface gelqt + !> GELQT computes a blocked LQ factorization of a complex M-by-N matrix A + !> using the compact WY representation of Q. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgelqt( m, n, mb, a, lda, t, ldt, work, info ) import sp,dp,qp,ilp,lk @@ -1791,11 +1791,11 @@ module stdlib_linalg_lapack - !> GELQT3: recursively computes a LQ factorization of a complex M-by-N + 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. - interface gelqt3 #ifdef STDLIB_EXTERNAL_LAPACK pure recursive subroutine cgelqt3( m, n, a, lda, t, ldt, info ) import sp,dp,qp,ilp,lk @@ -1854,7 +1854,8 @@ module stdlib_linalg_lapack - !> GELS: solves overdetermined or underdetermined complex linear systems + 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: @@ -1872,7 +1873,6 @@ module stdlib_linalg_lapack !> 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. - interface gels #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -1935,7 +1935,8 @@ module stdlib_linalg_lapack - !> GELSD: computes the minimum-norm solution to a real linear least + 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 @@ -1960,7 +1961,6 @@ module stdlib_linalg_lapack !> 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. - interface gelsd #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & iwork, info ) @@ -2029,7 +2029,8 @@ module stdlib_linalg_lapack - !> GELSS: computes the minimum norm solution to a complex linear + 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 @@ -2041,7 +2042,6 @@ module stdlib_linalg_lapack !> The effective rank of A is determined by treating as zero those !> singular values which are less than RCOND times the largest singular !> value. - interface gelss #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & info ) @@ -2110,7 +2110,8 @@ module stdlib_linalg_lapack - !> GELSY: computes the minimum-norm solution to a complex linear least + 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 @@ -2142,7 +2143,6 @@ module stdlib_linalg_lapack !> 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. - interface gelsy #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, & rwork, info ) @@ -2215,14 +2215,14 @@ module stdlib_linalg_lapack - !> GEMLQ: overwrites the general real M-by-N matrix C with + 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) - interface gemlq #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork,& info ) @@ -2293,7 +2293,8 @@ module stdlib_linalg_lapack - !> GEMLQT: overwrites the general complex M-by-N matrix C with + 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 @@ -2302,7 +2303,6 @@ module stdlib_linalg_lapack !> 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'. - interface gemlqt #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, & info ) @@ -2373,14 +2373,14 @@ module stdlib_linalg_lapack - !> GEMQR: overwrites the general real M-by-N matrix C with + 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) - interface gemqr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork,& info ) @@ -2451,7 +2451,8 @@ module stdlib_linalg_lapack - !> GEMQRT: overwrites the general complex M-by-N matrix C with + 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 @@ -2460,7 +2461,6 @@ module stdlib_linalg_lapack !> 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'. - interface gemqrt #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, & info ) @@ -2531,9 +2531,9 @@ module stdlib_linalg_lapack - !> GEQLF: computes a QL factorization of a complex M-by-N matrix A: - !> A = Q * L. interface geqlf + !> GEQLF computes a QL factorization of a complex M-by-N matrix A: + !> A = Q * L. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeqlf( m, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -2592,14 +2592,14 @@ module stdlib_linalg_lapack - !> GEQR: computes a QR factorization of a complex M-by-N matrix A: + 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. - interface geqr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeqr( m, n, a, lda, t, tsize, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -2658,7 +2658,8 @@ module stdlib_linalg_lapack - !> GEQR2P: computes a QR factorization of a complex m-by-n matrix A: + interface geqr2p + !> GEQR2P computes a QR factorization of a complex m-by-n matrix A: !> A = Q * ( R ), !> ( 0 ) !> where: @@ -2666,7 +2667,6 @@ module stdlib_linalg_lapack !> 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. - interface geqr2p #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgeqr2p( m, n, a, lda, tau, work, info ) import sp,dp,qp,ilp,lk @@ -2725,14 +2725,14 @@ module stdlib_linalg_lapack - !> GEQRF: computes a QR factorization of a complex M-by-N matrix A: + 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. - interface geqrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeqrf( m, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -2791,6 +2791,7 @@ module stdlib_linalg_lapack + interface geqrfp !> CGEQR2P computes a QR factorization of a complex M-by-N matrix A: !> A = Q * ( R ), !> ( 0 ) @@ -2799,7 +2800,6 @@ module stdlib_linalg_lapack !> 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. - interface geqrfp #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgeqrfp( m, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -2858,9 +2858,9 @@ module stdlib_linalg_lapack - !> GEQRT: computes a blocked QR factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. interface geqrt + !> GEQRT computes a blocked QR factorization of a complex M-by-N matrix A + !> using the compact WY representation of Q. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeqrt( m, n, nb, a, lda, t, ldt, work, info ) import sp,dp,qp,ilp,lk @@ -2919,9 +2919,9 @@ module stdlib_linalg_lapack - !> GEQRT2: computes a QR factorization of a complex M-by-N matrix A, - !> using the compact WY representation of Q. interface geqrt2 + !> GEQRT2 computes a QR factorization of a complex M-by-N matrix A, + !> using the compact WY representation of Q. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeqrt2( m, n, a, lda, t, ldt, info ) import sp,dp,qp,ilp,lk @@ -2980,11 +2980,11 @@ module stdlib_linalg_lapack - !> GEQRT3: recursively computes a QR factorization of a complex M-by-N matrix A, + 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. - interface geqrt3 #ifdef STDLIB_EXTERNAL_LAPACK pure recursive subroutine cgeqrt3( m, n, a, lda, t, ldt, info ) import sp,dp,qp,ilp,lk @@ -3043,10 +3043,10 @@ module stdlib_linalg_lapack - !> GERFS: improves the computed solution to a system of linear + interface gerfs + !> GERFS improves the computed solution to a system of linear !> equations and provides error bounds and backward error estimates for !> the solution. - interface gerfs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, & ferr, berr, work, rwork, info ) @@ -3119,9 +3119,9 @@ module stdlib_linalg_lapack - !> GERQF: computes an RQ factorization of a complex M-by-N matrix A: - !> A = R * Q. interface gerqf + !> GERQF computes an RQ factorization of a complex M-by-N matrix A: + !> A = R * Q. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgerqf( m, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -3180,7 +3180,8 @@ module stdlib_linalg_lapack - !> GESDD: computes the singular value decomposition (SVD) of a complex + 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) @@ -3197,7 +3198,6 @@ module stdlib_linalg_lapack !> 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. - interface gesdd #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, & iwork, info ) @@ -3266,7 +3266,8 @@ module stdlib_linalg_lapack - !> GESV: computes the solution to a complex system of linear equations + 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 @@ -3275,7 +3276,6 @@ module stdlib_linalg_lapack !> 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. - interface gesv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -3330,7 +3330,8 @@ module stdlib_linalg_lapack - !> GESVD: computes the singular value decomposition (SVD) of a complex + 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) @@ -3341,7 +3342,6 @@ module stdlib_linalg_lapack !> 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. - interface gesvd #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, & rwork, info ) @@ -3410,7 +3410,8 @@ module stdlib_linalg_lapack - !> GESVDQ: computes the singular value decomposition (SVD) of a complex + 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] @@ -3419,7 +3420,6 @@ module stdlib_linalg_lapack !> 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. - interface gesvdq #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & numrank, iwork, liwork,cwork, lcwork, rwork, lrwork, info ) @@ -3492,7 +3492,8 @@ module stdlib_linalg_lapack - !> GESVJ: computes the singular value decomposition (SVD) of a complex + 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] @@ -3501,7 +3502,6 @@ module stdlib_linalg_lapack !> 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. - interface gesvj #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, cwork, & lwork, rwork, lrwork, info ) @@ -3570,7 +3570,8 @@ module stdlib_linalg_lapack - !> GETRF: computes an LU factorization of a general M-by-N matrix A + 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 @@ -3578,7 +3579,6 @@ module stdlib_linalg_lapack !> 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. - interface getrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgetrf( m, n, a, lda, ipiv, info ) import sp,dp,qp,ilp,lk @@ -3633,7 +3633,8 @@ module stdlib_linalg_lapack - !> GETRF2: computes an LU factorization of a general M-by-N matrix A + 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 @@ -3652,7 +3653,6 @@ module stdlib_linalg_lapack !> do the swaps on [ --- ], solve A12, update A22, !> [ A22 ] !> then calls itself to factor A22 and do the swaps on A21. - interface getrf2 #ifdef STDLIB_EXTERNAL_LAPACK pure recursive subroutine cgetrf2( m, n, a, lda, ipiv, info ) import sp,dp,qp,ilp,lk @@ -3707,11 +3707,11 @@ module stdlib_linalg_lapack - !> GETRI: computes the inverse of a matrix using the LU factorization + 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). - interface getri #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgetri( n, a, lda, ipiv, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -3770,11 +3770,11 @@ module stdlib_linalg_lapack - !> GETRS: solves a system of linear equations + 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. - interface getrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -3837,7 +3837,8 @@ module stdlib_linalg_lapack - !> GETSLS: solves overdetermined or underdetermined complex linear systems + 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: @@ -3855,7 +3856,6 @@ module stdlib_linalg_lapack !> 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. - interface getsls #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) import sp,dp,qp,ilp,lk @@ -3918,7 +3918,8 @@ module stdlib_linalg_lapack - !> GETSQRHRT: computes a NB2-sized column blocked QR-factorization + 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 @@ -3930,7 +3931,6 @@ module stdlib_linalg_lapack !> 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. - interface getsqrhrt #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) @@ -3993,11 +3993,11 @@ module stdlib_linalg_lapack - !> GGBAK: forms the right or left eigenvectors of a complex generalized + 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. - interface ggbak #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) @@ -4064,7 +4064,8 @@ module stdlib_linalg_lapack - !> GGBAL: balances a pair of general complex matrices (A,B). This + 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 @@ -4073,7 +4074,6 @@ module stdlib_linalg_lapack !> 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. - interface ggbal #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, & info ) @@ -4140,7 +4140,8 @@ module stdlib_linalg_lapack - !> GGES: computes for a pair of N-by-N complex nonsymmetric matrices + 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 @@ -4160,7 +4161,6 @@ module stdlib_linalg_lapack !> 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. - interface gges #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alpha, & beta, vsl, ldvsl, vsr, ldvsr, work,lwork, rwork, bwork, info ) @@ -4241,7 +4241,8 @@ module stdlib_linalg_lapack - !> GGEV: computes for a pair of N-by-N complex nonsymmetric matrices + 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 @@ -4256,7 +4257,6 @@ module stdlib_linalg_lapack !> 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). - interface ggev #ifdef STDLIB_EXTERNAL_LAPACK subroutine cggev( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & work, lwork, rwork, info ) @@ -4329,7 +4329,8 @@ module stdlib_linalg_lapack - !> GGGLM: solves a general Gauss-Markov linear model (GLM) problem: + 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 @@ -4347,7 +4348,6 @@ module stdlib_linalg_lapack !> minimize || inv(B)*(d-A*x) ||_2 !> x !> where inv(B) denotes the inverse of B. - interface ggglm #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) @@ -4410,7 +4410,8 @@ module stdlib_linalg_lapack - !> GGHRD: reduces a pair of complex matrices (A,B) to generalized upper + 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 @@ -4433,7 +4434,6 @@ module stdlib_linalg_lapack !> 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. - interface gghrd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & info ) @@ -4496,7 +4496,8 @@ module stdlib_linalg_lapack - !> GGLSE: solves the linear equality-constrained least squares (LSE) + 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 @@ -4508,7 +4509,6 @@ module stdlib_linalg_lapack !> which is obtained using a generalized RQ factorization of the !> matrices (B, A) given by !> B = (0 R)*Q, A = Z*T*Q. - interface gglse #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) @@ -4571,7 +4571,8 @@ module stdlib_linalg_lapack - !> GGQRF: computes a generalized QR factorization of an N-by-M matrix A + 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, @@ -4589,7 +4590,6 @@ module stdlib_linalg_lapack !> 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. - interface ggqrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) @@ -4652,7 +4652,8 @@ module stdlib_linalg_lapack - !> GGRQF: computes a generalized RQ factorization of an M-by-N matrix A + 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 @@ -4670,7 +4671,6 @@ module stdlib_linalg_lapack !> 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. - interface ggrqf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) @@ -4733,11 +4733,11 @@ module stdlib_linalg_lapack - !> GSVJ0: is called from CGESVJ as a pre-processor and that is its main + 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. - interface gsvj0 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & nsweep, work, lwork, info ) @@ -4810,7 +4810,8 @@ module stdlib_linalg_lapack - !> GSVJ1: is called from CGESVJ as a pre-processor and that is its main + 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 @@ -4834,7 +4835,6 @@ module stdlib_linalg_lapack !> 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. - interface gsvj1 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol,& nsweep, work, lwork, info ) @@ -4907,12 +4907,12 @@ module stdlib_linalg_lapack - !> GTCON: estimates the reciprocal of the condition number of a complex + 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))). - interface gtcon #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, info ) @@ -4983,10 +4983,10 @@ module stdlib_linalg_lapack - !> GTRFS: improves the computed solution to a system of linear + 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. - interface gtrfs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, & x, ldx, ferr, berr, work, rwork,info ) @@ -5063,13 +5063,13 @@ module stdlib_linalg_lapack - !> GTSV: solves the equation + 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. - interface gtsv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgtsv( n, nrhs, dl, d, du, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -5124,14 +5124,14 @@ module stdlib_linalg_lapack - !> GTTRF: computes an LU factorization of a complex tridiagonal matrix A + 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. - interface gttrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgttrf( n, dl, d, du, du2, ipiv, info ) import sp,dp,qp,ilp,lk @@ -5190,11 +5190,11 @@ module stdlib_linalg_lapack - !> GTTRS: solves one of the systems of equations + 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. - interface gttrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) import sp,dp,qp,ilp,lk @@ -5257,9 +5257,9 @@ module stdlib_linalg_lapack - !> HB2ST_KERNELS: is an internal routine used by the CHETRD_HB2ST - !> subroutine. interface hb2st_kernels + !> HB2ST_KERNELS is an internal routine used by the CHETRD_HB2ST + !> subroutine. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, & lda, v, tau, ldvt, work) @@ -5295,9 +5295,9 @@ module stdlib_linalg_lapack - !> HBEV: computes all the eigenvalues and, optionally, eigenvectors of - !> a complex Hermitian band matrix A. interface hbev + !> HBEV computes all the eigenvalues and, optionally, eigenvectors of + !> a complex Hermitian band matrix A. #ifdef STDLIB_EXTERNAL_LAPACK subroutine chbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,rwork, info ) @@ -5335,7 +5335,8 @@ module stdlib_linalg_lapack - !> HBEVD: computes all the eigenvalues and, optionally, eigenvectors of + 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 @@ -5344,7 +5345,6 @@ module stdlib_linalg_lapack !> 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. - interface hbevd #ifdef STDLIB_EXTERNAL_LAPACK subroutine chbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, rwork, & lrwork, iwork, liwork, info ) @@ -5382,14 +5382,14 @@ module stdlib_linalg_lapack - !> HBGST: reduces a complex Hermitian-definite banded generalized + 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. - interface hbgst #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, & rwork, info ) @@ -5429,11 +5429,11 @@ module stdlib_linalg_lapack - !> HBGV: computes all the eigenvalues, and optionally, the eigenvectors + 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. - interface hbgv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & rwork, info ) @@ -5471,7 +5471,8 @@ module stdlib_linalg_lapack - !> HBGVD: computes all the eigenvalues, and optionally, the eigenvectors + 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 @@ -5482,7 +5483,6 @@ module stdlib_linalg_lapack !> 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. - interface hbgvd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & lwork, rwork, lrwork, iwork,liwork, info ) @@ -5520,10 +5520,10 @@ module stdlib_linalg_lapack - !> HBTRD: reduces a complex Hermitian band matrix A to real symmetric + 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. - interface hbtrd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) @@ -5561,12 +5561,12 @@ module stdlib_linalg_lapack - !> HECON: estimates the reciprocal of the condition number of a complex + 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))). - interface hecon #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine checon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) import sp,dp,qp,ilp,lk @@ -5604,12 +5604,12 @@ module stdlib_linalg_lapack - !> HECON_ROOK: estimates the reciprocal of the condition number of a complex + 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))). - interface hecon_rook #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine checon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) @@ -5649,14 +5649,14 @@ module stdlib_linalg_lapack - !> HEEQUB: computes row and column scalings intended to equilibrate a + 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. - interface heequb #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cheequb( uplo, n, a, lda, s, scond, amax, work, info ) import sp,dp,qp,ilp,lk @@ -5692,9 +5692,9 @@ module stdlib_linalg_lapack - !> HEEV: computes all eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix A. interface heev + !> HEEV computes all eigenvalues and, optionally, eigenvectors of a + !> complex Hermitian matrix A. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cheev( jobz, uplo, n, a, lda, w, work, lwork, rwork,info ) import sp,dp,qp,ilp,lk @@ -5730,7 +5730,8 @@ module stdlib_linalg_lapack - !> HEEVD: computes all eigenvalues and, optionally, eigenvectors of a + 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 @@ -5739,7 +5740,6 @@ module stdlib_linalg_lapack !> 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. - interface heevd #ifdef STDLIB_EXTERNAL_LAPACK subroutine cheevd( jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, & liwork, info ) @@ -5777,7 +5777,8 @@ module stdlib_linalg_lapack - !> HEEVR: computes selected eigenvalues and, optionally, eigenvectors + 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. @@ -5827,7 +5828,6 @@ module stdlib_linalg_lapack !> hence may abort due to a floating point exception in environments !> which do not handle NaNs and infinities in the ieee standard default !> manner. - interface heevr #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -5867,14 +5867,14 @@ module stdlib_linalg_lapack - !> HEGST: reduces a complex Hermitian-definite generalized + 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. - interface hegst #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chegst( itype, uplo, n, a, lda, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -5906,12 +5906,12 @@ module stdlib_linalg_lapack - !> HEGV: computes all the eigenvalues, and optionally, the eigenvectors + 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. - interface hegv #ifdef STDLIB_EXTERNAL_LAPACK subroutine chegv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, info & ) @@ -5949,7 +5949,8 @@ module stdlib_linalg_lapack - !> HEGVD: computes all the eigenvalues, and optionally, the eigenvectors + 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. @@ -5960,7 +5961,6 @@ module stdlib_linalg_lapack !> 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. - interface hegvd #ifdef STDLIB_EXTERNAL_LAPACK subroutine chegvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, & lrwork, iwork, liwork, info ) @@ -5998,10 +5998,10 @@ module stdlib_linalg_lapack - !> HERFS: improves the computed solution to a system of linear + 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. - interface herfs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cherfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr,& berr, work, rwork, info ) @@ -6041,7 +6041,8 @@ module stdlib_linalg_lapack - !> HESV: computes the solution to a complex system of linear equations + 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. @@ -6052,7 +6053,6 @@ module stdlib_linalg_lapack !> 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. - interface hesv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chesv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -6088,7 +6088,8 @@ module stdlib_linalg_lapack - !> HESV_AA: computes the solution to a complex system of linear equations + 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. @@ -6098,7 +6099,6 @@ module stdlib_linalg_lapack !> 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. - interface hesv_aa #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chesv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -6134,7 +6134,8 @@ module stdlib_linalg_lapack - !> HESV_RK: computes the solution to a complex system of linear + 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 @@ -6148,7 +6149,6 @@ module stdlib_linalg_lapack !> 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. - interface hesv_rk #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chesv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info & ) @@ -6184,7 +6184,8 @@ module stdlib_linalg_lapack - !> HESV_ROOK: computes the solution to a complex system of linear equations + 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. @@ -6200,7 +6201,6 @@ module stdlib_linalg_lapack !> 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). - interface hesv_rook #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chesv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -6236,9 +6236,9 @@ module stdlib_linalg_lapack - !> HESWAPR: applies an elementary permutation on the rows and the columns of - !> a hermitian matrix. interface heswapr + !> HESWAPR applies an elementary permutation on the rows and the columns of + !> a hermitian matrix. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cheswapr( uplo, n, a, lda, i1, i2) import sp,dp,qp,ilp,lk @@ -6268,7 +6268,8 @@ module stdlib_linalg_lapack - !> HETF2_RK: computes the factorization of a complex Hermitian matrix A + 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, @@ -6277,7 +6278,6 @@ module stdlib_linalg_lapack !> 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. - interface hetf2_rk #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetf2_rk( uplo, n, a, lda, e, ipiv, info ) import sp,dp,qp,ilp,lk @@ -6311,14 +6311,14 @@ module stdlib_linalg_lapack - !> HETF2_ROOK: computes the factorization of a complex Hermitian matrix A + 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. - interface hetf2_rook #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetf2_rook( uplo, n, a, lda, ipiv, info ) import sp,dp,qp,ilp,lk @@ -6350,10 +6350,10 @@ module stdlib_linalg_lapack - !> HETRD: reduces a complex Hermitian matrix A to real symmetric + 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. - interface hetrd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -6389,10 +6389,10 @@ module stdlib_linalg_lapack - !> HETRD_HB2ST: reduces a complex Hermitian band matrix A to real symmetric + 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. - interface hetrd_hb2st #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, & lhous, work, lwork, info ) @@ -6430,10 +6430,10 @@ module stdlib_linalg_lapack - !> HETRD_HE2HB: reduces a complex Hermitian matrix A to complex Hermitian + 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. - interface hetrd_he2hb #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info & ) @@ -6469,7 +6469,8 @@ module stdlib_linalg_lapack - !> HETRF: computes the factorization of a complex Hermitian matrix A + 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 @@ -6477,7 +6478,6 @@ module stdlib_linalg_lapack !> 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. - interface hetrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrf( uplo, n, a, lda, ipiv, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -6511,13 +6511,13 @@ module stdlib_linalg_lapack - !> HETRF_AA: computes the factorization of a complex hermitian matrix A + 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. - interface hetrf_aa #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) import sp,dp,qp,ilp,lk @@ -6551,7 +6551,8 @@ module stdlib_linalg_lapack - !> HETRF_RK: computes the factorization of a complex Hermitian matrix A + 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, @@ -6560,7 +6561,6 @@ module stdlib_linalg_lapack !> 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. - interface hetrf_rk #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -6594,7 +6594,8 @@ module stdlib_linalg_lapack - !> HETRF_ROOK: computes the factorization of a complex Hermitian matrix A + 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 @@ -6602,7 +6603,6 @@ module stdlib_linalg_lapack !> 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. - interface hetrf_rook #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -6636,10 +6636,10 @@ module stdlib_linalg_lapack - !> HETRI: computes the inverse of a complex Hermitian indefinite matrix + 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. - interface hetri #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetri( uplo, n, a, lda, ipiv, work, info ) import sp,dp,qp,ilp,lk @@ -6673,10 +6673,10 @@ module stdlib_linalg_lapack - !> HETRI_ROOK: computes the inverse of a complex Hermitian indefinite matrix + 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. - interface hetri_rook #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetri_rook( uplo, n, a, lda, ipiv, work, info ) import sp,dp,qp,ilp,lk @@ -6710,10 +6710,10 @@ module stdlib_linalg_lapack - !> HETRS: solves a system of linear equations A*X = B with a complex + 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. - interface hetrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -6747,10 +6747,10 @@ module stdlib_linalg_lapack - !> HETRS2: solves a system of linear equations A*X = B with a complex + 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. - interface hetrs2 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) import sp,dp,qp,ilp,lk @@ -6784,7 +6784,8 @@ module stdlib_linalg_lapack - !> HETRS_3: solves a system of linear equations A * X = B with a complex + 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), @@ -6793,7 +6794,6 @@ module stdlib_linalg_lapack !> 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. - interface hetrs_3 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) import sp,dp,qp,ilp,lk @@ -6827,10 +6827,10 @@ module stdlib_linalg_lapack - !> HETRS_AA: solves a system of linear equations A*X = B with a complex + 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. - interface hetrs_aa #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) @@ -6868,10 +6868,10 @@ module stdlib_linalg_lapack - !> HETRS_ROOK: solves a system of linear equations A*X = B with a complex + 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. - interface hetrs_rook #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) import sp,dp,qp,ilp,lk @@ -6905,15 +6905,15 @@ module stdlib_linalg_lapack + interface hfrk !> Level 3 BLAS like routine for C in RFP Format. - !> HFRK: performs one of the Hermitian rank--k operations + !> 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. - interface hfrk #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) import sp,dp,qp,ilp,lk @@ -6947,7 +6947,8 @@ module stdlib_linalg_lapack - !> HGEQZ: computes the eigenvalues of a complex matrix pair (H,T), + 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 @@ -6980,7 +6981,6 @@ module stdlib_linalg_lapack !> Ref: C.B. Moler !> Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973), !> pp. 241--256. - interface hgeqz #ifdef STDLIB_EXTERNAL_LAPACK subroutine chgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alpha, beta, q, & ldq, z, ldz, work, lwork,rwork, info ) @@ -7049,12 +7049,12 @@ module stdlib_linalg_lapack - !> HPCON: estimates the reciprocal of the condition number of a complex + 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))). - interface hpcon #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chpcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) import sp,dp,qp,ilp,lk @@ -7092,9 +7092,9 @@ module stdlib_linalg_lapack - !> HPEV: computes all the eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix in packed storage. interface hpev + !> HPEV computes all the eigenvalues and, optionally, eigenvectors of a + !> complex Hermitian matrix in packed storage. #ifdef STDLIB_EXTERNAL_LAPACK subroutine chpev( jobz, uplo, n, ap, w, z, ldz, work, rwork,info ) import sp,dp,qp,ilp,lk @@ -7130,7 +7130,8 @@ module stdlib_linalg_lapack - !> HPEVD: computes all the eigenvalues and, optionally, eigenvectors of + 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 @@ -7139,7 +7140,6 @@ module stdlib_linalg_lapack !> 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. - interface hpevd #ifdef STDLIB_EXTERNAL_LAPACK subroutine chpevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,rwork, lrwork, iwork, & liwork, info ) @@ -7177,14 +7177,14 @@ module stdlib_linalg_lapack - !> HPGST: reduces a complex Hermitian-definite generalized + 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. - interface hpgst #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chpgst( itype, uplo, n, ap, bp, info ) import sp,dp,qp,ilp,lk @@ -7218,12 +7218,12 @@ module stdlib_linalg_lapack - !> HPGV: computes all the eigenvalues and, optionally, the eigenvectors + 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. - interface hpgv #ifdef STDLIB_EXTERNAL_LAPACK subroutine chpgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,rwork, info ) @@ -7261,7 +7261,8 @@ module stdlib_linalg_lapack - !> HPGVD: computes all the eigenvalues and, optionally, the eigenvectors + 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 @@ -7273,7 +7274,6 @@ module stdlib_linalg_lapack !> 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. - interface hpgvd #ifdef STDLIB_EXTERNAL_LAPACK subroutine chpgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, rwork, & lrwork, iwork, liwork, info ) @@ -7311,11 +7311,11 @@ module stdlib_linalg_lapack - !> HPRFS: improves the computed solution to a system of linear + 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. - interface hprfs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, & work, rwork, info ) @@ -7355,7 +7355,8 @@ module stdlib_linalg_lapack - !> HPSV: computes the solution to a complex system of linear equations + 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. @@ -7366,7 +7367,6 @@ module stdlib_linalg_lapack !> 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. - interface hpsv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chpsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -7398,10 +7398,10 @@ module stdlib_linalg_lapack - !> HPTRD: reduces a complex Hermitian matrix A stored in packed form to + 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. - interface hptrd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chptrd( uplo, n, ap, d, e, tau, info ) import sp,dp,qp,ilp,lk @@ -7437,13 +7437,13 @@ module stdlib_linalg_lapack - !> HPTRF: computes the factorization of a complex Hermitian packed + 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. - interface hptrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chptrf( uplo, n, ap, ipiv, info ) import sp,dp,qp,ilp,lk @@ -7475,10 +7475,10 @@ module stdlib_linalg_lapack - !> HPTRI: computes the inverse of a complex Hermitian indefinite matrix + 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. - interface hptri #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chptri( uplo, n, ap, ipiv, work, info ) import sp,dp,qp,ilp,lk @@ -7512,10 +7512,10 @@ module stdlib_linalg_lapack - !> HPTRS: solves a system of linear equations A*X = B with a complex + 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. - interface hptrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -7549,13 +7549,13 @@ module stdlib_linalg_lapack - !> HSEIN: uses inverse iteration to find specified right and/or left + 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. - interface hsein #ifdef STDLIB_EXTERNAL_LAPACK subroutine chsein( side, eigsrc, initv, select, n, h, ldh, w, vl,ldvl, vr, ldvr, & mm, m, work, rwork, ifaill,ifailr, info ) @@ -7632,7 +7632,8 @@ module stdlib_linalg_lapack - !> HSEQR: computes the eigenvalues of a Hessenberg matrix H + 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. @@ -7640,7 +7641,6 @@ module stdlib_linalg_lapack !> 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. - interface hseqr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chseqr( job, compz, n, ilo, ihi, h, ldh, w, z, ldz,work, lwork, & info ) @@ -7707,10 +7707,10 @@ module stdlib_linalg_lapack - !> ISNAN: returns .TRUE. if its argument is NaN, and .FALSE. + interface isnan + !> ISNAN returns .TRUE. if its argument is NaN, and .FALSE. !> otherwise. To be replaced by the Fortran 2003 intrinsic in the !> future. - interface isnan #ifdef STDLIB_EXTERNAL_LAPACK pure logical(lk) function disnan( din ) import sp,dp,qp,ilp,lk @@ -7736,7 +7736,8 @@ module stdlib_linalg_lapack - !> LA_GBAMV: performs one of the matrix-vector operations + 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 @@ -7749,7 +7750,6 @@ module stdlib_linalg_lapack !> "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. - interface la_gbamv #ifdef STDLIB_EXTERNAL_LAPACK subroutine cla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) @@ -7810,7 +7810,8 @@ module stdlib_linalg_lapack - !> LA_GBRCOND: Estimates the Skeel condition number of op(A) * op2(C) + 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 @@ -7819,7 +7820,6 @@ module stdlib_linalg_lapack !> 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. - interface la_gbrcond #ifdef STDLIB_EXTERNAL_LAPACK real(dp) function dla_gbrcond( trans, n, kl, ku, ab, ldab,afb, ldafb, ipiv, cmode, & c,info, work, iwork ) @@ -7855,9 +7855,9 @@ module stdlib_linalg_lapack - !> LA_GBRCOND_C: Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a REAL vector. 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_gbrcond_c( trans, n, kl, ku, ab, ldab, afb,ldafb, ipiv, c, & capply, info, work,rwork ) @@ -7899,13 +7899,13 @@ module stdlib_linalg_lapack - !> LA_GBRPVGRW: computes the reciprocal pivot growth factor + 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. - interface la_gbrpvgrw #ifdef STDLIB_EXTERNAL_LAPACK pure real(sp) function cla_gbrpvgrw( n, kl, ku, ncols, ab, ldab, afb,ldafb ) @@ -7960,7 +7960,8 @@ module stdlib_linalg_lapack - !> LA_GEAMV: performs one of the matrix-vector operations + 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 @@ -7973,7 +7974,6 @@ module stdlib_linalg_lapack !> "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. - interface la_geamv #ifdef STDLIB_EXTERNAL_LAPACK subroutine cla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) import sp,dp,qp,ilp,lk @@ -8030,7 +8030,8 @@ module stdlib_linalg_lapack - !> LA_GERCOND: estimates the Skeel condition number of op(A) * op2(C) + 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 @@ -8039,7 +8040,6 @@ module stdlib_linalg_lapack !> 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. - interface la_gercond #ifdef STDLIB_EXTERNAL_LAPACK real(dp) function dla_gercond( trans, n, a, lda, af,ldaf, ipiv, cmode, c,info, & work, iwork ) @@ -8075,9 +8075,9 @@ module stdlib_linalg_lapack - !> LA_GERCOND_C: computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a REAL vector. 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_gercond_c( trans, n, a, lda, af, ldaf, ipiv, c,capply, info, & work, rwork ) @@ -8119,13 +8119,13 @@ module stdlib_linalg_lapack - !> LA_GERPVGRW: computes the reciprocal pivot growth factor + 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. - interface la_gerpvgrw #ifdef STDLIB_EXTERNAL_LAPACK pure real(sp) function cla_gerpvgrw( n, ncols, a, lda, af, ldaf ) import sp,dp,qp,ilp,lk @@ -8176,6 +8176,7 @@ module stdlib_linalg_lapack + 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 @@ -8188,7 +8189,6 @@ module stdlib_linalg_lapack !> "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. - interface la_heamv #ifdef STDLIB_EXTERNAL_LAPACK subroutine cla_heamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) import sp,dp,qp,ilp,lk @@ -8220,9 +8220,9 @@ module stdlib_linalg_lapack - !> LA_HERCOND_C: computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a REAL vector. 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_hercond_c( uplo, n, a, lda, af, ldaf, ipiv, c,capply, info, & work, rwork ) @@ -8264,13 +8264,13 @@ module stdlib_linalg_lapack - !> LA_HERPVGRW: computes the reciprocal pivot growth factor + 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. - interface la_herpvgrw #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_herpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work ) @@ -8304,12 +8304,12 @@ module stdlib_linalg_lapack - !> LA_LIN_BERR: computes componentwise relative backward error from + 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. - interface la_lin_berr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cla_lin_berr( n, nz, nrhs, res, ayb, berr ) import sp,dp,qp,ilp,lk @@ -8366,7 +8366,8 @@ module stdlib_linalg_lapack - !> LA_PORCOND: Estimates the Skeel condition number of op(A) * op2(C) + 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 @@ -8375,7 +8376,6 @@ module stdlib_linalg_lapack !> 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. - interface la_porcond #ifdef STDLIB_EXTERNAL_LAPACK real(dp) function dla_porcond( uplo, n, a, lda, af, ldaf,cmode, c, info, work,& iwork ) @@ -8411,9 +8411,9 @@ module stdlib_linalg_lapack - !> LA_PORCOND_C: Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a REAL vector 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 #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_porcond_c( uplo, n, a, lda, af, ldaf, c, capply,info, work, & rwork ) @@ -8455,13 +8455,13 @@ module stdlib_linalg_lapack - !> LA_PORPVGRW: computes the reciprocal pivot growth factor + 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. - interface la_porpvgrw #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_porpvgrw( uplo, ncols, a, lda, af, ldaf, work ) import sp,dp,qp,ilp,lk @@ -8520,7 +8520,8 @@ module stdlib_linalg_lapack - !> LA_SYAMV: performs the matrix-vector operation + 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. @@ -8532,7 +8533,6 @@ module stdlib_linalg_lapack !> "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. - interface la_syamv #ifdef STDLIB_EXTERNAL_LAPACK subroutine cla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) import sp,dp,qp,ilp,lk @@ -8589,7 +8589,8 @@ module stdlib_linalg_lapack - !> LA_SYRCOND: estimates the Skeel condition number of op(A) * op2(C) + 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 @@ -8598,7 +8599,6 @@ module stdlib_linalg_lapack !> 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. - interface la_syrcond #ifdef STDLIB_EXTERNAL_LAPACK real(dp) function dla_syrcond( uplo, n, a, lda, af, ldaf,ipiv, cmode, c, info, & work,iwork ) @@ -8634,9 +8634,9 @@ module stdlib_linalg_lapack - !> LA_SYRCOND_C: Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a REAL vector. 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_syrcond_c( uplo, n, a, lda, af, ldaf, ipiv, c,capply, info, & work, rwork ) @@ -8678,13 +8678,13 @@ module stdlib_linalg_lapack - !> LA_SYRPVGRW: computes the reciprocal pivot growth factor + 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. - interface la_syrpvgrw #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_syrpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work ) @@ -8747,10 +8747,10 @@ module stdlib_linalg_lapack - !> LA_WWADDW: adds a vector W into a doubled-single vector (X, Y). + 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. - interface la_wwaddw #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cla_wwaddw( n, x, y, w ) import sp,dp,qp,ilp,lk @@ -8805,7 +8805,8 @@ module stdlib_linalg_lapack - !> LABAD: takes as input the values computed by DLAMCH for underflow and + 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 @@ -8813,7 +8814,6 @@ module stdlib_linalg_lapack !> 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. - interface labad #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlabad( small, large ) import sp,dp,qp,ilp,lk @@ -8839,14 +8839,14 @@ module stdlib_linalg_lapack - !> LABRD: reduces the first NB rows and columns of a complex general + 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 - interface labrd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) import sp,dp,qp,ilp,lk @@ -8903,8 +8903,8 @@ module stdlib_linalg_lapack - !> LACGV: conjugates a complex vector of length N. interface lacgv + !> LACGV conjugates a complex vector of length N. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clacgv( n, x, incx ) import sp,dp,qp,ilp,lk @@ -8932,9 +8932,9 @@ module stdlib_linalg_lapack - !> LACON: estimates the 1-norm of a square, complex matrix A. - !> Reverse communication is used for evaluating matrix-vector products. interface lacon + !> LACON estimates the 1-norm of a square, complex matrix A. + !> Reverse communication is used for evaluating matrix-vector products. #ifdef STDLIB_EXTERNAL_LAPACK subroutine clacon( n, v, x, est, kase ) import sp,dp,qp,ilp,lk @@ -8997,9 +8997,9 @@ module stdlib_linalg_lapack - !> LACPY: copies all or part of a two-dimensional matrix A to another - !> matrix B. interface lacpy + !> LACPY copies all or part of a two-dimensional matrix A to another + !> matrix B. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clacpy( uplo, m, n, a, lda, b, ldb ) import sp,dp,qp,ilp,lk @@ -9058,11 +9058,11 @@ module stdlib_linalg_lapack - !> LACRM: performs a very simple matrix-matrix multiplication: + 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. - interface lacrm #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clacrm( m, n, a, lda, b, ldb, c, ldc, rwork ) import sp,dp,qp,ilp,lk @@ -9096,11 +9096,11 @@ module stdlib_linalg_lapack - !> LACRT: performs the operation + 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. - interface lacrt #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clacrt( n, cx, incx, cy, incy, c, s ) import sp,dp,qp,ilp,lk @@ -9130,10 +9130,10 @@ module stdlib_linalg_lapack - !> LADIV_F: := X / Y, where X and Y are complex. The computation of X / Y + 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. - interface ladiv_f #ifdef STDLIB_EXTERNAL_LAPACK pure complex(sp) function cladiv( x, y ) import sp,dp,qp,ilp,lk @@ -9159,14 +9159,14 @@ module stdlib_linalg_lapack - !> LADIV_S: performs complex division in real arithmetic + 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" - interface ladiv_s #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dladiv( a, b, c, d, p, q ) import sp,dp,qp,ilp,lk @@ -9250,7 +9250,8 @@ module stdlib_linalg_lapack - !> LAEBZ: contains the iteration loops which compute and use the + 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: @@ -9281,7 +9282,6 @@ module stdlib_linalg_lapack !> University, July 21, 1966 !> Note: the arguments are, in general, *not* checked for unreasonable !> values. - interface laebz #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaebz( ijob, nitmax, n, mmax, minp, nbmin, abstol,reltol, pivmin, & d, e, e2, nval, ab, c, mout,nab, work, iwork, info ) @@ -9319,11 +9319,11 @@ module stdlib_linalg_lapack + 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. - interface laed0 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claed0( qsiz, n, d, e, q, ldq, qstore, ldqs, rwork,iwork, info ) @@ -9390,7 +9390,8 @@ module stdlib_linalg_lapack - !> LAED1: computes the updated eigensystem of a diagonal + 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 @@ -9416,7 +9417,6 @@ module stdlib_linalg_lapack !> directly using the updated eigenvalues. The eigenvectors for !> the current problem are multiplied with the eigenvectors from !> the overall problem. - interface laed1 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaed1( n, d, q, ldq, indxq, rho, cutpnt, work, iwork,info ) @@ -9452,6 +9452,7 @@ module stdlib_linalg_lapack + 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 @@ -9462,7 +9463,6 @@ module stdlib_linalg_lapack !> 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. - interface laed4 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaed4( n, i, d, z, delta, rho, dlam, info ) import sp,dp,qp,ilp,lk @@ -9494,6 +9494,7 @@ module stdlib_linalg_lapack + 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) . @@ -9501,7 +9502,6 @@ module stdlib_linalg_lapack !> D(i) < D(j) for i < j . !> We also assume RHO > 0 and that the Euclidean norm of the vector !> Z is one. - interface laed5 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaed5( i, d, z, delta, rho, dlam ) import sp,dp,qp,ilp,lk @@ -9531,7 +9531,8 @@ module stdlib_linalg_lapack - !> LAED6: computes the positive or negative root (closest to the origin) + interface laed6 + !> LAED6 computes the positive or negative root (closest to the origin) !> of !> z(1) z(2) z(3) !> f(x) = rho + --------- + ---------- + --------- @@ -9542,7 +9543,6 @@ module stdlib_linalg_lapack !> 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. - interface laed6 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaed6( kniter, orgati, rho, d, z, finit, tau, info ) import sp,dp,qp,ilp,lk @@ -9576,7 +9576,8 @@ module stdlib_linalg_lapack - !> LAED7: computes the updated eigensystem of a diagonal + 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 @@ -9600,7 +9601,6 @@ module stdlib_linalg_lapack !> directly using the updated eigenvalues. The eigenvectors for !> the current problem are multiplied with the eigenvectors from !> the overall problem. - interface laed7 #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -9681,13 +9681,13 @@ module stdlib_linalg_lapack - !> LAED8: merges the two sets of eigenvalues together into a single + 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. - interface laed8 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claed8( k, n, qsiz, q, ldq, d, rho, cutpnt, z, dlamda,q2, ldq2, w, & indxp, indx, indxq, perm, givptr,givcol, givnum, info ) @@ -9762,11 +9762,11 @@ module stdlib_linalg_lapack - !> LAED9: finds the roots of the secular equation, as defined by the + 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. - interface laed9 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaed9( k, kstart, kstop, n, d, q, ldq, rho, dlamda, w,s, lds, & info ) @@ -9802,10 +9802,10 @@ module stdlib_linalg_lapack - !> LAEDA: computes the Z vector corresponding to the merge step in the + 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. - interface laeda #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaeda( n, tlvls, curlvl, curpbm, prmptr, perm, givptr,givcol, & givnum, q, qptr, z, ztemp, info ) @@ -9841,10 +9841,10 @@ module stdlib_linalg_lapack - !> LAEIN: uses inverse iteration to find a right or left eigenvector + 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. - interface laein #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claein( rightv, noinit, n, h, ldh, w, v, b, ldb, rwork,eps3, & smlnum, info ) @@ -9919,7 +9919,8 @@ module stdlib_linalg_lapack - !> LAESY: computes the eigendecomposition of a 2-by-2 symmetric matrix + 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. @@ -9928,7 +9929,6 @@ module stdlib_linalg_lapack !> 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 ] - interface laesy #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claesy( a, b, c, rt1, rt2, evscal, cs1, sn1 ) import sp,dp,qp,ilp,lk @@ -9956,14 +9956,14 @@ module stdlib_linalg_lapack - !> LAEXC: swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in + 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. - interface laexc #ifdef STDLIB_EXTERNAL_LAPACK subroutine dlaexc( wantq, n, t, ldt, q, ldq, j1, n1, n2, work,info ) import sp,dp,qp,ilp,lk @@ -9997,7 +9997,8 @@ module stdlib_linalg_lapack - !> LAGTF: factorizes the matrix (T - lambda*I), where T is an n by n + 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 @@ -10009,7 +10010,6 @@ module stdlib_linalg_lapack !> 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. - interface lagtf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlagtf( n, a, lambda, b, c, tol, d, in, info ) import sp,dp,qp,ilp,lk @@ -10043,12 +10043,12 @@ module stdlib_linalg_lapack - !> LAGTM: performs a matrix-vector product of the form + 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. - interface lagtm #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) @@ -10113,7 +10113,8 @@ module stdlib_linalg_lapack - !> LAGTS: may be used to solve one of the systems of equations + 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 @@ -10122,7 +10123,6 @@ module stdlib_linalg_lapack !> 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. - interface lagts #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlagts( job, n, a, b, c, d, in, y, tol, info ) import sp,dp,qp,ilp,lk @@ -10154,7 +10154,8 @@ module stdlib_linalg_lapack - !> LAHEF: computes a partial factorization of a complex Hermitian + 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: @@ -10167,7 +10168,6 @@ module stdlib_linalg_lapack !> 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'). - interface lahef #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clahef( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) import sp,dp,qp,ilp,lk @@ -10201,7 +10201,8 @@ module stdlib_linalg_lapack - !> LAHEF_AA: factorizes a panel of a complex hermitian matrix A using + 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 @@ -10211,7 +10212,6 @@ module stdlib_linalg_lapack !> 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. - interface lahef_aa #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clahef_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) import sp,dp,qp,ilp,lk @@ -10245,7 +10245,8 @@ module stdlib_linalg_lapack - !> LAHEF_RK: computes a partial factorization of a complex Hermitian + 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: @@ -10257,7 +10258,6 @@ module stdlib_linalg_lapack !> 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'). - interface lahef_rk #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clahef_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) import sp,dp,qp,ilp,lk @@ -10291,7 +10291,8 @@ module stdlib_linalg_lapack - !> LAHEF_ROOK: computes a partial factorization of a complex Hermitian + 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: @@ -10304,7 +10305,6 @@ module stdlib_linalg_lapack !> 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'). - interface lahef_rook #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clahef_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) import sp,dp,qp,ilp,lk @@ -10338,11 +10338,11 @@ module stdlib_linalg_lapack - !> LAHQR: is an auxiliary routine called by CHSEQR to update the + 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. - interface lahqr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, & info ) @@ -10409,7 +10409,8 @@ module stdlib_linalg_lapack - !> LAIC1: applies one step of incremental condition estimation in + 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 @@ -10429,7 +10430,6 @@ module stdlib_linalg_lapack !> diag(sest*sest, 0) + [alpha gamma] * [ conjg(alpha) ] !> [ conjg(gamma) ] !> where alpha = x**H*w. - interface laic1 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claic1( job, j, x, sest, w, gamma, sestpr, s, c ) import sp,dp,qp,ilp,lk @@ -10488,9 +10488,10 @@ module stdlib_linalg_lapack + 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 + !> 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. @@ -10499,7 +10500,6 @@ module stdlib_linalg_lapack !> 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. - interface laisnan #ifdef STDLIB_EXTERNAL_LAPACK pure logical(lk) function dlaisnan( din1, din2 ) import sp,dp,qp,ilp,lk @@ -10525,7 +10525,8 @@ module stdlib_linalg_lapack - !> LALS0: applies back the multiplying factors of either the left or the + 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. @@ -10545,7 +10546,6 @@ module stdlib_linalg_lapack !> null space. !> (3R) The inverse transformation of (2L). !> (4R) The inverse transformation of (1L). - interface lals0 #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -10622,7 +10622,8 @@ module stdlib_linalg_lapack - !> LALSA: is an itermediate step in solving the least squares problem + 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.). @@ -10631,7 +10632,6 @@ module stdlib_linalg_lapack !> 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. - interface lalsa #ifdef STDLIB_EXTERNAL_LAPACK 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 & @@ -10712,7 +10712,8 @@ module stdlib_linalg_lapack - !> LALSD: uses the singular value decomposition of A to solve the least + 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. @@ -10726,7 +10727,6 @@ module stdlib_linalg_lapack !> 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. - interface lalsd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, & rwork, iwork, info ) @@ -10801,10 +10801,10 @@ module stdlib_linalg_lapack - !> LAMRG: will create a permutation list which will merge the elements + 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. - interface lamrg #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlamrg( n1, n2, a, dtrd1, dtrd2, index ) import sp,dp,qp,ilp,lk @@ -10834,14 +10834,14 @@ module stdlib_linalg_lapack - !> LAMSWLQ: overwrites the general complex M-by-N matrix C with + 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) - interface lamswlq #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, & work, lwork, info ) @@ -10912,14 +10912,14 @@ module stdlib_linalg_lapack - !> LAMTSQR: overwrites the general complex M-by-N matrix C with + 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) - interface lamtsqr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, & work, lwork, info ) @@ -10990,7 +10990,8 @@ module stdlib_linalg_lapack - !> LANEG: computes the Sturm count, the number of negative pivots + 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 @@ -11005,7 +11006,6 @@ module stdlib_linalg_lapack !> 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.) - interface laneg #ifdef STDLIB_EXTERNAL_LAPACK pure integer(ilp) function dlaneg( n, d, lld, sigma, pivmin, r ) import sp,dp,qp,ilp,lk @@ -11033,10 +11033,10 @@ module stdlib_linalg_lapack - !> LANGB: returns the value of the one norm, or the Frobenius norm, or + 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. - interface langb #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clangb( norm, n, kl, ku, ab, ldab,work ) import sp,dp,qp,ilp,lk @@ -11095,10 +11095,10 @@ module stdlib_linalg_lapack - !> LANGE: returns the value of the one norm, or the Frobenius norm, or + 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. - interface lange #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clange( norm, m, n, a, lda, work ) import sp,dp,qp,ilp,lk @@ -11157,10 +11157,10 @@ module stdlib_linalg_lapack - !> LANGT: returns the value of the one norm, or the Frobenius norm, or + 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. - interface langt #ifdef STDLIB_EXTERNAL_LAPACK pure real(sp) function clangt( norm, n, dl, d, du ) import sp,dp,qp,ilp,lk @@ -11215,10 +11215,10 @@ module stdlib_linalg_lapack - !> LANHB: returns the value of the one norm, or the Frobenius norm, or + 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. - interface lanhb #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clanhb( norm, uplo, n, k, ab, ldab,work ) import sp,dp,qp,ilp,lk @@ -11250,10 +11250,10 @@ module stdlib_linalg_lapack - !> LANHE: returns the value of the one norm, or the Frobenius norm, or + 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. - interface lanhe #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clanhe( norm, uplo, n, a, lda, work ) import sp,dp,qp,ilp,lk @@ -11285,10 +11285,10 @@ module stdlib_linalg_lapack - !> LANHF: returns the value of the one norm, or the Frobenius norm, or + 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. - interface lanhf #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clanhf( norm, transr, uplo, n, a, work ) import sp,dp,qp,ilp,lk @@ -11320,10 +11320,10 @@ module stdlib_linalg_lapack - !> LANHP: returns the value of the one norm, or the Frobenius norm, or + 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. - interface lanhp #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clanhp( norm, uplo, n, ap, work ) import sp,dp,qp,ilp,lk @@ -11355,10 +11355,10 @@ module stdlib_linalg_lapack - !> LANHS: returns the value of the one norm, or the Frobenius norm, or + 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. - interface lanhs #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clanhs( norm, n, a, lda, work ) import sp,dp,qp,ilp,lk @@ -11417,10 +11417,10 @@ module stdlib_linalg_lapack - !> LANHT: returns the value of the one norm, or the Frobenius norm, or + 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. - interface lanht #ifdef STDLIB_EXTERNAL_LAPACK pure real(sp) function clanht( norm, n, d, e ) import sp,dp,qp,ilp,lk @@ -11452,10 +11452,10 @@ module stdlib_linalg_lapack - !> LANSB: returns the value of the one norm, or the Frobenius norm, or + 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. - interface lansb #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clansb( norm, uplo, n, k, ab, ldab,work ) import sp,dp,qp,ilp,lk @@ -11514,10 +11514,10 @@ module stdlib_linalg_lapack - !> LANSF: returns the value of the one norm, or the Frobenius norm, or + 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. - interface lansf #ifdef STDLIB_EXTERNAL_LAPACK real(dp) function dlansf( norm, transr, uplo, n, a, work ) import sp,dp,qp,ilp,lk @@ -11549,10 +11549,10 @@ module stdlib_linalg_lapack - !> LANSP: returns the value of the one norm, or the Frobenius norm, or + 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. - interface lansp #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clansp( norm, uplo, n, ap, work ) import sp,dp,qp,ilp,lk @@ -11611,10 +11611,10 @@ module stdlib_linalg_lapack - !> LANST: returns the value of the one norm, or the Frobenius norm, or + 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. - interface lanst #ifdef STDLIB_EXTERNAL_LAPACK pure real(dp) function dlanst( norm, n, d, e ) import sp,dp,qp,ilp,lk @@ -11644,10 +11644,10 @@ module stdlib_linalg_lapack - !> LANSY: returns the value of the one norm, or the Frobenius norm, or + 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. - interface lansy #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clansy( norm, uplo, n, a, lda, work ) import sp,dp,qp,ilp,lk @@ -11706,10 +11706,10 @@ module stdlib_linalg_lapack - !> LANTB: returns the value of the one norm, or the Frobenius norm, or + 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. - interface lantb #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clantb( norm, uplo, diag, n, k, ab,ldab, work ) @@ -11770,10 +11770,10 @@ module stdlib_linalg_lapack - !> LANTP: returns the value of the one norm, or the Frobenius norm, or + 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. - interface lantp #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clantp( norm, uplo, diag, n, ap, work ) import sp,dp,qp,ilp,lk @@ -11832,10 +11832,10 @@ module stdlib_linalg_lapack - !> LANTR: returns the value of the one norm, or the Frobenius norm, or + 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. - interface lantr #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clantr( norm, uplo, diag, m, n, a, lda,work ) import sp,dp,qp,ilp,lk @@ -11894,7 +11894,8 @@ module stdlib_linalg_lapack - !> LAORHR_COL_GETRFNP: computes the modified LU factorization without + 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, @@ -11927,7 +11928,6 @@ module stdlib_linalg_lapack !> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, !> E. Solomonik, J. Parallel Distrib. Comput., !> vol. 85, pp. 3-31, 2015. - interface laorhr_col_getrfnp #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaorhr_col_getrfnp( m, n, a, lda, d, info ) import sp,dp,qp,ilp,lk @@ -11959,7 +11959,8 @@ module stdlib_linalg_lapack - !> LAORHR_COL_GETRFNP2: computes the modified LU factorization without + 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, @@ -12007,7 +12008,6 @@ module stdlib_linalg_lapack !> [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. - interface laorhr_col_getrfnp2 #ifdef STDLIB_EXTERNAL_LAPACK pure recursive subroutine dlaorhr_col_getrfnp2( m, n, a, lda, d, info ) import sp,dp,qp,ilp,lk @@ -12039,13 +12039,13 @@ module stdlib_linalg_lapack + 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. - interface lapll #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clapll( n, x, incx, y, incy, ssmin ) import sp,dp,qp,ilp,lk @@ -12100,13 +12100,13 @@ module stdlib_linalg_lapack - !> LAPMR: rearranges the rows of the M by N matrix X as specified + 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. - interface lapmr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clapmr( forwrd, m, n, x, ldx, k ) import sp,dp,qp,ilp,lk @@ -12165,13 +12165,13 @@ module stdlib_linalg_lapack - !> LAPMT: rearranges the columns of the M by N matrix X as specified + 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. - interface lapmt #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clapmt( forwrd, m, n, x, ldx, k ) import sp,dp,qp,ilp,lk @@ -12230,10 +12230,10 @@ module stdlib_linalg_lapack - !> LAQGB: equilibrates a general M by N band matrix A with KL + 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. - interface laqgb #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) @@ -12296,9 +12296,9 @@ module stdlib_linalg_lapack - !> LAQGE: equilibrates a general M by N matrix A using the row and - !> column scaling factors in the vectors R and C. interface laqge + !> LAQGE equilibrates a general M by N matrix A using the row and + !> column scaling factors in the vectors R and C. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed ) import sp,dp,qp,ilp,lk @@ -12357,9 +12357,9 @@ module stdlib_linalg_lapack - !> LAQHB: equilibrates an Hermitian band matrix A using the scaling - !> factors in the vector S. interface laqhb + !> LAQHB equilibrates an Hermitian band matrix A using the scaling + !> factors in the vector S. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqhb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) import sp,dp,qp,ilp,lk @@ -12395,9 +12395,9 @@ module stdlib_linalg_lapack - !> LAQHE: equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. interface laqhe + !> LAQHE equilibrates a Hermitian matrix A using the scaling factors + !> in the vector S. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqhe( uplo, n, a, lda, s, scond, amax, equed ) import sp,dp,qp,ilp,lk @@ -12431,9 +12431,9 @@ module stdlib_linalg_lapack - !> LAQHP: equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. interface laqhp + !> LAQHP equilibrates a Hermitian matrix A using the scaling factors + !> in the vector S. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqhp( uplo, n, ap, s, scond, amax, equed ) import sp,dp,qp,ilp,lk @@ -12467,7 +12467,8 @@ module stdlib_linalg_lapack - !> LAQPS: computes a step of QR factorization with column pivoting + 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. @@ -12475,7 +12476,6 @@ module stdlib_linalg_lapack !> 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. - interface laqps #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & ldf ) @@ -12544,7 +12544,8 @@ module stdlib_linalg_lapack - !> LAQR0: computes the eigenvalues of a Hessenberg matrix H + 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. @@ -12552,7 +12553,6 @@ module stdlib_linalg_lapack !> 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. - interface laqr0 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, & work, lwork, info ) @@ -12619,13 +12619,13 @@ module stdlib_linalg_lapack + 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. - interface laqr1 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqr1( n, h, ldh, s1, s2, v ) import sp,dp,qp,ilp,lk @@ -12680,7 +12680,8 @@ module stdlib_linalg_lapack - !> LAQR4: implements one level of recursion for CLAQR0. + 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 @@ -12694,7 +12695,6 @@ module stdlib_linalg_lapack !> 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. - interface laqr4 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqr4( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, & work, lwork, info ) @@ -12761,9 +12761,9 @@ module stdlib_linalg_lapack - !> LAQR5: called by CLAQR0 performs a - !> single small-bulge multi-shift QR sweep. interface laqr5 + !> LAQR5 called by CLAQR0 performs a + !> single small-bulge multi-shift QR sweep. #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -12830,9 +12830,9 @@ module stdlib_linalg_lapack - !> LAQSB: equilibrates a symmetric band matrix A using the scaling - !> factors in the vector S. interface laqsb + !> LAQSB equilibrates a symmetric band matrix A using the scaling + !> factors in the vector S. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) import sp,dp,qp,ilp,lk @@ -12895,9 +12895,9 @@ module stdlib_linalg_lapack - !> LAQSP: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. interface laqsp + !> LAQSP equilibrates a symmetric matrix A using the scaling factors + !> in the vector S. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqsp( uplo, n, ap, s, scond, amax, equed ) import sp,dp,qp,ilp,lk @@ -12960,9 +12960,9 @@ module stdlib_linalg_lapack - !> LAQSY: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. interface laqsy + !> LAQSY equilibrates a symmetric matrix A using the scaling factors + !> in the vector S. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqsy( uplo, n, a, lda, s, scond, amax, equed ) import sp,dp,qp,ilp,lk @@ -13025,7 +13025,8 @@ module stdlib_linalg_lapack - !> LAQTR: solves the real quasi-triangular system + 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. @@ -13043,7 +13044,6 @@ module stdlib_linalg_lapack !> [ d ] [ q ] !> This subroutine is designed for the condition number estimation !> in routine DTRSNA. - interface laqtr #ifdef STDLIB_EXTERNAL_LAPACK subroutine dlaqtr( ltran, lreal, n, t, ldt, b, w, scale, x, work,info ) import sp,dp,qp,ilp,lk @@ -13079,7 +13079,8 @@ module stdlib_linalg_lapack - !> LAQZ0: computes the eigenvalues of a matrix pair (H,T), + 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 @@ -13119,7 +13120,6 @@ module stdlib_linalg_lapack !> 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" - interface laqz0 #ifdef STDLIB_EXTERNAL_LAPACK recursive subroutine claqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, & alpha, beta, q, ldq, z,ldz, work, lwork, rwork, rec,info ) @@ -13188,8 +13188,8 @@ module stdlib_linalg_lapack - !> LAQZ1: chases a 1x1 shift bulge in a matrix pencil down a single position interface laqz1 + !> LAQZ1 chases a 1x1 shift bulge in a matrix pencil down a single position #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqz1( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, & qstart, q, ldq, nz, zstart, z, ldz ) @@ -13248,8 +13248,8 @@ module stdlib_linalg_lapack - !> LAQZ4: Executes a single multishift QZ sweep interface laqz4 + !> LAQZ4 Executes a single multishift QZ sweep #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -13293,7 +13293,8 @@ module stdlib_linalg_lapack - !> LAR1V: computes the (scaled) r-th column of the inverse of + 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 @@ -13308,7 +13309,6 @@ module stdlib_linalg_lapack !> (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. - interface lar1v #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc,& negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) @@ -13383,14 +13383,14 @@ module stdlib_linalg_lapack - !> LAR2V: applies a vector of complex plane rotations with real cosines + 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) ) - interface lar2v #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clar2v( n, x, y, z, incx, c, s, incc ) import sp,dp,qp,ilp,lk @@ -13447,11 +13447,11 @@ module stdlib_linalg_lapack - !> LARCM: performs a very simple matrix-matrix multiplication: + 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. - interface larcm #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarcm( m, n, a, lda, b, ldb, c, ldc, rwork ) import sp,dp,qp,ilp,lk @@ -13485,7 +13485,8 @@ module stdlib_linalg_lapack - !> LARF: applies a complex elementary reflector H to a complex M-by-N + 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 @@ -13493,7 +13494,6 @@ module stdlib_linalg_lapack !> 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. - interface larf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarf( side, m, n, v, incv, tau, c, ldc, work ) import sp,dp,qp,ilp,lk @@ -13556,9 +13556,9 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, & ldc, work, ldwork ) @@ -13625,14 +13625,14 @@ module stdlib_linalg_lapack - !> LARFB_GETT: applies a complex Householder block reflector H from the + 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. - interface larfb_gett #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) @@ -13699,7 +13699,8 @@ module stdlib_linalg_lapack - !> LARFG: generates a complex elementary reflector H of order n, such + interface larfg + !> LARFG generates a complex elementary reflector H of order n, such !> that !> H**H * ( alpha ) = ( beta ), H**H * H = I. !> ( x ) ( 0 ) @@ -13712,7 +13713,6 @@ module stdlib_linalg_lapack !> 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 . - interface larfg #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarfg( n, alpha, x, incx, tau ) import sp,dp,qp,ilp,lk @@ -13767,7 +13767,8 @@ module stdlib_linalg_lapack - !> LARFGP: generates a complex elementary reflector H of order n, such + interface larfgp + !> LARFGP generates a complex elementary reflector H of order n, such !> that !> H**H * ( alpha ) = ( beta ), H**H * H = I. !> ( x ) ( 0 ) @@ -13779,7 +13780,6 @@ module stdlib_linalg_lapack !> 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. - interface larfgp #ifdef STDLIB_EXTERNAL_LAPACK subroutine clarfgp( n, alpha, x, incx, tau ) import sp,dp,qp,ilp,lk @@ -13834,7 +13834,8 @@ module stdlib_linalg_lapack - !> LARFT: forms the triangular factor T of a complex block reflector H + 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. @@ -13844,7 +13845,6 @@ module stdlib_linalg_lapack !> 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 - interface larft #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarft( direct, storev, n, k, v, ldv, tau, t, ldt ) import sp,dp,qp,ilp,lk @@ -13903,13 +13903,13 @@ module stdlib_linalg_lapack - !> LARFY: applies an elementary reflector, or Householder matrix, H, + 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. - interface larfy #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarfy( uplo, n, v, incv, tau, c, ldc, work ) import sp,dp,qp,ilp,lk @@ -13972,7 +13972,8 @@ module stdlib_linalg_lapack - !> LARGV: generates a vector of complex plane rotations with real + 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) ) @@ -13982,7 +13983,6 @@ module stdlib_linalg_lapack !> 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. - interface largv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clargv( n, x, incx, y, incy, c, incc ) import sp,dp,qp,ilp,lk @@ -14037,9 +14037,9 @@ module stdlib_linalg_lapack - !> LARNV: returns a vector of n random complex numbers from a uniform or - !> normal distribution. interface larnv + !> LARNV returns a vector of n random complex numbers from a uniform or + !> normal distribution. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarnv( idist, iseed, n, x ) import sp,dp,qp,ilp,lk @@ -14094,9 +14094,9 @@ module stdlib_linalg_lapack - !> Compute the splitting points with threshold SPLTOL. - !> LARRA: sets any "small" off-diagonal elements to zero. interface larra + !> Compute the splitting points with threshold SPLTOL. + !> LARRA sets any "small" off-diagonal elements to zero. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlarra( n, d, e, e2, spltol, tnrm,nsplit, isplit, info ) import sp,dp,qp,ilp,lk @@ -14128,6 +14128,7 @@ module stdlib_linalg_lapack + 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 @@ -14136,7 +14137,6 @@ module stdlib_linalg_lapack !> 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. - interface larrb #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlarrb( n, d, lld, ifirst, ilast, rtol1,rtol2, offset, w, wgap, & werr, work, iwork,pivmin, spdiam, twist, info ) @@ -14172,10 +14172,10 @@ module stdlib_linalg_lapack + 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'. - interface larrc #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlarrc( jobt, n, vl, vu, d, e, pivmin,eigcnt, lcnt, rcnt, info ) @@ -14209,7 +14209,8 @@ module stdlib_linalg_lapack - !> LARRD: computes the eigenvalues of a symmetric tridiagonal + 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 @@ -14221,7 +14222,6 @@ module stdlib_linalg_lapack !> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal !> Matrix", Report CS41, Computer Science Dept., Stanford !> University, July 21, 1966. - interface larrd #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -14259,6 +14259,7 @@ module stdlib_linalg_lapack + 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 @@ -14272,7 +14273,6 @@ module stdlib_linalg_lapack !> 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. - interface larre #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -14314,12 +14314,12 @@ module stdlib_linalg_lapack + 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. - interface larrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlarrf( n, d, l, ld, clstrt, clend,w, wgap, werr,spdiam, clgapl, & clgapr, pivmin, sigma,dplus, lplus, work, info ) @@ -14357,6 +14357,7 @@ module stdlib_linalg_lapack + 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 @@ -14364,7 +14365,6 @@ module stdlib_linalg_lapack !> 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. - interface larrj #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlarrj( n, d, e2, ifirst, ilast,rtol, offset, w, werr, work, iwork,& pivmin, spdiam, info ) @@ -14400,7 +14400,8 @@ module stdlib_linalg_lapack - !> LARRK: computes one eigenvalue of a symmetric tridiagonal + 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 @@ -14409,7 +14410,6 @@ module stdlib_linalg_lapack !> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal !> Matrix", Report CS41, Computer Science Dept., Stanford !> University, July 21, 1966. - interface larrk #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlarrk( n, iw, gl, gu,d, e2, pivmin, reltol, w, werr, info) import sp,dp,qp,ilp,lk @@ -14441,10 +14441,10 @@ module stdlib_linalg_lapack + interface larrr !> Perform tests to decide whether the symmetric tridiagonal matrix T !> warrants expensive computations which guarantee high relative accuracy !> in the eigenvalues. - interface larrr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlarrr( n, d, e, info ) import sp,dp,qp,ilp,lk @@ -14476,10 +14476,10 @@ module stdlib_linalg_lapack - !> LARRV: computes the eigenvectors of the tridiagonal matrix + 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. - interface larrv #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -14556,9 +14556,10 @@ module stdlib_linalg_lapack + interface lartg !> ! !> - !> LARTG: generates a plane rotation so that + !> 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. @@ -14580,7 +14581,6 @@ module stdlib_linalg_lapack !> 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. - interface lartg #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clartg( f, g, c, s, r ) import sp,dp,qp,ilp,lk @@ -14633,7 +14633,8 @@ module stdlib_linalg_lapack - !> LARTGP: generates a plane rotation so that + 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, @@ -14642,7 +14643,6 @@ module stdlib_linalg_lapack !> 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. - interface lartgp #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlartgp( f, g, cs, sn, r ) import sp,dp,qp,ilp,lk @@ -14670,7 +14670,8 @@ module stdlib_linalg_lapack - !> LARTGS: generates a plane rotation designed to introduce a bulge in + 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 @@ -14678,7 +14679,6 @@ module stdlib_linalg_lapack !> [ -SN CS ] [ X * Y ] [ 0 ] !> with R nonnegative. If X^2 - SIGMA and X * Y are 0, then the !> rotation is by PI/2. - interface lartgs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlartgs( x, y, sigma, cs, sn ) import sp,dp,qp,ilp,lk @@ -14706,11 +14706,11 @@ module stdlib_linalg_lapack - !> LARTV: applies a vector of complex plane rotations with real cosines + 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) ) - interface lartv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clartv( n, x, incx, y, incy, c, s, incc ) import sp,dp,qp,ilp,lk @@ -14767,10 +14767,10 @@ module stdlib_linalg_lapack - !> LARUV: returns a vector of n random real numbers from a uniform (0,1) + 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. - interface laruv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaruv( iseed, n, x ) import sp,dp,qp,ilp,lk @@ -14800,7 +14800,8 @@ module stdlib_linalg_lapack - !> LARZ: applies a complex elementary reflector H to a complex + 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 @@ -14809,7 +14810,6 @@ module stdlib_linalg_lapack !> 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. - interface larz #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarz( side, m, n, l, v, incv, tau, c, ldc, work ) import sp,dp,qp,ilp,lk @@ -14872,10 +14872,10 @@ module stdlib_linalg_lapack - !> LARZB: applies a complex block reflector H or its transpose H**H + 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. - interface larzb #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & ldc, work, ldwork ) @@ -14938,7 +14938,8 @@ module stdlib_linalg_lapack - !> LARZT: forms the triangular factor T of a complex block reflector + 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; @@ -14950,7 +14951,6 @@ module stdlib_linalg_lapack !> 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. - interface larzt #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) import sp,dp,qp,ilp,lk @@ -15013,12 +15013,12 @@ module stdlib_linalg_lapack - !> LASCL: multiplies the M by N complex matrix A by the real scalar + 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. - interface lascl #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) import sp,dp,qp,ilp,lk @@ -15081,6 +15081,7 @@ module stdlib_linalg_lapack + 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. @@ -15088,7 +15089,6 @@ module stdlib_linalg_lapack !> 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. - interface lasd0 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasd0( n, sqre, d, e, u, ldu, vt, ldvt, smlsiz, iwork,work, info ) @@ -15122,7 +15122,8 @@ module stdlib_linalg_lapack - !> LASD1: computes the SVD of an upper bidiagonal N-by-M matrix B, + 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. @@ -15151,7 +15152,6 @@ module stdlib_linalg_lapack !> directly using the updated singular values. The singular vectors !> for the current problem are multiplied with the singular vectors !> from the overall problem. - interface lasd1 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasd1( nl, nr, sqre, d, alpha, beta, u, ldu, vt, ldvt,idxq, iwork,& work, info ) @@ -15187,6 +15187,7 @@ module stdlib_linalg_lapack + 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 @@ -15198,7 +15199,6 @@ module stdlib_linalg_lapack !> 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. - interface lasd4 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasd4( n, i, d, z, delta, rho, sigma, work, info ) import sp,dp,qp,ilp,lk @@ -15230,6 +15230,7 @@ module stdlib_linalg_lapack + 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 @@ -15238,7 +15239,6 @@ module stdlib_linalg_lapack !> 0 <= D(i) < D(j) for i < j . !> We also assume RHO > 0 and that the Euclidean norm of the vector !> Z is one. - interface lasd5 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasd5( i, d, z, delta, rho, dsigma, work ) import sp,dp,qp,ilp,lk @@ -15268,7 +15268,8 @@ module stdlib_linalg_lapack - !> LASD6: computes the SVD of an updated upper bidiagonal matrix B + 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. @@ -15303,7 +15304,6 @@ module stdlib_linalg_lapack !> between the updated singular values and the old singular !> values. !> LASD6 is called from DLASDA. - interface lasd6 #ifdef STDLIB_EXTERNAL_LAPACK 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, & @@ -15345,14 +15345,14 @@ module stdlib_linalg_lapack - !> LASD7: merges the two sets of singular values together into a single + 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. - interface lasd7 #ifdef STDLIB_EXTERNAL_LAPACK 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, & @@ -15396,14 +15396,14 @@ module stdlib_linalg_lapack - !> LASD8: finds the square roots of the roots of the secular equation, + 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. - interface lasd8 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasd8( icompq, k, d, z, vf, vl, difl, difr, lddifr,dsigma, work, & info ) @@ -15437,6 +15437,7 @@ module stdlib_linalg_lapack + 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 @@ -15445,7 +15446,6 @@ module stdlib_linalg_lapack !> compact form. !> A related subroutine, DLASD0, computes the singular values and !> the singular vectors in explicit form. - interface lasda #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -15483,7 +15483,8 @@ module stdlib_linalg_lapack - !> LASDQ: computes the singular value decomposition (SVD) of a real + 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 @@ -15495,7 +15496,6 @@ module stdlib_linalg_lapack !> 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. - interface lasdq #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasdq( uplo, sqre, n, ncvt, nru, ncc, d, e, vt, ldvt,u, ldu, c, & ldc, work, info ) @@ -15531,9 +15531,9 @@ module stdlib_linalg_lapack - !> LASET: initializes a 2-D array A to BETA on the diagonal and - !> ALPHA on the offdiagonals. interface laset + !> LASET initializes a 2-D array A to BETA on the diagonal and + !> ALPHA on the offdiagonals. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claset( uplo, m, n, alpha, beta, a, lda ) import sp,dp,qp,ilp,lk @@ -15592,7 +15592,8 @@ module stdlib_linalg_lapack - !> LASQ1: computes the singular values of a real N-by-N bidiagonal + 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 @@ -15602,7 +15603,6 @@ module stdlib_linalg_lapack !> 1994, !> and the present implementation is described in "An implementation of !> the dqds Algorithm (Positive Case)", LAPACK Working Note. - interface lasq1 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasq1( n, d, e, work, info ) import sp,dp,qp,ilp,lk @@ -15634,9 +15634,9 @@ module stdlib_linalg_lapack - !> LASQ4: computes an approximation TAU to the smallest eigenvalue - !> using values of d from the previous transform. interface lasq4 + !> LASQ4 computes an approximation TAU to the smallest eigenvalue + !> using values of d from the previous transform. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasq4( i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn,dn1, dn2, tau, & ttype, g ) @@ -15672,9 +15672,9 @@ module stdlib_linalg_lapack - !> LASQ5: computes one dqds transform in ping-pong form, one - !> version for IEEE machines another for non IEEE machines. interface lasq5 + !> LASQ5 computes one dqds transform in ping-pong form, one + !> version for IEEE machines another for non IEEE machines. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasq5( i0, n0, z, pp, tau, sigma, dmin, dmin1, dmin2,dn, dnm1, & dnm2, ieee, eps ) @@ -15710,9 +15710,9 @@ module stdlib_linalg_lapack - !> LASQ6: computes one dqd (shift equal to zero) transform in - !> ping-pong form, with protection against underflow and overflow. interface lasq6 + !> LASQ6 computes one dqd (shift equal to zero) transform in + !> ping-pong form, with protection against underflow and overflow. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasq6( i0, n0, z, pp, dmin, dmin1, dmin2, dn,dnm1, dnm2 ) import sp,dp,qp,ilp,lk @@ -15742,7 +15742,8 @@ module stdlib_linalg_lapack - !> LASR: applies a sequence of real plane rotations to a complex matrix + 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 @@ -15793,7 +15794,6 @@ module stdlib_linalg_lapack !> ( -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. - interface lasr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clasr( side, pivot, direct, m, n, c, s, a, lda ) import sp,dp,qp,ilp,lk @@ -15852,11 +15852,11 @@ module stdlib_linalg_lapack + 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. - interface lasrt #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasrt( id, n, d, info ) import sp,dp,qp,ilp,lk @@ -15888,9 +15888,10 @@ module stdlib_linalg_lapack + interface lassq !> ! !> - !> LASSQ: returns the values scl and smsq such that + !> 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. @@ -15908,7 +15909,6 @@ module stdlib_linalg_lapack !> and !> TINY*EPS -- tiniest representable number; !> HUGE -- biggest representable number. - interface lassq #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine classq( n, x, incx, scl, sumsq ) import sp,dp,qp,ilp,lk @@ -15963,7 +15963,8 @@ module stdlib_linalg_lapack - !> LASWLQ: computes a blocked Tall-Skinny LQ factorization of + 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: @@ -15973,7 +15974,6 @@ module stdlib_linalg_lapack !> 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. - interface laswlq #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) import sp,dp,qp,ilp,lk @@ -16032,9 +16032,9 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claswp( n, a, lda, k1, k2, ipiv, incx ) import sp,dp,qp,ilp,lk @@ -16085,7 +16085,8 @@ module stdlib_linalg_lapack - !> LASYF: computes a partial factorization of a complex symmetric matrix + 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: @@ -16098,7 +16099,6 @@ module stdlib_linalg_lapack !> 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'). - interface lasyf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) import sp,dp,qp,ilp,lk @@ -16161,6 +16161,7 @@ module stdlib_linalg_lapack + 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. @@ -16171,7 +16172,6 @@ module stdlib_linalg_lapack !> 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. - interface lasyf_aa #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) import sp,dp,qp,ilp,lk @@ -16234,7 +16234,8 @@ module stdlib_linalg_lapack - !> LASYF_RK: computes a partial factorization of a complex symmetric + 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: @@ -16246,7 +16247,6 @@ module stdlib_linalg_lapack !> 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'). - interface lasyf_rk #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) import sp,dp,qp,ilp,lk @@ -16309,7 +16309,8 @@ module stdlib_linalg_lapack - !> LASYF_ROOK: computes a partial factorization of a complex symmetric + 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: @@ -16321,7 +16322,6 @@ module stdlib_linalg_lapack !> 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'). - interface lasyf_rook #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) import sp,dp,qp,ilp,lk @@ -16384,7 +16384,8 @@ module stdlib_linalg_lapack - !> LATBS: solves one of the triangular systems + 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 @@ -16394,7 +16395,6 @@ module stdlib_linalg_lapack !> 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. - interface latbs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm,& info ) @@ -16467,7 +16467,8 @@ module stdlib_linalg_lapack - !> LATDF: computes the contribution to the reciprocal Dif-estimate + 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 @@ -16475,7 +16476,6 @@ module stdlib_linalg_lapack !> 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. - interface latdf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) import sp,dp,qp,ilp,lk @@ -16528,7 +16528,8 @@ module stdlib_linalg_lapack - !> LATPS: solves one of the triangular systems + 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 @@ -16539,7 +16540,6 @@ module stdlib_linalg_lapack !> 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. - interface latps #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) @@ -16612,7 +16612,8 @@ module stdlib_linalg_lapack - !> LATRD: reduces NB rows and columns of a complex Hermitian matrix A to + interface latrd + !> LATRD reduces NB rows and columns of a complex Hermitian matrix A to !> Hermitian tridiagonal form by a unitary similarity !> transformation Q**H * A * Q, and returns the matrices V and W which are !> needed to apply the transformation to the unreduced part of A. @@ -16621,7 +16622,6 @@ module stdlib_linalg_lapack !> if UPLO = 'L', LATRD reduces the first NB rows and columns of a !> matrix, of which the lower triangle is supplied. !> This is an auxiliary routine called by CHETRD. - interface latrd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) import sp,dp,qp,ilp,lk @@ -16682,7 +16682,8 @@ module stdlib_linalg_lapack - !> LATRS: solves one of the triangular systems + interface latrs + !> LATRS 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. Here A is an upper or lower !> triangular matrix, A**T denotes the transpose of A, A**H denotes the @@ -16692,7 +16693,6 @@ module stdlib_linalg_lapack !> unscaled problem will not cause overflow, the Level 2 BLAS routine !> CTRSV 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. - interface latrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info & ) @@ -16765,11 +16765,11 @@ module stdlib_linalg_lapack - !> LATRZ: factors the M-by-(M+L) complex upper trapezoidal matrix + interface latrz + !> LATRZ factors the M-by-(M+L) complex upper trapezoidal matrix !> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z by means !> of unitary transformations, where Z is an (M+L)-by-(M+L) unitary !> matrix and, R and A1 are M-by-M upper triangular matrices. - interface latrz #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatrz( m, n, l, a, lda, tau, work ) import sp,dp,qp,ilp,lk @@ -16824,7 +16824,8 @@ module stdlib_linalg_lapack - !> LATSQR: computes a blocked Tall-Skinny QR factorization of + interface latsqr + !> LATSQR computes a blocked Tall-Skinny QR factorization of !> a complex M-by-N matrix A for M >= N: !> A = Q * ( R ), !> ( 0 ) @@ -16835,7 +16836,6 @@ module stdlib_linalg_lapack !> R is an upper-triangular N-by-N matrix, stored on exit in !> the elements on and above the diagonal of the array A. !> 0 is a (M-N)-by-N zero matrix, and is not stored. - interface latsqr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) import sp,dp,qp,ilp,lk @@ -16894,7 +16894,8 @@ module stdlib_linalg_lapack - !> LAUNHR_COL_GETRFNP: computes the modified LU factorization without + interface launhr_col_getrfnp + !> LAUNHR_COL_GETRFNP computes the modified LU factorization without !> pivoting of a complex general M-by-N matrix A. The factorization has !> the form: !> A - S = L * U, @@ -16927,7 +16928,6 @@ module stdlib_linalg_lapack !> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, !> E. Solomonik, J. Parallel Distrib. Comput., !> vol. 85, pp. 3-31, 2015. - interface launhr_col_getrfnp #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claunhr_col_getrfnp( m, n, a, lda, d, info ) import sp,dp,qp,ilp,lk @@ -16959,7 +16959,8 @@ module stdlib_linalg_lapack - !> LAUNHR_COL_GETRFNP2: computes the modified LU factorization without + interface launhr_col_getrfnp2 + !> LAUNHR_COL_GETRFNP2 computes the modified LU factorization without !> pivoting of a complex general M-by-N matrix A. The factorization has !> the form: !> A - S = L * U, @@ -17007,7 +17008,6 @@ module stdlib_linalg_lapack !> [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. - interface launhr_col_getrfnp2 #ifdef STDLIB_EXTERNAL_LAPACK pure recursive subroutine claunhr_col_getrfnp2( m, n, a, lda, d, info ) import sp,dp,qp,ilp,lk @@ -17039,7 +17039,8 @@ module stdlib_linalg_lapack - !> LAUUM: computes the product U * U**H or L**H * L, where the triangular + interface lauum + !> LAUUM computes the product U * U**H or L**H * L, where the triangular !> factor U or L is stored in the upper or lower triangular part of !> the array A. !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, @@ -17047,7 +17048,6 @@ module stdlib_linalg_lapack !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, !> overwriting the factor L in A. !> This is the blocked form of the algorithm, calling Level 3 BLAS. - interface lauum #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clauum( uplo, n, a, lda, info ) import sp,dp,qp,ilp,lk @@ -17106,12 +17106,12 @@ module stdlib_linalg_lapack - !> OPGTR: generates a real orthogonal matrix Q which is defined as the + interface opgtr + !> OPGTR generates a real orthogonal matrix Q which is defined as the !> product of n-1 elementary reflectors H(i) of order n, as returned by !> DSPTRD using packed storage: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - interface opgtr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dopgtr( uplo, n, ap, tau, q, ldq, work, info ) import sp,dp,qp,ilp,lk @@ -17145,7 +17145,8 @@ module stdlib_linalg_lapack - !> OPMTR: overwrites the general real M-by-N matrix C with + interface opmtr + !> OPMTR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -17155,7 +17156,6 @@ module stdlib_linalg_lapack !> storage: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - interface opmtr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dopmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) @@ -17193,7 +17193,8 @@ module stdlib_linalg_lapack - !> ORBDB: simultaneously bidiagonalizes the blocks of an M-by-M + interface orbdb + !> ORBDB simultaneously bidiagonalizes the blocks of an M-by-M !> partitioned orthogonal matrix X: !> [ B11 | B12 0 0 ] !> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**T @@ -17209,7 +17210,6 @@ module stdlib_linalg_lapack !> represented implicitly by Householder vectors. !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented !> implicitly by angles THETA, PHI. - interface orbdb #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) @@ -17249,7 +17249,8 @@ module stdlib_linalg_lapack - !> ORBDB1: simultaneously bidiagonalizes the blocks of a tall and skinny + interface orbdb1 + !> ORBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -17264,7 +17265,6 @@ module stdlib_linalg_lapack !> Householder vectors. !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by !> angles THETA, PHI. - interface orbdb1 #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -17300,7 +17300,8 @@ module stdlib_linalg_lapack - !> ORBDB2: simultaneously bidiagonalizes the blocks of a tall and skinny + interface orbdb2 + !> ORBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -17315,7 +17316,6 @@ module stdlib_linalg_lapack !> Householder vectors. !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by !> angles THETA, PHI. - interface orbdb2 #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -17351,7 +17351,8 @@ module stdlib_linalg_lapack - !> ORBDB3: simultaneously bidiagonalizes the blocks of a tall and skinny + interface orbdb3 + !> ORBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -17366,7 +17367,6 @@ module stdlib_linalg_lapack !> Householder vectors. !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - interface orbdb3 #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -17402,7 +17402,8 @@ module stdlib_linalg_lapack - !> ORBDB4: simultaneously bidiagonalizes the blocks of a tall and skinny + interface orbdb4 + !> ORBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -17417,7 +17418,6 @@ module stdlib_linalg_lapack !> Householder vectors. !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - interface orbdb4 #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, phantom, work, lwork,info ) @@ -17453,7 +17453,8 @@ module stdlib_linalg_lapack - !> ORBDB5: orthogonalizes the column vector + interface orbdb5 + !> ORBDB5 orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] !> with respect to the columns of @@ -17464,7 +17465,6 @@ module stdlib_linalg_lapack !> criterion, then some other vector from the orthogonal complement !> is returned. This vector is chosen in an arbitrary but deterministic !> way. - interface orbdb5 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) @@ -17500,7 +17500,8 @@ module stdlib_linalg_lapack - !> ORBDB6: orthogonalizes the column vector + interface orbdb6 + !> ORBDB6 orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] !> with respect to the columns of @@ -17509,7 +17510,6 @@ module stdlib_linalg_lapack !> The columns of Q must be orthonormal. !> If the projection is zero according to Kahan's "twice is enough" !> criterion, then the zero vector is returned. - interface orbdb6 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) @@ -17545,7 +17545,8 @@ module stdlib_linalg_lapack - !> ORCSD: computes the CS decomposition of an M-by-M partitioned + interface orcsd + !> ORCSD computes the CS decomposition of an M-by-M partitioned !> orthogonal matrix X: !> [ I 0 0 | 0 0 0 ] !> [ 0 C 0 | 0 -S 0 ] @@ -17558,7 +17559,6 @@ module stdlib_linalg_lapack !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in !> which R = MIN(P,M-P,Q,M-Q). - interface orcsd #ifdef STDLIB_EXTERNAL_LAPACK recursive subroutine dorcsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, & x11, ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, & @@ -17602,7 +17602,8 @@ module stdlib_linalg_lapack - !> ORCSD2BY1: computes the CS decomposition of an M-by-Q matrix X with + interface orcsd2by1 + !> ORCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with !> orthonormal columns that has been partitioned into a 2-by-1 block !> structure: !> [ I1 0 0 ] @@ -17617,7 +17618,6 @@ module stdlib_linalg_lapack !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). - interface orcsd2by1 #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorcsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta,& u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, iwork, info ) @@ -17655,12 +17655,12 @@ module stdlib_linalg_lapack - !> ORG2L: generates an m by n real matrix Q with orthonormal columns, + interface org2l + !> ORG2L generates an m by n real matrix Q with orthonormal columns, !> which is defined as the last n columns of a product of k elementary !> reflectors of order m !> Q = H(k) . . . H(2) H(1) !> as returned by DGEQLF. - interface org2l #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorg2l( m, n, k, a, lda, tau, work, info ) import sp,dp,qp,ilp,lk @@ -17694,12 +17694,12 @@ module stdlib_linalg_lapack - !> ORG2R: generates an m by n real matrix Q with orthonormal columns, + interface org2r + !> ORG2R generates an m by n real matrix Q with orthonormal columns, !> which is defined as the first n columns of a product of k elementary !> reflectors of order m !> Q = H(1) H(2) . . . H(k) !> as returned by DGEQRF. - interface org2r #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorg2r( m, n, k, a, lda, tau, work, info ) import sp,dp,qp,ilp,lk @@ -17733,7 +17733,8 @@ module stdlib_linalg_lapack - !> ORGBR: generates one of the real orthogonal matrices Q or P**T + interface orgbr + !> ORGBR generates one of the real orthogonal matrices Q or P**T !> determined by DGEBRD when reducing a real matrix A to bidiagonal !> form: A = Q * B * P**T. Q and P**T are defined as products of !> elementary reflectors H(i) or G(i) respectively. @@ -17749,7 +17750,6 @@ module stdlib_linalg_lapack !> rows of P**T, where n >= m >= k; !> if k >= n, P**T = G(n-1) . . . G(2) G(1) and ORGBR returns P**T as !> an N-by-N matrix. - interface orgbr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorgbr( vect, m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -17785,11 +17785,11 @@ module stdlib_linalg_lapack - !> ORGHR: generates a real orthogonal matrix Q which is defined as the + interface orghr + !> ORGHR generates a real orthogonal matrix Q which is defined as the !> product of IHI-ILO elementary reflectors of order N, as returned by !> DGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - interface orghr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -17823,12 +17823,12 @@ module stdlib_linalg_lapack - !> ORGLQ: generates an M-by-N real matrix Q with orthonormal rows, + interface orglq + !> ORGLQ generates an M-by-N real matrix Q with orthonormal rows, !> which is defined as the first M rows of a product of K elementary !> reflectors of order N !> Q = H(k) . . . H(2) H(1) !> as returned by DGELQF. - interface orglq #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorglq( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -17862,12 +17862,12 @@ module stdlib_linalg_lapack - !> ORGQL: generates an M-by-N real matrix Q with orthonormal columns, + interface orgql + !> ORGQL generates an M-by-N real matrix Q with orthonormal columns, !> which is defined as the last N columns of a product of K elementary !> reflectors of order M !> Q = H(k) . . . H(2) H(1) !> as returned by DGEQLF. - interface orgql #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorgql( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -17901,12 +17901,12 @@ module stdlib_linalg_lapack - !> ORGQR: generates an M-by-N real matrix Q with orthonormal columns, + interface orgqr + !> ORGQR generates an M-by-N real matrix Q with orthonormal columns, !> which is defined as the first N columns of a product of K elementary !> reflectors of order M !> Q = H(1) H(2) . . . H(k) !> as returned by DGEQRF. - interface orgqr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorgqr( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -17940,12 +17940,12 @@ module stdlib_linalg_lapack - !> ORGRQ: generates an M-by-N real matrix Q with orthonormal rows, + interface orgrq + !> ORGRQ generates an M-by-N real matrix Q with orthonormal rows, !> which is defined as the last M rows of a product of K elementary !> reflectors of order N !> Q = H(1) H(2) . . . H(k) !> as returned by DGERQF. - interface orgrq #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorgrq( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -17979,12 +17979,12 @@ module stdlib_linalg_lapack - !> ORGTR: generates a real orthogonal matrix Q which is defined as the + interface orgtr + !> ORGTR generates a real orthogonal matrix Q which is defined as the !> product of n-1 elementary reflectors of order N, as returned by !> DSYTRD: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - interface orgtr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorgtr( uplo, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -18020,12 +18020,12 @@ module stdlib_linalg_lapack - !> ORGTSQR: generates an M-by-N real matrix Q_out with orthonormal columns, + interface orgtsqr + !> ORGTSQR generates an M-by-N real matrix Q_out with orthonormal columns, !> which are the first N columns of a product of real orthogonal !> matrices of order M which are returned by DLATSQR !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). !> See the documentation for DLATSQR. - interface orgtsqr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorgtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -18059,7 +18059,8 @@ module stdlib_linalg_lapack - !> ORGTSQR_ROW: generates an M-by-N real matrix Q_out with + interface orgtsqr_row + !> ORGTSQR_ROW generates an M-by-N real matrix Q_out with !> orthonormal columns from the output of DLATSQR. These N orthonormal !> columns are the first N columns of a product of complex unitary !> matrices Q(k)_in of order M, which are returned by DLATSQR in @@ -18074,7 +18075,6 @@ module stdlib_linalg_lapack !> starting in the bottom row block and continues to the top row block !> (hence _ROW in the routine name). This sweep is in reverse order of !> the order in which DLATSQR generates the output blocks. - interface orgtsqr_row #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorgtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) @@ -18110,7 +18110,8 @@ module stdlib_linalg_lapack - !> ORHR_COL: takes an M-by-N real matrix Q_in with orthonormal columns + interface orhr_col + !> ORHR_COL takes an M-by-N real matrix Q_in with orthonormal columns !> as input, stored in A, and performs Householder Reconstruction (HR), !> i.e. reconstructs Householder vectors V(i) implicitly representing !> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, @@ -18119,7 +18120,6 @@ module stdlib_linalg_lapack !> stored in A on output, and the diagonal entries of S are stored in D. !> Block reflectors are also returned in T !> (same output format as DGEQRT). - interface orhr_col #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorhr_col( m, n, nb, a, lda, t, ldt, d, info ) import sp,dp,qp,ilp,lk @@ -18151,7 +18151,8 @@ module stdlib_linalg_lapack - !> ORM2L: overwrites the general real m by n matrix C with + interface orm2l + !> ORM2L overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T * C if SIDE = 'L' and TRANS = 'T', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -18161,7 +18162,6 @@ module stdlib_linalg_lapack !> Q = H(k) . . . H(2) H(1) !> as returned by DGEQLF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - interface orm2l #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) @@ -18199,7 +18199,8 @@ module stdlib_linalg_lapack - !> ORM2R: overwrites the general real m by n matrix C with + interface orm2r + !> ORM2R overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T* C if SIDE = 'L' and TRANS = 'T', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -18209,7 +18210,6 @@ module stdlib_linalg_lapack !> Q = H(1) H(2) . . . H(k) !> as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - interface orm2r #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) @@ -18247,6 +18247,7 @@ module stdlib_linalg_lapack + interface ormbr !> If VECT = 'Q', ORMBR: overwrites the general real M-by-N matrix C !> with !> SIDE = 'L' SIDE = 'R' @@ -18269,7 +18270,6 @@ module stdlib_linalg_lapack !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: !> if k < nq, P = G(1) G(2) . . . G(k); !> if k >= nq, P = G(1) G(2) . . . G(nq-1). - interface ormbr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, & lwork, info ) @@ -18307,7 +18307,8 @@ module stdlib_linalg_lapack - !> ORMHR: overwrites the general real M-by-N matrix C with + interface ormhr + !> ORMHR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -18315,7 +18316,6 @@ module stdlib_linalg_lapack !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of !> IHI-ILO elementary reflectors, as returned by DGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - interface ormhr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, & lwork, info ) @@ -18353,7 +18353,8 @@ module stdlib_linalg_lapack - !> ORMLQ: overwrites the general real M-by-N matrix C with + interface ormlq + !> ORMLQ overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -18362,7 +18363,6 @@ module stdlib_linalg_lapack !> Q = H(k) . . . H(2) H(1) !> as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - interface ormlq #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18400,7 +18400,8 @@ module stdlib_linalg_lapack - !> ORMQL: overwrites the general real M-by-N matrix C with + interface ormql + !> ORMQL overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -18409,7 +18410,6 @@ module stdlib_linalg_lapack !> Q = H(k) . . . H(2) H(1) !> as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - interface ormql #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18447,7 +18447,8 @@ module stdlib_linalg_lapack - !> ORMQR: overwrites the general real M-by-N matrix C with + interface ormqr + !> ORMQR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -18456,7 +18457,6 @@ module stdlib_linalg_lapack !> Q = H(1) H(2) . . . H(k) !> as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - interface ormqr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18494,7 +18494,8 @@ module stdlib_linalg_lapack - !> ORMRQ: overwrites the general real M-by-N matrix C with + interface ormrq + !> ORMRQ overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -18503,7 +18504,6 @@ module stdlib_linalg_lapack !> Q = H(1) H(2) . . . H(k) !> as returned by DGERQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - interface ormrq #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18541,7 +18541,8 @@ module stdlib_linalg_lapack - !> ORMRZ: overwrites the general real M-by-N matrix C with + interface ormrz + !> ORMRZ overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -18550,7 +18551,6 @@ module stdlib_linalg_lapack !> Q = H(1) H(2) . . . H(k) !> as returned by DTZRZF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - interface ormrz #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18588,7 +18588,8 @@ module stdlib_linalg_lapack - !> ORMTR: overwrites the general real M-by-N matrix C with + interface ormtr + !> ORMTR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -18597,7 +18598,6 @@ module stdlib_linalg_lapack !> nq-1 elementary reflectors, as returned by DSYTRD: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - interface ormtr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18635,13 +18635,13 @@ module stdlib_linalg_lapack - !> PBCON: estimates the reciprocal of the condition number (in the + interface pbcon + !> PBCON estimates the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite band matrix using !> the Cholesky factorization A = U**H*U or A = L*L**H computed by !> CPBTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - interface pbcon #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,rwork, info ) @@ -18712,7 +18712,8 @@ module stdlib_linalg_lapack - !> PBEQU: computes row and column scalings intended to equilibrate a + interface pbequ + !> PBEQU computes row and column scalings intended to equilibrate a !> Hermitian positive definite band matrix A and reduce its condition !> number (with respect to the two-norm). S contains the scale factors, !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with @@ -18720,7 +18721,6 @@ module stdlib_linalg_lapack !> choice of S puts the condition number of B within a factor N of the !> smallest possible condition number over all possible diagonal !> scalings. - interface pbequ #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) import sp,dp,qp,ilp,lk @@ -18783,11 +18783,11 @@ module stdlib_linalg_lapack - !> PBRFS: improves the computed solution to a system of linear + interface pbrfs + !> PBRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite !> and banded, and provides error bounds and backward error estimates !> for the solution. - interface pbrfs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, & ferr, berr, work, rwork, info ) @@ -18860,7 +18860,8 @@ module stdlib_linalg_lapack - !> PBSTF: computes a split Cholesky factorization of a complex + interface pbstf + !> PBSTF computes a split Cholesky factorization of a complex !> Hermitian positive definite band matrix A. !> This routine is designed to be used in conjunction with CHBGST. !> The factorization has the form A = S**H*S where S is a band matrix @@ -18869,7 +18870,6 @@ module stdlib_linalg_lapack !> ( M L ) !> where U is upper triangular of order m = (n+kd)/2, and L is lower !> triangular of order n-m. - interface pbstf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbstf( uplo, n, kd, ab, ldab, info ) import sp,dp,qp,ilp,lk @@ -18928,7 +18928,8 @@ module stdlib_linalg_lapack - !> PBSV: computes the solution to a complex system of linear equations + interface pbsv + !> PBSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite band matrix and X !> and B are N-by-NRHS matrices. @@ -18939,7 +18940,6 @@ module stdlib_linalg_lapack !> triangular band matrix, with the same number of superdiagonals or !> subdiagonals as A. The factored form of A is then used to solve the !> system of equations A * X = B. - interface pbsv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -18998,13 +18998,13 @@ module stdlib_linalg_lapack - !> PBTRF: computes the Cholesky factorization of a complex Hermitian + interface pbtrf + !> PBTRF computes the Cholesky factorization of a complex Hermitian !> positive definite band matrix A. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. - interface pbtrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbtrf( uplo, n, kd, ab, ldab, info ) import sp,dp,qp,ilp,lk @@ -19063,10 +19063,10 @@ module stdlib_linalg_lapack - !> PBTRS: solves a system of linear equations A*X = B with a Hermitian + interface pbtrs + !> PBTRS solves a system of linear equations A*X = B with a Hermitian !> positive definite band matrix A using the Cholesky factorization !> A = U**H*U or A = L*L**H computed by CPBTRF. - interface pbtrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -19129,14 +19129,14 @@ module stdlib_linalg_lapack - !> PFTRF: computes the Cholesky factorization of a complex Hermitian + interface pftrf + !> PFTRF computes the Cholesky factorization of a complex Hermitian !> positive definite matrix A. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the block version of the algorithm, calling Level 3 BLAS. - interface pftrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpftrf( transr, uplo, n, a, info ) import sp,dp,qp,ilp,lk @@ -19195,10 +19195,10 @@ module stdlib_linalg_lapack - !> PFTRI: computes the inverse of a complex Hermitian positive definite + interface pftri + !> PFTRI computes the inverse of a complex Hermitian positive definite !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H !> computed by CPFTRF. - interface pftri #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpftri( transr, uplo, n, a, info ) import sp,dp,qp,ilp,lk @@ -19257,10 +19257,10 @@ module stdlib_linalg_lapack - !> PFTRS: solves a system of linear equations A*X = B with a Hermitian + interface pftrs + !> PFTRS solves a system of linear equations A*X = B with a Hermitian !> positive definite matrix A using the Cholesky factorization !> A = U**H*U or A = L*L**H computed by CPFTRF. - interface pftrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpftrs( transr, uplo, n, nrhs, a, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -19323,12 +19323,12 @@ module stdlib_linalg_lapack - !> POCON: estimates the reciprocal of the condition number (in the + interface pocon + !> POCON estimates the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite matrix using the !> Cholesky factorization A = U**H*U or A = L*L**H computed by CPOTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - interface pocon #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpocon( uplo, n, a, lda, anorm, rcond, work, rwork,info ) import sp,dp,qp,ilp,lk @@ -19397,7 +19397,8 @@ module stdlib_linalg_lapack - !> POEQU: computes row and column scalings intended to equilibrate a + interface poequ + !> POEQU computes row and column scalings intended to equilibrate a !> Hermitian positive definite matrix A and reduce its condition number !> (with respect to the two-norm). S contains the scale factors, !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with @@ -19405,7 +19406,6 @@ module stdlib_linalg_lapack !> choice of S puts the condition number of B within a factor N of the !> smallest possible condition number over all possible diagonal !> scalings. - interface poequ #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpoequ( n, a, lda, s, scond, amax, info ) import sp,dp,qp,ilp,lk @@ -19464,7 +19464,8 @@ module stdlib_linalg_lapack - !> POEQUB: computes row and column scalings intended to equilibrate a + interface poequb + !> POEQUB computes row and column scalings intended to equilibrate a !> Hermitian positive definite matrix A and reduce its condition number !> (with respect to the two-norm). S contains the scale factors, !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with @@ -19477,7 +19478,6 @@ module stdlib_linalg_lapack !> these factors introduces no additional rounding errors. However, the !> scaled diagonal entries are no longer approximately 1 but lie !> between sqrt(radix) and 1/sqrt(radix). - interface poequb #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpoequb( n, a, lda, s, scond, amax, info ) import sp,dp,qp,ilp,lk @@ -19536,11 +19536,11 @@ module stdlib_linalg_lapack - !> PORFS: improves the computed solution to a system of linear + interface porfs + !> PORFS improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite, !> and provides error bounds and backward error estimates for the !> solution. - interface porfs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr,& work, rwork, info ) @@ -19613,7 +19613,8 @@ module stdlib_linalg_lapack - !> POSV: computes the solution to a complex system of linear equations + interface posv + !> POSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite matrix and X and B !> are N-by-NRHS matrices. @@ -19623,7 +19624,6 @@ module stdlib_linalg_lapack !> where U is an upper triangular matrix and L is a lower triangular !> matrix. The factored form of A is then used to solve the system of !> equations A * X = B. - interface posv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cposv( uplo, n, nrhs, a, lda, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -19682,14 +19682,14 @@ module stdlib_linalg_lapack - !> POTRF: computes the Cholesky factorization of a complex Hermitian + interface potrf + !> POTRF computes the Cholesky factorization of a complex Hermitian !> positive definite matrix A. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the block version of the algorithm, calling Level 3 BLAS. - interface potrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpotrf( uplo, n, a, lda, info ) import sp,dp,qp,ilp,lk @@ -19748,7 +19748,8 @@ module stdlib_linalg_lapack - !> POTRF2: computes the Cholesky factorization of a Hermitian + interface potrf2 + !> POTRF2 computes the Cholesky factorization of a Hermitian !> positive definite matrix A using the recursive algorithm. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or @@ -19761,7 +19762,6 @@ module stdlib_linalg_lapack !> [ A21 | A22 ] n2 = n-n1 !> The subroutine calls itself to factor A11. Update and scale A21 !> or A12, update A22 then calls itself to factor A22. - interface potrf2 #ifdef STDLIB_EXTERNAL_LAPACK pure recursive subroutine cpotrf2( uplo, n, a, lda, info ) import sp,dp,qp,ilp,lk @@ -19820,10 +19820,10 @@ module stdlib_linalg_lapack - !> POTRI: computes the inverse of a complex Hermitian positive definite + interface potri + !> POTRI computes the inverse of a complex Hermitian positive definite !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H !> computed by CPOTRF. - interface potri #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpotri( uplo, n, a, lda, info ) import sp,dp,qp,ilp,lk @@ -19882,10 +19882,10 @@ module stdlib_linalg_lapack - !> POTRS: solves a system of linear equations A*X = B with a Hermitian + interface potrs + !> POTRS solves a system of linear equations A*X = B with a Hermitian !> positive definite matrix A using the Cholesky factorization !> A = U**H*U or A = L*L**H computed by CPOTRF. - interface potrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpotrs( uplo, n, nrhs, a, lda, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -19948,13 +19948,13 @@ module stdlib_linalg_lapack - !> PPCON: estimates the reciprocal of the condition number (in the + interface ppcon + !> PPCON estimates the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite packed matrix using !> the Cholesky factorization A = U**H*U or A = L*L**H computed by !> CPPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - interface ppcon #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cppcon( uplo, n, ap, anorm, rcond, work, rwork, info ) import sp,dp,qp,ilp,lk @@ -20021,7 +20021,8 @@ module stdlib_linalg_lapack - !> PPEQU: computes row and column scalings intended to equilibrate a + interface ppequ + !> PPEQU computes row and column scalings intended to equilibrate a !> Hermitian positive definite matrix A in packed storage and reduce !> its condition number (with respect to the two-norm). S contains the !> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix @@ -20029,7 +20030,6 @@ module stdlib_linalg_lapack !> This choice of S puts the condition number of B within a factor N of !> the smallest possible condition number over all possible diagonal !> scalings. - interface ppequ #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cppequ( uplo, n, ap, s, scond, amax, info ) import sp,dp,qp,ilp,lk @@ -20092,11 +20092,11 @@ module stdlib_linalg_lapack - !> PPRFS: improves the computed solution to a system of linear + interface pprfs + !> PPRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite !> and packed, and provides error bounds and backward error estimates !> for the solution. - interface pprfs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & rwork, info ) @@ -20169,7 +20169,8 @@ module stdlib_linalg_lapack - !> PPSV: computes the solution to a complex system of linear equations + interface ppsv + !> PPSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite matrix stored in !> packed format and X and B are N-by-NRHS matrices. @@ -20179,7 +20180,6 @@ module stdlib_linalg_lapack !> where U is an upper triangular matrix and L is a lower triangular !> matrix. The factored form of A is then used to solve the system of !> equations A * X = B. - interface ppsv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cppsv( uplo, n, nrhs, ap, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -20238,13 +20238,13 @@ module stdlib_linalg_lapack - !> PPTRF: computes the Cholesky factorization of a complex Hermitian + interface pptrf + !> PPTRF computes the Cholesky factorization of a complex Hermitian !> positive definite matrix A stored in packed format. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. - interface pptrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpptrf( uplo, n, ap, info ) import sp,dp,qp,ilp,lk @@ -20303,10 +20303,10 @@ module stdlib_linalg_lapack - !> PPTRI: computes the inverse of a complex Hermitian positive definite + interface pptri + !> PPTRI computes the inverse of a complex Hermitian positive definite !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H !> computed by CPPTRF. - interface pptri #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpptri( uplo, n, ap, info ) import sp,dp,qp,ilp,lk @@ -20365,10 +20365,10 @@ module stdlib_linalg_lapack - !> PPTRS: solves a system of linear equations A*X = B with a Hermitian + interface pptrs + !> PPTRS solves a system of linear equations A*X = B with a Hermitian !> positive definite matrix A in packed storage using the Cholesky !> factorization A = U**H*U or A = L*L**H computed by CPPTRF. - interface pptrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpptrs( uplo, n, nrhs, ap, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -20431,7 +20431,8 @@ module stdlib_linalg_lapack - !> PSTRF: computes the Cholesky factorization with complete + interface pstrf + !> PSTRF computes the Cholesky factorization with complete !> pivoting of a complex Hermitian positive semidefinite matrix A. !> The factorization has the form !> P**T * A * P = U**H * U , if UPLO = 'U', @@ -20440,7 +20441,6 @@ module stdlib_linalg_lapack !> P is stored as vector PIV. !> This algorithm does not attempt to check that A is positive !> semidefinite. This version of the algorithm calls level 3 BLAS. - interface pstrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) import sp,dp,qp,ilp,lk @@ -20507,14 +20507,14 @@ module stdlib_linalg_lapack - !> PTCON: computes the reciprocal of the condition number (in the + interface ptcon + !> PTCON computes the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite tridiagonal matrix !> using the factorization A = L*D*L**H or A = U**H*D*U computed by !> CPTTRF. !> Norm(inv(A)) is computed by a direct method, and the reciprocal of !> the condition number is computed as !> RCOND = 1 / (ANORM * norm(inv(A))). - interface ptcon #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cptcon( n, d, e, anorm, rcond, rwork, info ) import sp,dp,qp,ilp,lk @@ -20575,7 +20575,8 @@ module stdlib_linalg_lapack - !> PTEQR: computes all eigenvalues and, optionally, eigenvectors of a + interface pteqr + !> PTEQR computes all eigenvalues and, optionally, eigenvectors of a !> symmetric positive definite tridiagonal matrix by first factoring the !> matrix using SPTTRF and then calling CBDSQR to compute the singular !> values of the bidiagonal factor. @@ -20590,7 +20591,6 @@ module stdlib_linalg_lapack !> tridiagonal form, however, may preclude the possibility of obtaining !> high relative accuracy in the small eigenvalues of the original !> matrix, if these eigenvalues range over many orders of magnitude.) - interface pteqr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpteqr( compz, n, d, e, z, ldz, work, info ) import sp,dp,qp,ilp,lk @@ -20655,11 +20655,11 @@ module stdlib_linalg_lapack - !> PTRFS: improves the computed solution to a system of linear + interface ptrfs + !> PTRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite !> and tridiagonal, and provides error bounds and backward error !> estimates for the solution. - interface ptrfs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cptrfs( uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx,ferr, berr, & work, rwork, info ) @@ -20732,12 +20732,12 @@ module stdlib_linalg_lapack - !> PTSV: computes the solution to a complex system of linear equations + interface ptsv + !> PTSV computes the solution to a complex system of linear equations !> A*X = B, where A is an N-by-N Hermitian positive definite tridiagonal !> matrix, and X and B are N-by-NRHS matrices. !> A is factored as A = L*D*L**H, and the factored form of A is then !> used to solve the system of equations. - interface ptsv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cptsv( n, nrhs, d, e, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -20794,10 +20794,10 @@ module stdlib_linalg_lapack - !> PTTRF: computes the L*D*L**H factorization of a complex Hermitian + interface pttrf + !> PTTRF computes the L*D*L**H factorization of a complex Hermitian !> positive definite tridiagonal matrix A. The factorization may also !> be regarded as having the form A = U**H *D*U. - interface pttrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpttrf( n, d, e, info ) import sp,dp,qp,ilp,lk @@ -20854,13 +20854,13 @@ module stdlib_linalg_lapack - !> PTTRS: solves a tridiagonal system of the form + interface pttrs + !> PTTRS solves a tridiagonal system of the form !> A * X = B !> using the factorization A = U**H*D*U or A = L*D*L**H computed by CPTTRF. !> D is a diagonal matrix specified in the vector D, U (or L) is a unit !> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in !> the vector E, and X and B are N by NRHS matrices. - interface pttrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpttrs( uplo, n, nrhs, d, e, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -20923,9 +20923,9 @@ module stdlib_linalg_lapack - !> ROT: applies a plane rotation, where the cos (C) is real and the - !> sin (S) is complex, and the vectors CX and CY are complex. interface rot + !> ROT applies a plane rotation, where the cos (C) is real and the + !> sin (S) is complex, and the vectors CX and CY are complex. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine crot( n, cx, incx, cy, incy, c, s ) import sp,dp,qp,ilp,lk @@ -20957,10 +20957,10 @@ module stdlib_linalg_lapack - !> RSCL: multiplies an n-element real vector x by the real scalar 1/a. + interface rscl + !> RSCL multiplies an n-element real vector x by the real scalar 1/a. !> This is done without overflow or underflow as long as !> the final result x/a does not overflow or underflow. - interface rscl #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine drscl( n, sa, sx, incx ) import sp,dp,qp,ilp,lk @@ -20990,9 +20990,9 @@ module stdlib_linalg_lapack - !> SB2ST_KERNELS: is an internal routine used by the DSYTRD_SB2ST - !> subroutine. interface sb2st_kernels + !> SB2ST_KERNELS is an internal routine used by the DSYTRD_SB2ST + !> subroutine. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, & lda, v, tau, ldvt, work) @@ -21028,9 +21028,9 @@ module stdlib_linalg_lapack - !> SBEV: computes all the eigenvalues and, optionally, eigenvectors of - !> a real symmetric band matrix A. interface sbev + !> SBEV computes all the eigenvalues and, optionally, eigenvectors of + !> a real symmetric band matrix A. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,info ) import sp,dp,qp,ilp,lk @@ -21064,7 +21064,8 @@ module stdlib_linalg_lapack - !> SBEVD: computes all the eigenvalues and, optionally, eigenvectors of + interface sbevd + !> SBEVD computes all the eigenvalues and, optionally, eigenvectors of !> a real symmetric band matrix A. If eigenvectors are desired, it uses !> a divide and conquer algorithm. !> The divide and conquer algorithm makes very mild assumptions about @@ -21073,7 +21074,6 @@ module stdlib_linalg_lapack !> 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. - interface sbevd #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, iwork, & liwork, info ) @@ -21109,14 +21109,14 @@ module stdlib_linalg_lapack - !> SBGST: reduces a real symmetric-definite banded generalized + interface sbgst + !> SBGST reduces a real symmetric-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**T*S by DPBSTF, using a !> split Cholesky factorization. A is overwritten by C = X**T*A*X, where !> X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the !> bandwidth of A. - interface sbgst #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, & info ) @@ -21154,11 +21154,11 @@ module stdlib_linalg_lapack - !> SBGV: computes all the eigenvalues, and optionally, the eigenvectors + interface sbgv + !> SBGV computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-definite banded eigenproblem, of !> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric !> and banded, and B is also positive definite. - interface sbgv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & info ) @@ -21194,7 +21194,8 @@ module stdlib_linalg_lapack - !> SBGVD: computes all the eigenvalues, and optionally, the eigenvectors + interface sbgvd + !> SBGVD computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-definite banded eigenproblem, of the !> form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric and !> banded, and B is also positive definite. If eigenvectors are @@ -21205,7 +21206,6 @@ module stdlib_linalg_lapack !> 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. - interface sbgvd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & lwork, iwork, liwork, info ) @@ -21241,10 +21241,10 @@ module stdlib_linalg_lapack - !> SBTRD: reduces a real symmetric band matrix A to symmetric + interface sbtrd + !> SBTRD reduces a real symmetric band matrix A to symmetric !> tridiagonal form T by an orthogonal similarity transformation: !> Q**T * A * Q = T. - interface sbtrd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) @@ -21280,15 +21280,15 @@ module stdlib_linalg_lapack + interface sfrk !> Level 3 BLAS like routine for C in RFP Format. - !> SFRK: performs one of the symmetric rank--k operations + !> SFRK performs one of the symmetric rank--k operations !> C := alpha*A*A**T + beta*C, !> or !> C := alpha*A**T*A + beta*C, !> where alpha and beta are real scalars, C is an n--by--n symmetric !> matrix and A is an n--by--k matrix in the first case and a k--by--n !> matrix in the second case. - interface sfrk #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) import sp,dp,qp,ilp,lk @@ -21320,12 +21320,12 @@ module stdlib_linalg_lapack - !> SPCON: estimates the reciprocal of the condition number (in the + interface spcon + !> SPCON estimates the reciprocal of the condition number (in the !> 1-norm) of a complex symmetric packed matrix A using the !> factorization A = U*D*U**T or A = L*D*L**T computed by CSPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - interface spcon #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cspcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) import sp,dp,qp,ilp,lk @@ -21392,9 +21392,9 @@ module stdlib_linalg_lapack - !> SPEV: computes all the eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A in packed storage. interface spev + !> SPEV computes all the eigenvalues and, optionally, eigenvectors of a + !> real symmetric matrix A in packed storage. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dspev( jobz, uplo, n, ap, w, z, ldz, work, info ) import sp,dp,qp,ilp,lk @@ -21428,7 +21428,8 @@ module stdlib_linalg_lapack - !> SPEVD: computes all the eigenvalues and, optionally, eigenvectors + interface spevd + !> SPEVD computes all the eigenvalues and, optionally, eigenvectors !> of a real symmetric 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 @@ -21437,7 +21438,6 @@ module stdlib_linalg_lapack !> 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. - interface spevd #ifdef STDLIB_EXTERNAL_LAPACK subroutine dspevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,iwork, liwork, info ) @@ -21473,14 +21473,14 @@ module stdlib_linalg_lapack - !> SPGST: reduces a real symmetric-definite generalized eigenproblem + interface spgst + !> SPGST reduces a real symmetric-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**T)*A*inv(U) or inv(L)*A*inv(L**T) !> 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**T or L**T*A*L. !> B must have been previously factorized as U**T*U or L*L**T by DPPTRF. - interface spgst #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dspgst( itype, uplo, n, ap, bp, info ) import sp,dp,qp,ilp,lk @@ -21514,12 +21514,12 @@ module stdlib_linalg_lapack - !> SPGV: computes all the eigenvalues and, optionally, the eigenvectors + interface spgv + !> SPGV computes all the eigenvalues and, optionally, the eigenvectors !> of a real generalized symmetric-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 symmetric, stored in packed format, !> and B is also positive definite. - interface spgv #ifdef STDLIB_EXTERNAL_LAPACK subroutine dspgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,info ) import sp,dp,qp,ilp,lk @@ -21553,7 +21553,8 @@ module stdlib_linalg_lapack - !> SPGVD: computes all the eigenvalues, and optionally, the eigenvectors + interface spgvd + !> SPGVD computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-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 symmetric, stored in packed format, and B is also @@ -21565,7 +21566,6 @@ module stdlib_linalg_lapack !> 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. - interface spgvd #ifdef STDLIB_EXTERNAL_LAPACK subroutine dspgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, iwork, & liwork, info ) @@ -21601,11 +21601,11 @@ module stdlib_linalg_lapack - !> SPMV: performs the matrix-vector operation + interface spmv + !> SPMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix, supplied in packed form. - interface spmv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cspmv( uplo, n, alpha, ap, x, incx, beta, y, incy ) import sp,dp,qp,ilp,lk @@ -21637,11 +21637,11 @@ module stdlib_linalg_lapack - !> SPR: performs the symmetric rank 1 operation + interface spr + !> SPR performs the symmetric rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a complex scalar, x is an n element vector and A is an !> n by n symmetric matrix, supplied in packed form. - interface spr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cspr( uplo, n, alpha, x, incx, ap ) import sp,dp,qp,ilp,lk @@ -21673,11 +21673,11 @@ module stdlib_linalg_lapack - !> SPRFS: improves the computed solution to a system of linear + interface sprfs + !> SPRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric indefinite !> and packed, and provides error bounds and backward error estimates !> for the solution. - interface sprfs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, & work, rwork, info ) @@ -21750,7 +21750,8 @@ module stdlib_linalg_lapack - !> SPSV: computes the solution to a complex system of linear equations + interface spsv + !> SPSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix stored in packed format and X !> and B are N-by-NRHS matrices. @@ -21761,7 +21762,6 @@ module stdlib_linalg_lapack !> triangular matrices, D is symmetric 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. - interface spsv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -21820,10 +21820,10 @@ module stdlib_linalg_lapack - !> SPTRD: reduces a real symmetric matrix A stored in packed form to + interface sptrd + !> SPTRD reduces a real symmetric matrix A stored in packed form to !> symmetric tridiagonal form T by an orthogonal similarity !> transformation: Q**T * A * Q = T. - interface sptrd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsptrd( uplo, n, ap, d, e, tau, info ) import sp,dp,qp,ilp,lk @@ -21857,14 +21857,14 @@ module stdlib_linalg_lapack - !> SPTRF: computes the factorization of a complex symmetric matrix A + interface sptrf + !> SPTRF computes the factorization of a complex symmetric matrix A !> stored in packed format using the Bunch-Kaufman diagonal pivoting !> method: !> 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 symmetric and block diagonal with !> 1-by-1 and 2-by-2 diagonal blocks. - interface sptrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csptrf( uplo, n, ap, ipiv, info ) import sp,dp,qp,ilp,lk @@ -21923,10 +21923,10 @@ module stdlib_linalg_lapack - !> SPTRI: computes the inverse of a complex symmetric indefinite matrix + interface sptri + !> SPTRI computes the inverse of a complex symmetric indefinite matrix !> A in packed storage using the factorization A = U*D*U**T or !> A = L*D*L**T computed by CSPTRF. - interface sptri #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csptri( uplo, n, ap, ipiv, work, info ) import sp,dp,qp,ilp,lk @@ -21989,10 +21989,10 @@ module stdlib_linalg_lapack - !> SPTRS: solves a system of linear equations A*X = B with a complex + interface sptrs + !> SPTRS solves a system of linear equations A*X = B with a complex !> symmetric matrix A stored in packed format using the factorization !> A = U*D*U**T or A = L*D*L**T computed by CSPTRF. - interface sptrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -22055,7 +22055,8 @@ module stdlib_linalg_lapack - !> STEBZ: computes the eigenvalues of a symmetric tridiagonal + interface stebz + !> STEBZ computes the eigenvalues of a symmetric tridiagonal !> matrix T. The user may ask for all eigenvalues, all eigenvalues !> in the half-open interval (VL, VU], or the IL-th through IU-th !> eigenvalues. @@ -22065,7 +22066,6 @@ module stdlib_linalg_lapack !> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal !> Matrix", Report CS41, Computer Science Dept., Stanford !> University, July 21, 1966. - interface stebz #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dstebz( range, order, n, vl, vu, il, iu, abstol, d, e,m, nsplit, w,& iblock, isplit, work, iwork,info ) @@ -22103,7 +22103,8 @@ module stdlib_linalg_lapack - !> STEDC: computes all eigenvalues and, optionally, eigenvectors of a + interface stedc + !> STEDC computes all eigenvalues and, optionally, eigenvectors of a !> symmetric tridiagonal matrix using the divide and conquer method. !> The eigenvectors of a full or band complex Hermitian matrix can also !> be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this @@ -22114,7 +22115,6 @@ module stdlib_linalg_lapack !> 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 SLAED3 for details. - interface stedc #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cstedc( compz, n, d, e, z, ldz, work, lwork, rwork,lrwork, iwork, & liwork, info ) @@ -22185,7 +22185,8 @@ module stdlib_linalg_lapack - !> STEGR: computes selected eigenvalues and, optionally, eigenvectors + interface stegr + !> STEGR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has !> a well defined set of pairwise different real eigenvalues, the corresponding !> real eigenvectors are pairwise orthogonal. @@ -22201,7 +22202,6 @@ module stdlib_linalg_lapack !> NaNs. Normal execution may create these exceptiona values and hence !> may abort due to a floating point exception in environments which !> do not conform to the IEEE-754 standard. - interface stegr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & isuppz, work, lwork, iwork,liwork, info ) @@ -22274,7 +22274,8 @@ module stdlib_linalg_lapack - !> STEIN: computes the eigenvectors of a real symmetric tridiagonal + interface stein + !> STEIN computes the eigenvectors of a real symmetric tridiagonal !> matrix T corresponding to specified eigenvalues, using inverse !> iteration. !> The maximum number of iterations allowed for each eigenvector is @@ -22283,7 +22284,6 @@ module stdlib_linalg_lapack !> array, which may be passed to CUNMTR or CUPMTR for back !> transformation to the eigenvectors of a complex Hermitian matrix !> which was reduced to tridiagonal form. - interface stein #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & info ) @@ -22348,7 +22348,8 @@ module stdlib_linalg_lapack - !> STEMR: computes selected eigenvalues and, optionally, eigenvectors + interface stemr + !> STEMR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has !> a well defined set of pairwise different real eigenvalues, the corresponding !> real eigenvectors are pairwise orthogonal. @@ -22407,7 +22408,6 @@ module stdlib_linalg_lapack !> Since LAPACK drivers overwrite the matrix data with the eigenvectors, !> STEMR accepts complex workspace to facilitate interoperability !> with CUNMTR or CUPMTR. - interface stemr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & isuppz, tryrac, work, lwork,iwork, liwork, info ) @@ -22484,12 +22484,12 @@ module stdlib_linalg_lapack - !> STEQR: computes all eigenvalues and, optionally, eigenvectors of a + interface steqr + !> STEQR computes all eigenvalues and, optionally, eigenvectors of a !> symmetric tridiagonal matrix using the implicit QL or QR method. !> The eigenvectors of a full or band complex Hermitian matrix can also !> be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this !> matrix to tridiagonal form. - interface steqr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csteqr( compz, n, d, e, z, ldz, work, info ) import sp,dp,qp,ilp,lk @@ -22554,9 +22554,9 @@ module stdlib_linalg_lapack - !> STERF: computes all eigenvalues of a symmetric tridiagonal matrix - !> using the Pal-Walker-Kahan variant of the QL or QR algorithm. interface sterf + !> STERF computes all eigenvalues of a symmetric tridiagonal matrix + !> using the Pal-Walker-Kahan variant of the QL or QR algorithm. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsterf( n, d, e, info ) import sp,dp,qp,ilp,lk @@ -22586,9 +22586,9 @@ module stdlib_linalg_lapack - !> STEV: computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric tridiagonal matrix A. interface stev + !> STEV computes all eigenvalues and, optionally, eigenvectors of a + !> real symmetric tridiagonal matrix A. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dstev( jobz, n, d, e, z, ldz, work, info ) import sp,dp,qp,ilp,lk @@ -22622,7 +22622,8 @@ module stdlib_linalg_lapack - !> STEVD: computes all eigenvalues and, optionally, eigenvectors of a + interface stevd + !> STEVD computes all eigenvalues and, optionally, eigenvectors of a !> real symmetric tridiagonal matrix. If eigenvectors are desired, it !> uses a divide and conquer algorithm. !> The divide and conquer algorithm makes very mild assumptions about @@ -22631,7 +22632,6 @@ module stdlib_linalg_lapack !> 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. - interface stevd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dstevd( jobz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) @@ -22667,7 +22667,8 @@ module stdlib_linalg_lapack - !> STEVR: computes selected eigenvalues and, optionally, eigenvectors + interface stevr + !> STEVR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Eigenvalues and !> eigenvectors can be selected by specifying either a range of values !> or a range of indices for the desired eigenvalues. @@ -22702,7 +22703,6 @@ module stdlib_linalg_lapack !> hence may abort due to a floating point exception in environments !> which do not handle NaNs and infinities in the ieee standard default !> manner. - interface stevr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dstevr( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & isuppz, work, lwork, iwork,liwork, info ) @@ -22740,12 +22740,12 @@ module stdlib_linalg_lapack - !> SYCON: estimates the reciprocal of the condition number (in the + interface sycon + !> SYCON estimates the reciprocal of the condition number (in the !> 1-norm) of a complex symmetric matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by CSYTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - interface sycon #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csycon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) import sp,dp,qp,ilp,lk @@ -22814,12 +22814,12 @@ module stdlib_linalg_lapack - !> SYCON_ROOK: estimates the reciprocal of the condition number (in the + interface sycon_rook + !> SYCON_ROOK estimates the reciprocal of the condition number (in the !> 1-norm) of a complex symmetric matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by CSYTRF_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))). - interface sycon_rook #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) @@ -22890,10 +22890,10 @@ module stdlib_linalg_lapack - !> SYCONV: convert A given by TRF into L and D and vice-versa. + interface syconv + !> SYCONV convert A given by TRF into L and D and vice-versa. !> Get Non-diag elements of D (returned in workspace) and !> apply or reverse permutation done in TRF. - interface syconv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyconv( uplo, way, n, a, lda, ipiv, e, info ) import sp,dp,qp,ilp,lk @@ -22956,8 +22956,9 @@ module stdlib_linalg_lapack + interface syconvf !> If parameter WAY = 'C': - !> SYCONVF: converts the factorization output format used in + !> SYCONVF converts the factorization output format used in !> CSYTRF provided on entry in parameter A into the factorization !> output format used in CSYTRF_RK (or CSYTRF_BK) that is stored !> on exit in parameters A and E. It also converts in place details of @@ -22973,7 +22974,6 @@ module stdlib_linalg_lapack !> (or CSYTRF_BK) into the format used in CSYTRF. !> SYCONVF can also convert in Hermitian matrix case, i.e. between !> formats used in CHETRF and CHETRF_RK (or CHETRF_BK). - interface syconvf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyconvf( uplo, way, n, a, lda, e, ipiv, info ) import sp,dp,qp,ilp,lk @@ -23036,8 +23036,9 @@ module stdlib_linalg_lapack + interface syconvf_rook !> If parameter WAY = 'C': - !> SYCONVF_ROOK: converts the factorization output format used in + !> SYCONVF_ROOK converts the factorization output format used in !> CSYTRF_ROOK provided on entry in parameter A into the factorization !> output format used in CSYTRF_RK (or CSYTRF_BK) that is stored !> on exit in parameters A and E. IPIV format for CSYTRF_ROOK and @@ -23051,7 +23052,6 @@ module stdlib_linalg_lapack !> CSYTRF_RK (or CSYTRF_BK) is the same and is not converted. !> SYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between !> formats used in CHETRF_ROOK and CHETRF_RK (or CHETRF_BK). - interface syconvf_rook #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) import sp,dp,qp,ilp,lk @@ -23110,14 +23110,14 @@ module stdlib_linalg_lapack - !> SYEQUB: computes row and column scalings intended to equilibrate a + interface syequb + !> SYEQUB computes row and column scalings intended to equilibrate a !> symmetric 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. - interface syequb #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyequb( uplo, n, a, lda, s, scond, amax, work, info ) import sp,dp,qp,ilp,lk @@ -23182,9 +23182,9 @@ module stdlib_linalg_lapack - !> SYEV: computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A. interface syev + !> SYEV computes all eigenvalues and, optionally, eigenvectors of a + !> real symmetric matrix A. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsyev( jobz, uplo, n, a, lda, w, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -23218,7 +23218,8 @@ module stdlib_linalg_lapack - !> SYEVD: computes all eigenvalues and, optionally, eigenvectors of a + interface syevd + !> SYEVD computes all eigenvalues and, optionally, eigenvectors of a !> real symmetric matrix A. If eigenvectors are desired, it uses a !> divide and conquer algorithm. !> The divide and conquer algorithm makes very mild assumptions about @@ -23229,7 +23230,6 @@ module stdlib_linalg_lapack !> without guard digits, but we know of none. !> Because of large use of BLAS of level 3, SYEVD needs N**2 more !> workspace than DSYEVX. - interface syevd #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsyevd( jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info ) @@ -23265,7 +23265,8 @@ module stdlib_linalg_lapack - !> SYEVR: computes selected eigenvalues and, optionally, eigenvectors + interface syevr + !> SYEVR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric matrix A. Eigenvalues and eigenvectors can be !> selected by specifying either a range of values or a range of !> indices for the desired eigenvalues. @@ -23315,7 +23316,6 @@ module stdlib_linalg_lapack !> hence may abort due to a floating point exception in environments !> which do not handle NaNs and infinities in the ieee standard default !> manner. - interface syevr #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsyevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, & ldz, isuppz, work, lwork,iwork, liwork, info ) @@ -23353,14 +23353,14 @@ module stdlib_linalg_lapack - !> SYGST: reduces a real symmetric-definite generalized eigenproblem + interface sygst + !> SYGST reduces a real symmetric-definite generalized eigenproblem !> to standard form. !> If ITYPE = 1, the problem is A*x = lambda*B*x, !> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) !> 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**T or L**T*A*L. !> B must have been previously factorized as U**T*U or L*L**T by DPOTRF. - interface sygst #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsygst( itype, uplo, n, a, lda, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -23394,12 +23394,12 @@ module stdlib_linalg_lapack - !> SYGV: computes all the eigenvalues, and optionally, the eigenvectors + interface sygv + !> SYGV computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-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 symmetric and B is also !> positive definite. - interface sygv #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsygv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, info ) @@ -23435,7 +23435,8 @@ module stdlib_linalg_lapack - !> SYGVD: computes all the eigenvalues, and optionally, the eigenvectors + interface sygvd + !> SYGVD computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-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 symmetric and B is also positive definite. @@ -23446,7 +23447,6 @@ module stdlib_linalg_lapack !> 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. - interface sygvd #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsygvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, iwork, & liwork, info ) @@ -23482,11 +23482,11 @@ module stdlib_linalg_lapack - !> SYMV: performs the matrix-vector operation + interface symv + !> SYMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix. - interface symv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csymv( uplo, n, alpha, a, lda, x, incx, beta, y, incy ) import sp,dp,qp,ilp,lk @@ -23518,11 +23518,11 @@ module stdlib_linalg_lapack - !> SYR: performs the symmetric rank 1 operation + interface syr + !> SYR performs the symmetric rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a complex scalar, x is an n element vector and A is an !> n by n symmetric matrix. - interface syr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyr( uplo, n, alpha, x, incx, a, lda ) import sp,dp,qp,ilp,lk @@ -23554,10 +23554,10 @@ module stdlib_linalg_lapack - !> SYRFS: improves the computed solution to a system of linear + interface syrfs + !> SYRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric indefinite, and !> provides error bounds and backward error estimates for the solution. - interface syrfs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr,& berr, work, rwork, info ) @@ -23630,7 +23630,8 @@ module stdlib_linalg_lapack - !> SYSV: computes the solution to a complex system of linear equations + interface sysv + !> SYSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS !> matrices. @@ -23641,7 +23642,6 @@ module stdlib_linalg_lapack !> triangular matrices, and D is symmetric 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. - interface sysv #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -23708,6 +23708,7 @@ module stdlib_linalg_lapack + interface sysv_aa !> CSYSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS @@ -23718,7 +23719,6 @@ module stdlib_linalg_lapack !> where U (or L) is a product of permutation and unit upper (lower) !> triangular matrices, and T is symmetric tridiagonal. The factored !> form of A is then used to solve the system of equations A * X = B. - interface sysv_aa #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -23785,7 +23785,8 @@ module stdlib_linalg_lapack - !> SYSV_RK: computes the solution to a complex system of linear + interface sysv_rk + !> SYSV_RK computes the solution to a complex system of linear !> equations A * X = B, where A is an N-by-N symmetric matrix !> and X and B are N-by-NRHS matrices. !> The bounded Bunch-Kaufman (rook) diagonal pivoting method is used @@ -23799,7 +23800,6 @@ module stdlib_linalg_lapack !> CSYTRF_RK is called to compute the factorization of a complex !> symmetric matrix. The factored form of A is then used to solve !> the system of equations A * X = B by calling BLAS3 routine CSYTRS_3. - interface sysv_rk #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info & ) @@ -23866,7 +23866,8 @@ module stdlib_linalg_lapack - !> SYSV_ROOK: computes the solution to a complex system of linear + interface sysv_rook + !> SYSV_ROOK computes the solution to a complex system of linear !> equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS @@ -23882,7 +23883,6 @@ module stdlib_linalg_lapack !> pivoting method. !> The factored form of A is then used to solve the system !> of equations A * X = B by calling CSYTRS_ROOK. - interface sysv_rook #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -23949,9 +23949,9 @@ module stdlib_linalg_lapack - !> SYSWAPR: applies an elementary permutation on the rows and the columns of - !> a symmetric matrix. interface syswapr + !> SYSWAPR applies an elementary permutation on the rows and the columns of + !> a symmetric matrix. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyswapr( uplo, n, a, lda, i1, i2) import sp,dp,qp,ilp,lk @@ -24006,7 +24006,8 @@ module stdlib_linalg_lapack - !> SYTF2_RK: computes the factorization of a complex symmetric matrix A + interface sytf2_rk + !> SYTF2_RK computes the factorization of a complex symmetric matrix A !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), !> where U (or L) is unit upper (or lower) triangular matrix, @@ -24015,7 +24016,6 @@ module stdlib_linalg_lapack !> 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. - interface sytf2_rk #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytf2_rk( uplo, n, a, lda, e, ipiv, info ) import sp,dp,qp,ilp,lk @@ -24078,14 +24078,14 @@ module stdlib_linalg_lapack - !> SYTF2_ROOK: computes the factorization of a complex symmetric matrix A + interface sytf2_rook + !> SYTF2_ROOK computes the factorization of a complex symmetric matrix A !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: !> 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, U**T is the transpose of U, and D is symmetric 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. - interface sytf2_rook #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytf2_rook( uplo, n, a, lda, ipiv, info ) import sp,dp,qp,ilp,lk @@ -24144,10 +24144,10 @@ module stdlib_linalg_lapack - !> SYTRD: reduces a real symmetric matrix A to real symmetric + interface sytrd + !> SYTRD reduces a real symmetric matrix A to real symmetric !> tridiagonal form T by an orthogonal similarity transformation: !> Q**T * A * Q = T. - interface sytrd #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsytrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -24181,10 +24181,10 @@ module stdlib_linalg_lapack - !> SYTRD_SB2ST: reduces a real symmetric band matrix A to real symmetric + interface sytrd_sb2st + !> SYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric !> tridiagonal form T by a orthogonal similarity transformation: !> Q**T * A * Q = T. - interface sytrd_sb2st #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, & lhous, work, lwork, info ) @@ -24220,10 +24220,10 @@ module stdlib_linalg_lapack - !> SYTRD_SY2SB: reduces a real symmetric matrix A to real symmetric + interface sytrd_sy2sb + !> SYTRD_SY2SB reduces a real symmetric matrix A to real symmetric !> band-diagonal form AB by a orthogonal similarity transformation: !> Q**T * A * Q = AB. - interface sytrd_sy2sb #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info & ) @@ -24259,7 +24259,8 @@ module stdlib_linalg_lapack - !> SYTRF: computes the factorization of a complex symmetric matrix A + interface sytrf + !> SYTRF computes the factorization of a complex symmetric matrix A !> using the Bunch-Kaufman diagonal pivoting method. The form of the !> factorization is !> A = U*D*U**T or A = L*D*L**T @@ -24267,7 +24268,6 @@ module stdlib_linalg_lapack !> triangular matrices, and D is symmetric 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. - interface sytrf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrf( uplo, n, a, lda, ipiv, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -24330,13 +24330,13 @@ module stdlib_linalg_lapack - !> SYTRF_AA: computes the factorization of a complex symmetric matrix A + interface sytrf_aa + !> SYTRF_AA computes the factorization of a complex symmetric matrix A !> using the Aasen's algorithm. The form of the factorization is !> A = U**T*T*U or A = L*T*L**T !> where U (or L) is a product of permutation and unit upper (lower) !> triangular matrices, and T is a complex symmetric tridiagonal matrix. !> This is the blocked version of the algorithm, calling Level 3 BLAS. - interface sytrf_aa #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) import sp,dp,qp,ilp,lk @@ -24399,7 +24399,8 @@ module stdlib_linalg_lapack - !> SYTRF_RK: computes the factorization of a complex symmetric matrix A + interface sytrf_rk + !> SYTRF_RK computes the factorization of a complex symmetric matrix A !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), !> where U (or L) is unit upper (or lower) triangular matrix, @@ -24408,7 +24409,6 @@ module stdlib_linalg_lapack !> 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. - interface sytrf_rk #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -24471,7 +24471,8 @@ module stdlib_linalg_lapack - !> SYTRF_ROOK: computes the factorization of a complex symmetric matrix A + interface sytrf_rook + !> SYTRF_ROOK computes the factorization of a complex symmetric 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 @@ -24479,7 +24480,6 @@ module stdlib_linalg_lapack !> triangular matrices, and D is symmetric 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. - interface sytrf_rook #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -24542,10 +24542,10 @@ module stdlib_linalg_lapack - !> SYTRI: computes the inverse of a complex symmetric indefinite matrix + interface sytri + !> SYTRI computes the inverse of a complex symmetric indefinite matrix !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by !> CSYTRF. - interface sytri #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytri( uplo, n, a, lda, ipiv, work, info ) import sp,dp,qp,ilp,lk @@ -24608,10 +24608,10 @@ module stdlib_linalg_lapack - !> SYTRI_ROOK: computes the inverse of a complex symmetric + interface sytri_rook + !> SYTRI_ROOK computes the inverse of a complex symmetric !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T !> computed by CSYTRF_ROOK. - interface sytri_rook #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytri_rook( uplo, n, a, lda, ipiv, work, info ) import sp,dp,qp,ilp,lk @@ -24674,10 +24674,10 @@ module stdlib_linalg_lapack - !> SYTRS: solves a system of linear equations A*X = B with a complex + interface sytrs + !> SYTRS solves a system of linear equations A*X = B with a complex !> symmetric matrix A using the factorization A = U*D*U**T or !> A = L*D*L**T computed by CSYTRF. - interface sytrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -24740,10 +24740,10 @@ module stdlib_linalg_lapack - !> SYTRS2: solves a system of linear equations A*X = B with a complex + interface sytrs2 + !> SYTRS2 solves a system of linear equations A*X = B with a complex !> symmetric matrix A using the factorization A = U*D*U**T or !> A = L*D*L**T computed by CSYTRF and converted by CSYCONV. - interface sytrs2 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) import sp,dp,qp,ilp,lk @@ -24806,7 +24806,8 @@ module stdlib_linalg_lapack - !> SYTRS_3: solves a system of linear equations A * X = B with a complex + interface sytrs_3 + !> SYTRS_3 solves a system of linear equations A * X = B with a complex !> symmetric matrix A using the factorization computed !> by CSYTRF_RK or CSYTRF_BK: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), @@ -24815,7 +24816,6 @@ module stdlib_linalg_lapack !> matrix, P**T is the transpose of P, and D is symmetric and block !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. !> This algorithm is using Level 3 BLAS. - interface sytrs_3 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) import sp,dp,qp,ilp,lk @@ -24878,10 +24878,10 @@ module stdlib_linalg_lapack - !> SYTRS_AA: solves a system of linear equations A*X = B with a complex + interface sytrs_aa + !> SYTRS_AA solves a system of linear equations A*X = B with a complex !> symmetric matrix A using the factorization A = U**T*T*U or !> A = L*T*L**T computed by CSYTRF_AA. - interface sytrs_aa #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) @@ -24952,10 +24952,10 @@ module stdlib_linalg_lapack - !> SYTRS_ROOK: solves a system of linear equations A*X = B with + interface sytrs_rook + !> SYTRS_ROOK solves a system of linear equations A*X = B with !> a complex symmetric matrix A using the factorization A = U*D*U**T or !> A = L*D*L**T computed by CSYTRF_ROOK. - interface sytrs_rook #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) import sp,dp,qp,ilp,lk @@ -25018,13 +25018,13 @@ module stdlib_linalg_lapack - !> TBCON: estimates the reciprocal of the condition number of a + interface tbcon + !> TBCON estimates the reciprocal of the condition number of a !> triangular band matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - interface tbcon #ifdef STDLIB_EXTERNAL_LAPACK subroutine ctbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,rwork, info ) @@ -25093,13 +25093,13 @@ module stdlib_linalg_lapack - !> TBRFS: provides error bounds and backward error estimates for the + interface tbrfs + !> TBRFS provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular band !> coefficient matrix. !> The solution matrix X must be computed by CTBTRS or some other !> means before entering this routine. TBRFS does not do iterative !> refinement because doing so cannot improve the backward error. - interface tbrfs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, & ferr, berr, work, rwork, info ) @@ -25168,11 +25168,11 @@ module stdlib_linalg_lapack - !> TBTRS: solves a triangular system of the form + interface tbtrs + !> TBTRS solves a triangular system of the form !> A * X = B, A**T * X = B, or A**H * X = B, !> where A is a triangular band matrix of order N, and B is an !> N-by-NRHS matrix. A check is made to verify that A is nonsingular. - interface tbtrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) @@ -25239,15 +25239,15 @@ module stdlib_linalg_lapack + interface tfsm !> Level 3 BLAS like routine for A in RFP Format. - !> TFSM: solves the matrix equation + !> TFSM solves the matrix equation !> op( A )*X = alpha*B or X*op( A ) = alpha*B !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**H. !> A is in Rectangular Full Packed (RFP) Format. !> The matrix X is overwritten on B. - interface tfsm #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) @@ -25310,10 +25310,10 @@ module stdlib_linalg_lapack - !> TFTRI: computes the inverse of a triangular matrix A stored in RFP + interface tftri + !> TFTRI computes the inverse of a triangular matrix A stored in RFP !> format. !> This is a Level 3 BLAS version of the algorithm. - interface tftri #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctftri( transr, uplo, diag, n, a, info ) import sp,dp,qp,ilp,lk @@ -25372,9 +25372,9 @@ module stdlib_linalg_lapack - !> TFTTP: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard packed format (TP). interface tfttp + !> TFTTP copies a triangular matrix A from rectangular full packed + !> format (TF) to standard packed format (TP). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctfttp( transr, uplo, n, arf, ap, info ) import sp,dp,qp,ilp,lk @@ -25437,9 +25437,9 @@ module stdlib_linalg_lapack - !> TFTTR: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard full format (TR). interface tfttr + !> TFTTR copies a triangular matrix A from rectangular full packed + !> format (TF) to standard full format (TR). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctfttr( transr, uplo, n, arf, a, lda, info ) import sp,dp,qp,ilp,lk @@ -25502,7 +25502,8 @@ module stdlib_linalg_lapack - !> TGEVC: computes some or all of the right and/or left eigenvectors of + interface tgevc + !> TGEVC computes some or all of the right and/or left eigenvectors of !> a pair of complex matrices (S,P), where S and P are upper triangular. !> Matrix pairs of this type are produced by the generalized Schur !> factorization of a complex matrix pair (A,B): @@ -25520,7 +25521,6 @@ module stdlib_linalg_lapack !> If Q and Z are the unitary factors from the generalized Schur !> factorization of a matrix pair (A,B), then Z*X and Q*Y !> are the matrices of right and left eigenvectors of (A,B). - interface tgevc #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr,& mm, m, work, rwork, info ) @@ -25597,7 +25597,8 @@ module stdlib_linalg_lapack - !> TGEXC: reorders the generalized Schur decomposition of a complex + interface tgexc + !> TGEXC reorders the generalized Schur decomposition of a complex !> matrix pair (A,B), using an unitary equivalence transformation !> (A, B) := Q * (A, B) * Z**H, so that the diagonal block of (A, B) with !> row index IFST is moved to row ILST. @@ -25607,7 +25608,6 @@ module stdlib_linalg_lapack !> updated. !> Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H !> Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H - interface tgexc #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst,& info ) @@ -25676,7 +25676,8 @@ module stdlib_linalg_lapack - !> TGSEN: reorders the generalized Schur decomposition of a complex + interface tgsen + !> TGSEN reorders the generalized Schur decomposition of a complex !> matrix pair (A, B) (in terms of an unitary equivalence trans- !> formation Q**H * (A, B) * Z), so that a selected cluster of eigenvalues !> appears in the leading diagonal blocks of the pair (A,B). The leading @@ -25694,7 +25695,6 @@ module stdlib_linalg_lapack !> the selected cluster and the eigenvalues outside the cluster, resp., !> and norms of "projections" onto left and right eigenspaces w.r.t. !> the selected cluster in the (1,1)-block. - interface tgsen #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alpha, beta, & q, ldq, z, ldz, m, pl, pr, dif,work, lwork, iwork, liwork, info ) @@ -25767,7 +25767,8 @@ module stdlib_linalg_lapack - !> TGSJA: computes the generalized singular value decomposition (GSVD) + interface tgsja + !> TGSJA computes the generalized singular value decomposition (GSVD) !> of two complex upper triangular (or trapezoidal) matrices A and B. !> On entry, it is assumed that matrices A and B have the following !> forms, which may be obtained by the preprocessing subroutine CGGSVP @@ -25829,7 +25830,6 @@ module stdlib_linalg_lapack !> The computation of the unitary transformation matrices U, V or Q !> is optional. These matrices may either be formed explicitly, or they !> may be postmultiplied into input matrices U1, V1, or Q1. - interface tgsja #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb,& alpha, beta, u, ldu, v, ldv,q, ldq, work, ncycle, info ) @@ -25906,11 +25906,11 @@ module stdlib_linalg_lapack - !> TGSNA: estimates reciprocal condition numbers for specified + interface tgsna + !> TGSNA estimates reciprocal condition numbers for specified !> eigenvalues and/or eigenvectors of a matrix pair (A, B). !> (A, B) must be in generalized Schur canonical form, that is, A and !> B are both upper triangular. - interface tgsna #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, & s, dif, mm, m, work, lwork,iwork, info ) @@ -25983,7 +25983,8 @@ module stdlib_linalg_lapack - !> TGSYL: solves the generalized Sylvester equation: + interface tgsyl + !> TGSYL solves the generalized Sylvester equation: !> A * R - L * B = scale * C (1) !> D * R - L * E = scale * F !> where R and L are unknown m-by-n matrices, (A, D), (B, E) and @@ -26010,7 +26011,6 @@ module stdlib_linalg_lapack !> Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the !> reciprocal of the smallest singular value of Z. !> This is a level-3 BLAS algorithm. - interface tgsyl #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, & f, ldf, scale, dif, work, lwork,iwork, info ) @@ -26083,13 +26083,13 @@ module stdlib_linalg_lapack - !> TPCON: estimates the reciprocal of the condition number of a packed + interface tpcon + !> TPCON estimates the reciprocal of the condition number of a packed !> triangular matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - interface tpcon #ifdef STDLIB_EXTERNAL_LAPACK subroutine ctpcon( norm, uplo, diag, n, ap, rcond, work, rwork,info ) import sp,dp,qp,ilp,lk @@ -26154,11 +26154,11 @@ module stdlib_linalg_lapack - !> TPLQT: computes a blocked LQ factorization of a complex + interface tplqt + !> TPLQT computes a blocked LQ factorization of a complex !> "triangular-pentagonal" matrix C, which is composed of a !> triangular block A and pentagonal block B, using the compact !> WY representation for Q. - interface tplqt #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) import sp,dp,qp,ilp,lk @@ -26217,10 +26217,10 @@ module stdlib_linalg_lapack - !> TPLQT2: computes a LQ a factorization of a complex "triangular-pentagonal" + interface tplqt2 + !> TPLQT2 computes a LQ a factorization of a complex "triangular-pentagonal" !> matrix C, which is composed of a triangular block A and pentagonal block B, !> using the compact WY representation for Q. - interface tplqt2 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) import sp,dp,qp,ilp,lk @@ -26279,10 +26279,10 @@ module stdlib_linalg_lapack - !> TPMLQT: applies a complex unitary matrix Q obtained from a + interface tpmlqt + !> TPMLQT applies a complex unitary matrix Q obtained from a !> "triangular-pentagonal" complex block reflector H to a general !> complex matrix C, which consists of two blocks A and B. - interface tpmlqt #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, & ldb, work, info ) @@ -26353,10 +26353,10 @@ module stdlib_linalg_lapack - !> TPMQRT: applies a complex orthogonal matrix Q obtained from a + interface tpmqrt + !> TPMQRT applies a complex orthogonal matrix Q obtained from a !> "triangular-pentagonal" complex block reflector H to a general !> complex matrix C, which consists of two blocks A and B. - interface tpmqrt #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, & ldb, work, info ) @@ -26427,11 +26427,11 @@ module stdlib_linalg_lapack - !> TPQRT: computes a blocked QR factorization of a complex + interface tpqrt + !> TPQRT computes a blocked QR factorization of a complex !> "triangular-pentagonal" matrix C, which is composed of a !> triangular block A and pentagonal block B, using the compact !> WY representation for Q. - interface tpqrt #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) import sp,dp,qp,ilp,lk @@ -26490,10 +26490,10 @@ module stdlib_linalg_lapack - !> TPQRT2: computes a QR factorization of a complex "triangular-pentagonal" + interface tpqrt2 + !> TPQRT2 computes a QR factorization of a complex "triangular-pentagonal" !> matrix C, which is composed of a triangular block A and pentagonal block B, !> using the compact WY representation for Q. - interface tpqrt2 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) import sp,dp,qp,ilp,lk @@ -26552,10 +26552,10 @@ module stdlib_linalg_lapack - !> TPRFB: applies a complex "triangular-pentagonal" block reflector H or its + interface tprfb + !> TPRFB applies a complex "triangular-pentagonal" block reflector H or its !> conjugate transpose H**H to a complex matrix C, which is composed of two !> blocks A and B, either from the left or right. - interface tprfb #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & lda, b, ldb, work, ldwork ) @@ -26622,13 +26622,13 @@ module stdlib_linalg_lapack - !> TPRFS: provides error bounds and backward error estimates for the + interface tprfs + !> TPRFS provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular packed !> coefficient matrix. !> The solution matrix X must be computed by CTPTRS or some other !> means before entering this routine. TPRFS does not do iterative !> refinement because doing so cannot improve the backward error. - interface tprfs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & work, rwork, info ) @@ -26697,9 +26697,9 @@ module stdlib_linalg_lapack - !> TPTRI: computes the inverse of a complex upper or lower triangular - !> matrix A stored in packed format. interface tptri + !> TPTRI computes the inverse of a complex upper or lower triangular + !> matrix A stored in packed format. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctptri( uplo, diag, n, ap, info ) import sp,dp,qp,ilp,lk @@ -26758,12 +26758,12 @@ module stdlib_linalg_lapack - !> TPTRS: solves a triangular system of the form + interface tptrs + !> TPTRS solves a triangular system of the form !> A * X = B, A**T * X = B, or A**H * X = B, !> where A is a triangular matrix of order N stored in packed format, !> and B is an N-by-NRHS matrix. A check is made to verify that A is !> nonsingular. - interface tptrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -26826,9 +26826,9 @@ module stdlib_linalg_lapack - !> TPTTF: copies a triangular matrix A from standard packed format (TP) - !> to rectangular full packed format (TF). interface tpttf + !> TPTTF copies a triangular matrix A from standard packed format (TP) + !> to rectangular full packed format (TF). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctpttf( transr, uplo, n, ap, arf, info ) import sp,dp,qp,ilp,lk @@ -26891,9 +26891,9 @@ module stdlib_linalg_lapack - !> TPTTR: copies a triangular matrix A from standard packed format (TP) - !> to standard full format (TR). interface tpttr + !> TPTTR copies a triangular matrix A from standard packed format (TP) + !> to standard full format (TR). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctpttr( uplo, n, ap, a, lda, info ) import sp,dp,qp,ilp,lk @@ -26956,13 +26956,13 @@ module stdlib_linalg_lapack - !> TRCON: estimates the reciprocal of the condition number of a + interface trcon + !> TRCON estimates the reciprocal of the condition number of a !> triangular matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - interface trcon #ifdef STDLIB_EXTERNAL_LAPACK subroutine ctrcon( norm, uplo, diag, n, a, lda, rcond, work,rwork, info ) import sp,dp,qp,ilp,lk @@ -27027,7 +27027,8 @@ module stdlib_linalg_lapack - !> TREVC: computes some or all of the right and/or left eigenvectors of + interface trevc + !> TREVC computes some or all of the right and/or left eigenvectors of !> a complex upper triangular matrix T. !> Matrices of this type are produced by the Schur factorization of !> a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. @@ -27042,7 +27043,6 @@ module stdlib_linalg_lapack !> input matrix. If Q is the unitary factor that reduces a matrix A to !> Schur form T, then Q*X and Q*Y are the matrices of right and left !> eigenvectors of A. - interface trevc #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & work, rwork, info ) @@ -27117,7 +27117,8 @@ module stdlib_linalg_lapack - !> TREVC3: computes some or all of the right and/or left eigenvectors of + interface trevc3 + !> TREVC3 computes some or all of the right and/or left eigenvectors of !> a complex upper triangular matrix T. !> Matrices of this type are produced by the Schur factorization of !> a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. @@ -27133,7 +27134,6 @@ module stdlib_linalg_lapack !> Schur form T, then Q*X and Q*Y are the matrices of right and left !> eigenvectors of A. !> This uses a Level 3 BLAS version of the back transformation. - interface trevc3 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrevc3( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m,& work, lwork, rwork, lrwork, info) @@ -27208,13 +27208,13 @@ module stdlib_linalg_lapack - !> TREXC: reorders the Schur factorization of a complex matrix + interface trexc + !> TREXC reorders the Schur factorization of a complex matrix !> A = Q*T*Q**H, so that the diagonal element of T with row index IFST !> is moved to row ILST. !> The Schur form T is reordered by a unitary similarity transformation !> Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by !> postmultplying it with Z. - interface trexc #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrexc( compq, n, t, ldt, q, ldq, ifst, ilst, info ) import sp,dp,qp,ilp,lk @@ -27277,13 +27277,13 @@ module stdlib_linalg_lapack - !> TRRFS: provides error bounds and backward error estimates for the + interface trrfs + !> TRRFS provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular !> coefficient matrix. !> The solution matrix X must be computed by CTRTRS or some other !> means before entering this routine. TRRFS does not do iterative !> refinement because doing so cannot improve the backward error. - interface trrfs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, & berr, work, rwork, info ) @@ -27352,14 +27352,14 @@ module stdlib_linalg_lapack - !> TRSEN: reorders the Schur factorization of a complex matrix + interface trsen + !> TRSEN reorders the Schur factorization of a complex matrix !> A = Q*T*Q**H, so that a selected cluster of eigenvalues appears in !> the leading positions on the diagonal of the upper triangular matrix !> T, and the leading columns of Q form an orthonormal basis of the !> corresponding right invariant subspace. !> Optionally the routine computes the reciprocal condition numbers of !> the cluster of eigenvalues and/or the invariant subspace. - interface trsen #ifdef STDLIB_EXTERNAL_LAPACK subroutine ctrsen( job, compq, select, n, t, ldt, q, ldq, w, m, s,sep, work, lwork,& info ) @@ -27432,10 +27432,10 @@ module stdlib_linalg_lapack - !> TRSNA: estimates reciprocal condition numbers for specified + interface trsna + !> TRSNA estimates reciprocal condition numbers for specified !> eigenvalues and/or right eigenvectors of a complex upper triangular !> matrix T (or of any matrix Q*T*Q**H with Q unitary). - interface trsna #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, & mm, m, work, ldwork, rwork,info ) @@ -27508,14 +27508,14 @@ module stdlib_linalg_lapack - !> TRSYL: solves the complex Sylvester matrix equation: + interface trsyl + !> TRSYL solves the complex Sylvester matrix equation: !> op(A)*X + X*op(B) = scale*C or !> op(A)*X - X*op(B) = scale*C, !> where op(A) = A or A**H, and A and B are both upper triangular. A is !> M-by-M and B is N-by-N; the right hand side C and the solution X are !> M-by-N; and scale is an output scale factor, set <= 1 to avoid !> overflow in X. - interface trsyl #ifdef STDLIB_EXTERNAL_LAPACK subroutine ctrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) @@ -27586,10 +27586,10 @@ module stdlib_linalg_lapack - !> TRTRI: computes the inverse of a complex upper or lower triangular + interface trtri + !> TRTRI computes the inverse of a complex upper or lower triangular !> matrix A. !> This is the Level 3 BLAS version of the algorithm. - interface trtri #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrtri( uplo, diag, n, a, lda, info ) import sp,dp,qp,ilp,lk @@ -27648,11 +27648,11 @@ module stdlib_linalg_lapack - !> TRTRS: solves a triangular system of the form + interface trtrs + !> TRTRS solves a triangular system of the form !> A * X = B, A**T * X = B, or A**H * X = B, !> where A is a triangular matrix of order N, and B is an N-by-NRHS !> matrix. A check is made to verify that A is nonsingular. - interface trtrs #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) import sp,dp,qp,ilp,lk @@ -27715,9 +27715,9 @@ module stdlib_linalg_lapack - !> TRTTF: copies a triangular matrix A from standard full format (TR) - !> to rectangular full packed format (TF) . interface trttf + !> TRTTF copies a triangular matrix A from standard full format (TR) + !> to rectangular full packed format (TF) . #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrttf( transr, uplo, n, a, lda, arf, info ) import sp,dp,qp,ilp,lk @@ -27780,9 +27780,9 @@ module stdlib_linalg_lapack - !> TRTTP: copies a triangular matrix A from full format (TR) to standard - !> packed format (TP). interface trttp + !> TRTTP copies a triangular matrix A from full format (TR) to standard + !> packed format (TP). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrttp( uplo, n, a, lda, ap, info ) import sp,dp,qp,ilp,lk @@ -27845,13 +27845,13 @@ module stdlib_linalg_lapack - !> TZRZF: reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A + interface tzrzf + !> TZRZF reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A !> to upper triangular form by means of unitary transformations. !> The upper trapezoidal matrix A is factored as !> A = ( R 0 ) * Z, !> where Z is an N-by-N unitary matrix and R is an M-by-M upper !> triangular matrix. - interface tzrzf #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctzrzf( m, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -27910,7 +27910,8 @@ module stdlib_linalg_lapack - !> UNBDB: simultaneously bidiagonalizes the blocks of an M-by-M + interface unbdb + !> UNBDB simultaneously bidiagonalizes the blocks of an M-by-M !> partitioned unitary matrix X: !> [ B11 | B12 0 0 ] !> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**H @@ -27926,7 +27927,6 @@ module stdlib_linalg_lapack !> represented implicitly by Householder vectors. !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented !> implicitly by angles THETA, PHI. - interface unbdb #ifdef STDLIB_EXTERNAL_LAPACK subroutine cunbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) @@ -27968,7 +27968,8 @@ module stdlib_linalg_lapack - !> UNBDB1: simultaneously bidiagonalizes the blocks of a tall and skinny + interface unbdb1 + !> UNBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -27983,7 +27984,6 @@ module stdlib_linalg_lapack !> Householder vectors. !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by !> angles THETA, PHI. - interface unbdb1 #ifdef STDLIB_EXTERNAL_LAPACK subroutine cunbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -28019,7 +28019,8 @@ module stdlib_linalg_lapack - !> UNBDB2: simultaneously bidiagonalizes the blocks of a tall and skinny + interface unbdb2 + !> UNBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -28034,7 +28035,6 @@ module stdlib_linalg_lapack !> Householder vectors. !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by !> angles THETA, PHI. - interface unbdb2 #ifdef STDLIB_EXTERNAL_LAPACK subroutine cunbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -28070,7 +28070,8 @@ module stdlib_linalg_lapack - !> UNBDB3: simultaneously bidiagonalizes the blocks of a tall and skinny + interface unbdb3 + !> UNBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -28085,7 +28086,6 @@ module stdlib_linalg_lapack !> Householder vectors. !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - interface unbdb3 #ifdef STDLIB_EXTERNAL_LAPACK subroutine cunbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -28121,7 +28121,8 @@ module stdlib_linalg_lapack - !> UNBDB4: simultaneously bidiagonalizes the blocks of a tall and skinny + interface unbdb4 + !> UNBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -28136,7 +28137,6 @@ module stdlib_linalg_lapack !> Householder vectors. !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - interface unbdb4 #ifdef STDLIB_EXTERNAL_LAPACK subroutine cunbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, phantom, work, lwork,info ) @@ -28174,7 +28174,8 @@ module stdlib_linalg_lapack - !> UNBDB5: orthogonalizes the column vector + interface unbdb5 + !> UNBDB5 orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] !> with respect to the columns of @@ -28185,7 +28186,6 @@ module stdlib_linalg_lapack !> criterion, then some other vector from the orthogonal complement !> is returned. This vector is chosen in an arbitrary but deterministic !> way. - interface unbdb5 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) @@ -28221,7 +28221,8 @@ module stdlib_linalg_lapack - !> UNBDB6: orthogonalizes the column vector + interface unbdb6 + !> UNBDB6 orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] !> with respect to the columns of @@ -28230,7 +28231,6 @@ module stdlib_linalg_lapack !> The columns of Q must be orthonormal. !> If the projection is zero according to Kahan's "twice is enough" !> criterion, then the zero vector is returned. - interface unbdb6 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) @@ -28266,7 +28266,8 @@ module stdlib_linalg_lapack - !> UNCSD: computes the CS decomposition of an M-by-M partitioned + interface uncsd + !> UNCSD computes the CS decomposition of an M-by-M partitioned !> unitary matrix X: !> [ I 0 0 | 0 0 0 ] !> [ 0 C 0 | 0 -S 0 ] @@ -28279,7 +28280,6 @@ module stdlib_linalg_lapack !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in !> which R = MIN(P,M-P,Q,M-Q). - interface uncsd #ifdef STDLIB_EXTERNAL_LAPACK recursive subroutine cuncsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, & x11, ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, & @@ -28325,7 +28325,8 @@ module stdlib_linalg_lapack - !> UNCSD2BY1: computes the CS decomposition of an M-by-Q matrix X with + interface uncsd2by1 + !> UNCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with !> orthonormal columns that has been partitioned into a 2-by-1 block !> structure: !> [ I1 0 0 ] @@ -28340,7 +28341,6 @@ module stdlib_linalg_lapack !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). - interface uncsd2by1 #ifdef STDLIB_EXTERNAL_LAPACK subroutine cuncsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta,& u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, rwork, lrwork, iwork,info ) @@ -28380,12 +28380,12 @@ module stdlib_linalg_lapack - !> UNG2L: generates an m by n complex matrix Q with orthonormal columns, + interface ung2l + !> UNG2L generates an m by n complex matrix Q with orthonormal columns, !> which is defined as the last n columns of a product of k elementary !> reflectors of order m !> Q = H(k) . . . H(2) H(1) !> as returned by CGEQLF. - interface ung2l #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cung2l( m, n, k, a, lda, tau, work, info ) import sp,dp,qp,ilp,lk @@ -28419,12 +28419,12 @@ module stdlib_linalg_lapack - !> UNG2R: generates an m by n complex matrix Q with orthonormal columns, + interface ung2r + !> UNG2R generates an m by n complex matrix Q with orthonormal columns, !> which is defined as the first n columns of a product of k elementary !> reflectors of order m !> Q = H(1) H(2) . . . H(k) !> as returned by CGEQRF. - interface ung2r #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cung2r( m, n, k, a, lda, tau, work, info ) import sp,dp,qp,ilp,lk @@ -28458,7 +28458,8 @@ module stdlib_linalg_lapack - !> UNGBR: generates one of the complex unitary matrices Q or P**H + interface ungbr + !> UNGBR generates one of the complex unitary matrices Q or P**H !> determined by CGEBRD when reducing a complex matrix A to bidiagonal !> form: A = Q * B * P**H. Q and P**H are defined as products of !> elementary reflectors H(i) or G(i) respectively. @@ -28474,7 +28475,6 @@ module stdlib_linalg_lapack !> rows of P**H, where n >= m >= k; !> if k >= n, P**H = G(n-1) . . . G(2) G(1) and UNGBR returns P**H as !> an N-by-N matrix. - interface ungbr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cungbr( vect, m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -28510,11 +28510,11 @@ module stdlib_linalg_lapack - !> UNGHR: generates a complex unitary matrix Q which is defined as the + interface unghr + !> UNGHR generates a complex unitary matrix Q which is defined as the !> product of IHI-ILO elementary reflectors of order N, as returned by !> CGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - interface unghr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -28548,12 +28548,12 @@ module stdlib_linalg_lapack - !> UNGLQ: generates an M-by-N complex matrix Q with orthonormal rows, + interface unglq + !> UNGLQ generates an M-by-N complex matrix Q with orthonormal rows, !> which is defined as the first M rows of a product of K elementary !> reflectors of order N !> Q = H(k)**H . . . H(2)**H H(1)**H !> as returned by CGELQF. - interface unglq #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunglq( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -28587,12 +28587,12 @@ module stdlib_linalg_lapack - !> UNGQL: generates an M-by-N complex matrix Q with orthonormal columns, + interface ungql + !> UNGQL generates an M-by-N complex matrix Q with orthonormal columns, !> which is defined as the last N columns of a product of K elementary !> reflectors of order M !> Q = H(k) . . . H(2) H(1) !> as returned by CGEQLF. - interface ungql #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cungql( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -28626,12 +28626,12 @@ module stdlib_linalg_lapack - !> UNGQR: generates an M-by-N complex matrix Q with orthonormal columns, + interface ungqr + !> UNGQR generates an M-by-N complex matrix Q with orthonormal columns, !> which is defined as the first N columns of a product of K elementary !> reflectors of order M !> Q = H(1) H(2) . . . H(k) !> as returned by CGEQRF. - interface ungqr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cungqr( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -28665,12 +28665,12 @@ module stdlib_linalg_lapack - !> UNGRQ: generates an M-by-N complex matrix Q with orthonormal rows, + interface ungrq + !> UNGRQ generates an M-by-N complex matrix Q with orthonormal rows, !> which is defined as the last M rows of a product of K elementary !> reflectors of order N !> Q = H(1)**H H(2)**H . . . H(k)**H !> as returned by CGERQF. - interface ungrq #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cungrq( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -28704,12 +28704,12 @@ module stdlib_linalg_lapack - !> UNGTR: generates a complex unitary matrix Q which is defined as the + interface ungtr + !> UNGTR generates a complex unitary matrix Q which is defined as the !> product of n-1 elementary reflectors of order N, as returned by !> CHETRD: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - interface ungtr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cungtr( uplo, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -28745,12 +28745,12 @@ module stdlib_linalg_lapack - !> UNGTSQR: generates an M-by-N complex matrix Q_out with orthonormal + interface ungtsqr + !> UNGTSQR generates an M-by-N complex matrix Q_out with orthonormal !> columns, which are the first N columns of a product of comlpex unitary !> matrices of order M which are returned by CLATSQR !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). !> See the documentation for CLATSQR. - interface ungtsqr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cungtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -28784,7 +28784,8 @@ module stdlib_linalg_lapack - !> UNGTSQR_ROW: generates an M-by-N complex matrix Q_out with + interface ungtsqr_row + !> UNGTSQR_ROW generates an M-by-N complex matrix Q_out with !> orthonormal columns from the output of CLATSQR. These N orthonormal !> columns are the first N columns of a product of complex unitary !> matrices Q(k)_in of order M, which are returned by CLATSQR in @@ -28799,7 +28800,6 @@ module stdlib_linalg_lapack !> starting in the bottom row block and continues to the top row block !> (hence _ROW in the routine name). This sweep is in reverse order of !> the order in which CLATSQR generates the output blocks. - interface ungtsqr_row #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cungtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) @@ -28835,7 +28835,8 @@ module stdlib_linalg_lapack - !> UNHR_COL: takes an M-by-N complex matrix Q_in with orthonormal columns + interface unhr_col + !> UNHR_COL takes an M-by-N complex matrix Q_in with orthonormal columns !> as input, stored in A, and performs Householder Reconstruction (HR), !> i.e. reconstructs Householder vectors V(i) implicitly representing !> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, @@ -28844,7 +28845,6 @@ module stdlib_linalg_lapack !> stored in A on output, and the diagonal entries of S are stored in D. !> Block reflectors are also returned in T !> (same output format as CGEQRT). - interface unhr_col #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunhr_col( m, n, nb, a, lda, t, ldt, d, info ) import sp,dp,qp,ilp,lk @@ -28876,7 +28876,8 @@ module stdlib_linalg_lapack - !> UNM2L: overwrites the general complex m-by-n matrix C with + interface unm2l + !> UNM2L overwrites the general complex m-by-n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -28886,7 +28887,6 @@ module stdlib_linalg_lapack !> Q = H(k) . . . H(2) H(1) !> as returned by CGEQLF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - interface unm2l #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) @@ -28924,7 +28924,8 @@ module stdlib_linalg_lapack - !> UNM2R: overwrites the general complex m-by-n matrix C with + interface unm2r + !> UNM2R overwrites the general complex m-by-n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -28934,7 +28935,6 @@ module stdlib_linalg_lapack !> Q = H(1) H(2) . . . H(k) !> as returned by CGEQRF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - interface unm2r #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) @@ -28972,6 +28972,7 @@ module stdlib_linalg_lapack + interface unmbr !> If VECT = 'Q', UNMBR: overwrites the general complex M-by-N matrix C !> with !> SIDE = 'L' SIDE = 'R' @@ -28994,7 +28995,6 @@ module stdlib_linalg_lapack !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: !> if k < nq, P = G(1) G(2) . . . G(k); !> if k >= nq, P = G(1) G(2) . . . G(nq-1). - interface unmbr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, & lwork, info ) @@ -29032,7 +29032,8 @@ module stdlib_linalg_lapack - !> UNMHR: overwrites the general complex M-by-N matrix C with + interface unmhr + !> UNMHR 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 @@ -29040,7 +29041,6 @@ module stdlib_linalg_lapack !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of !> IHI-ILO elementary reflectors, as returned by CGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - interface unmhr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, & lwork, info ) @@ -29078,7 +29078,8 @@ module stdlib_linalg_lapack - !> UNMLQ: overwrites the general complex M-by-N matrix C with + interface unmlq + !> UNMLQ 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 @@ -29087,7 +29088,6 @@ module stdlib_linalg_lapack !> Q = H(k)**H . . . H(2)**H H(1)**H !> as returned by CGELQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - interface unmlq #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29125,7 +29125,8 @@ module stdlib_linalg_lapack - !> UNMQL: overwrites the general complex M-by-N matrix C with + interface unmql + !> UNMQL 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 @@ -29134,7 +29135,6 @@ module stdlib_linalg_lapack !> Q = H(k) . . . H(2) H(1) !> as returned by CGEQLF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - interface unmql #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29172,7 +29172,8 @@ module stdlib_linalg_lapack - !> UNMQR: overwrites the general complex M-by-N matrix C with + interface unmqr + !> UNMQR 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 @@ -29181,7 +29182,6 @@ module stdlib_linalg_lapack !> Q = H(1) H(2) . . . H(k) !> as returned by CGEQRF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - interface unmqr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29219,7 +29219,8 @@ module stdlib_linalg_lapack - !> UNMRQ: overwrites the general complex M-by-N matrix C with + interface unmrq + !> UNMRQ 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 @@ -29228,7 +29229,6 @@ module stdlib_linalg_lapack !> Q = H(1)**H H(2)**H . . . H(k)**H !> as returned by CGERQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - interface unmrq #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29266,7 +29266,8 @@ module stdlib_linalg_lapack - !> UNMRZ: overwrites the general complex M-by-N matrix C with + interface unmrz + !> UNMRZ 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 @@ -29275,7 +29276,6 @@ module stdlib_linalg_lapack !> Q = H(1) H(2) . . . H(k) !> as returned by CTZRZF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - interface unmrz #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29313,7 +29313,8 @@ module stdlib_linalg_lapack - !> UNMTR: overwrites the general complex M-by-N matrix C with + interface unmtr + !> UNMTR 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 @@ -29322,7 +29323,6 @@ module stdlib_linalg_lapack !> nq-1 elementary reflectors, as returned by CHETRD: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - interface unmtr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29360,12 +29360,12 @@ module stdlib_linalg_lapack - !> UPGTR: generates a complex unitary matrix Q which is defined as the + interface upgtr + !> UPGTR generates a complex unitary matrix Q which is defined as the !> product of n-1 elementary reflectors H(i) of order n, as returned by !> CHPTRD using packed storage: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - interface upgtr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cupgtr( uplo, n, ap, tau, q, ldq, work, info ) import sp,dp,qp,ilp,lk @@ -29399,7 +29399,8 @@ module stdlib_linalg_lapack - !> UPMTR: overwrites the general complex M-by-N matrix C with + interface upmtr + !> UPMTR 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 @@ -29409,7 +29410,6 @@ module stdlib_linalg_lapack !> storage: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - interface upmtr #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cupmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) diff --git a/src/stdlib_linalg_lapack_aux.fypp b/src/stdlib_linalg_lapack_aux.fypp index f01fb9df8..059dbb878 100644 --- a/src/stdlib_linalg_lapack_aux.fypp +++ b/src/stdlib_linalg_lapack_aux.fypp @@ -143,14 +143,14 @@ module stdlib_linalg_lapack_aux contains + + pure character function stdlib_chla_transtype( trans ) !> This subroutine translates from a BLAST-specified integer constant to !> the character string specifying a transposition operation. - !> CHLA_TRANSTYPE: returns an CHARACTER*1. If CHLA_TRANSTYPE: is 'X', + !> CHLA_TRANSTYPE returns an CHARACTER*1. If CHLA_TRANSTYPE: is 'X', !> then input is not an integer indicating a transposition operator. !> Otherwise CHLA_TRANSTYPE returns the constant value corresponding to !> TRANS. - - pure character function stdlib_chla_transtype( trans ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -175,7 +175,9 @@ module stdlib_linalg_lapack_aux return end function stdlib_chla_transtype - !> DROUNDUP_LWORK: deals with a subtle bug with returning LWORK as a Float. + + pure real(dp) function stdlib_droundup_lwork( lwork ) + !> DROUNDUP_LWORK deals with a subtle bug with returning LWORK as a Float. !> This routine guarantees it is rounded up instead of down by !> multiplying LWORK by 1+eps when it is necessary, where eps is the relative machine precision. !> E.g., @@ -185,8 +187,6 @@ module stdlib_linalg_lapack_aux !> !> DROUNDUP_LWORK >= LWORK. !> DROUNDUP_LWORK is guaranteed to have zero decimal part. - - pure real(dp) function stdlib_droundup_lwork( lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -205,11 +205,11 @@ module stdlib_linalg_lapack_aux return end function stdlib_droundup_lwork - !> ICMAX1: finds the index of the first vector element of maximum absolute value. - !> Based on ICAMAX from Level 1 BLAS. - !> The change is to use the 'genuine' absolute value. pure integer(ilp) function stdlib_icmax1( n, cx, incx ) + !> ICMAX1 finds the index of the first vector element of maximum absolute value. + !> Based on ICAMAX from Level 1 BLAS. + !> The change is to use the 'genuine' absolute value. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -253,10 +253,10 @@ module stdlib_linalg_lapack_aux return end function stdlib_icmax1 - !> IEEECK: is called from the ILAENV to verify that Infinity and - !> possibly NaN arithmetic is safe (i.e. will not trap). pure integer(ilp) function stdlib_ieeeck( ispec, zero, one ) + !> IEEECK is called from the ILAENV to verify that Infinity and + !> possibly NaN arithmetic is safe (i.e. will not trap). ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -343,9 +343,9 @@ module stdlib_linalg_lapack_aux return end function stdlib_ieeeck - !> ILACLC: scans A for its last non-zero column. pure integer(ilp) function stdlib_ilaclc( m, n, a, lda ) + !> ILACLC scans A for its last non-zero column. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -376,9 +376,9 @@ module stdlib_linalg_lapack_aux return end function stdlib_ilaclc - !> ILACLR: scans A for its last non-zero row. pure integer(ilp) function stdlib_ilaclr( m, n, a, lda ) + !> ILACLR scans A for its last non-zero row. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -412,14 +412,14 @@ module stdlib_linalg_lapack_aux return end function stdlib_ilaclr + + integer(ilp) function stdlib_iladiag( diag ) !> This subroutine translated from a character string specifying if a !> matrix has unit diagonal or not to the relevant BLAST-specified !> integer constant. - !> ILADIAG: returns an INTEGER. If ILADIAG: < 0, then the input is not a + !> ILADIAG returns an INTEGER. If ILADIAG: < 0, then the input is not a !> character indicating a unit or non-unit diagonal. Otherwise ILADIAG !> returns the constant value corresponding to DIAG. - - integer(ilp) function stdlib_iladiag( diag ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -441,9 +441,9 @@ module stdlib_linalg_lapack_aux return end function stdlib_iladiag - !> ILADLC: scans A for its last non-zero column. pure integer(ilp) function stdlib_iladlc( m, n, a, lda ) + !> ILADLC scans A for its last non-zero column. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -474,9 +474,9 @@ module stdlib_linalg_lapack_aux return end function stdlib_iladlc - !> ILADLR: scans A for its last non-zero row. pure integer(ilp) function stdlib_iladlr( m, n, a, lda ) + !> ILADLR scans A for its last non-zero row. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -510,14 +510,14 @@ module stdlib_linalg_lapack_aux return end function stdlib_iladlr + + integer(ilp) function stdlib_ilaprec( prec ) !> This subroutine translated from a character string specifying an !> intermediate precision to the relevant BLAST-specified integer !> constant. - !> ILAPREC: returns an INTEGER. If ILAPREC: < 0, then the input is not a + !> ILAPREC returns an INTEGER. If ILAPREC: < 0, then the input is not a !> character indicating a supported intermediate precision. Otherwise !> ILAPREC returns the constant value corresponding to PREC. - - integer(ilp) function stdlib_ilaprec( prec ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -545,9 +545,9 @@ module stdlib_linalg_lapack_aux return end function stdlib_ilaprec - !> ILASLC: scans A for its last non-zero column. pure integer(ilp) function stdlib_ilaslc( m, n, a, lda ) + !> ILASLC scans A for its last non-zero column. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -578,9 +578,9 @@ module stdlib_linalg_lapack_aux return end function stdlib_ilaslc - !> ILASLR: scans A for its last non-zero row. pure integer(ilp) function stdlib_ilaslr( m, n, a, lda ) + !> ILASLR scans A for its last non-zero row. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -614,14 +614,14 @@ module stdlib_linalg_lapack_aux return end function stdlib_ilaslr + + integer(ilp) function stdlib_ilatrans( trans ) !> This subroutine translates from a character string specifying a !> transposition operation to the relevant BLAST-specified integer !> constant. - !> ILATRANS: returns an INTEGER. If ILATRANS: < 0, then the input is not + !> ILATRANS returns an INTEGER. If ILATRANS: < 0, then the input is not !> a character indicating a transposition operator. Otherwise ILATRANS !> returns the constant value corresponding to TRANS. - - integer(ilp) function stdlib_ilatrans( trans ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -646,14 +646,14 @@ module stdlib_linalg_lapack_aux return end function stdlib_ilatrans + + integer(ilp) function stdlib_ilauplo( uplo ) !> This subroutine translated from a character string specifying a !> upper- or lower-triangular matrix to the relevant BLAST-specified !> integer constant. - !> ILAUPLO: returns an INTEGER. If ILAUPLO: < 0, then the input is not + !> ILAUPLO returns an INTEGER. If ILAUPLO: < 0, then the input is not !> a character indicating an upper- or lower-triangular matrix. !> Otherwise ILAUPLO returns the constant value corresponding to UPLO. - - integer(ilp) function stdlib_ilauplo( uplo ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -675,9 +675,9 @@ module stdlib_linalg_lapack_aux return end function stdlib_ilauplo - !> ILAZLC: scans A for its last non-zero column. pure integer(ilp) function stdlib_ilazlc( m, n, a, lda ) + !> ILAZLC scans A for its last non-zero column. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -708,9 +708,9 @@ module stdlib_linalg_lapack_aux return end function stdlib_ilazlc - !> ILAZLR: scans A for its last non-zero row. pure integer(ilp) function stdlib_ilazlr( m, n, a, lda ) + !> ILAZLR scans A for its last non-zero row. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -744,12 +744,12 @@ module stdlib_linalg_lapack_aux return end function stdlib_ilazlr + + pure integer(ilp) function stdlib_iparmq( ispec, name, opts, n, ilo, ihi, lwork ) !> This program sets problem and machine dependent parameters !> useful for xHSEQR and related subroutines for eigenvalue !> problems. It is called whenever - !> IPARMQ: is called with 12 <= ISPEC <= 16 - - pure integer(ilp) function stdlib_iparmq( ispec, name, opts, n, ilo, ihi, lwork ) + !> IPARMQ is called with 12 <= ISPEC <= 16 ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -876,11 +876,11 @@ module stdlib_linalg_lapack_aux end if end function stdlib_iparmq - !> IZMAX1: finds the index of the first vector element of maximum absolute value. - !> Based on IZAMAX from Level 1 BLAS. - !> The change is to use the 'genuine' absolute value. pure integer(ilp) function stdlib_izmax1( n, zx, incx ) + !> IZMAX1 finds the index of the first vector element of maximum absolute value. + !> Based on IZAMAX from Level 1 BLAS. + !> The change is to use the 'genuine' absolute value. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -924,13 +924,13 @@ module stdlib_linalg_lapack_aux return end function stdlib_izmax1 - !> LSAMEN: tests if the first N letters of CA are the same as the + + pure logical(lk) function stdlib_lsamen( n, ca, cb ) + !> LSAMEN tests if the first N letters of CA are the same as the !> first N letters of CB, regardless of case. !> LSAMEN returns .TRUE. if CA and CB are equivalent except for case !> and .FALSE. otherwise. LSAMEN also returns .FALSE. if LEN( CA ) !> or LEN( CB ) is less than N. - - pure logical(lk) function stdlib_lsamen( n, ca, cb ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -955,7 +955,9 @@ module stdlib_linalg_lapack_aux return end function stdlib_lsamen - !> SROUNDUP_LWORK: deals with a subtle bug with returning LWORK as a Float. + + pure real(sp) function stdlib_sroundup_lwork( lwork ) + !> SROUNDUP_LWORK deals with a subtle bug with returning LWORK as a Float. !> This routine guarantees it is rounded up instead of down by !> multiplying LWORK by 1+eps when it is necessary, where eps is the relative machine precision. !> E.g., @@ -965,8 +967,6 @@ module stdlib_linalg_lapack_aux !> !> SROUNDUP_LWORK >= LWORK. !> SROUNDUP_LWORK is guaranteed to have zero decimal part. - - pure real(sp) function stdlib_sroundup_lwork( lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -987,6 +987,8 @@ module stdlib_linalg_lapack_aux #:if WITH_QP + + pure real(qp) function stdlib_qroundup_lwork( lwork ) !> DROUNDUP_LWORK: deals with a subtle bug with returning LWORK as a Float. !> This routine guarantees it is rounded up instead of down by !> multiplying LWORK by 1+eps when it is necessary, where eps is the relative machine precision. @@ -997,8 +999,6 @@ module stdlib_linalg_lapack_aux !> !> DROUNDUP_LWORK >= LWORK. !> DROUNDUP_LWORK is guaranteed to have zero decimal part. - - pure real(qp) function stdlib_qroundup_lwork( lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1020,14 +1020,14 @@ module stdlib_linalg_lapack_aux #:if WITH_QP + + integer(ilp) function stdlib_ilaqiag( diag ) !> This subroutine translated from a character string specifying if a !> matrix has unit diagonal or not to the relevant BLAST-specified !> integer constant. !> ILADIAG: returns an INTEGER. If ILADIAG: < 0, then the input is not a !> character indicating a unit or non-unit diagonal. Otherwise ILADIAG !> returns the constant value corresponding to DIAG. - - integer(ilp) function stdlib_ilaqiag( diag ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1052,9 +1052,9 @@ module stdlib_linalg_lapack_aux #:if WITH_QP - !> ILADLC: scans A for its last non-zero column. pure integer(ilp) function stdlib_ilaqlc( m, n, a, lda ) + !> ILADLC: scans A for its last non-zero column. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1088,9 +1088,9 @@ module stdlib_linalg_lapack_aux #:if WITH_QP - !> ILADLR: scans A for its last non-zero row. pure integer(ilp) function stdlib_ilaqlr( m, n, a, lda ) + !> ILADLR: scans A for its last non-zero row. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1127,9 +1127,9 @@ module stdlib_linalg_lapack_aux #:if WITH_QP - !> ILAZLC: scans A for its last non-zero column. pure integer(ilp) function stdlib_ilawlc( m, n, a, lda ) + !> ILAZLC: scans A for its last non-zero column. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1163,9 +1163,9 @@ module stdlib_linalg_lapack_aux #:if WITH_QP - !> ILAZLR: scans A for its last non-zero row. pure integer(ilp) function stdlib_ilawlr( m, n, a, lda ) + !> ILAZLR: scans A for its last non-zero row. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1202,11 +1202,11 @@ module stdlib_linalg_lapack_aux #:if WITH_QP + + pure integer(ilp) function stdlib_iwmax1( n, zx, incx ) !> IZMAX1: finds the index of the first vector element of maximum absolute value. !> Based on IZAMAX from Level 1 BLAS. !> The change is to use the 'genuine' absolute value. - - pure integer(ilp) function stdlib_iwmax1( n, zx, incx ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1251,7 +1251,9 @@ module stdlib_linalg_lapack_aux end function stdlib_iwmax1 #:endif - !> ILAENV: is called from the LAPACK routines to choose problem-dependent + + pure integer(ilp) function stdlib_ilaenv( ispec, name, opts, n1, n2, n3, n4 ) + !> ILAENV is called from the LAPACK routines to choose problem-dependent !> parameters for the local environment. See ISPEC for a description of !> the parameters. !> ILAENV returns an INTEGER @@ -1264,8 +1266,6 @@ module stdlib_linalg_lapack_aux !> and problem size information in the arguments. !> This routine will not function correctly if it is converted to all !> lower case. Converting it to all upper case is allowed. - - pure integer(ilp) function stdlib_ilaenv( ispec, name, opts, n1, n2, n3, n4 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1731,6 +1731,8 @@ module stdlib_linalg_lapack_aux return end function stdlib_ilaenv + + pure integer(ilp) function stdlib_iparam2stage( ispec, name, opts,ni, nbi, ibi, nxi ) !> This program sets problem and machine dependent parameters !> useful for xHETRD_2STAGE, xHETRD_HE2HB, xHETRD_HB2ST, !> xGEBRD_2STAGE, xGEBRD_GE2GB, xGEBRD_GB2BD @@ -1738,8 +1740,6 @@ module stdlib_linalg_lapack_aux !> It is called whenever ILAENV is called with 17 <= ISPEC <= 21. !> It is called whenever ILAENV2STAGE is called with 1 <= ISPEC <= 5 !> with a direct conversion ISPEC + 16. - - pure integer(ilp) function stdlib_iparam2stage( ispec, name, opts,ni, nbi, ibi, nxi ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1915,7 +1915,9 @@ module stdlib_linalg_lapack_aux endif end function stdlib_iparam2stage - !> ILAENV2STAGE: is called from the LAPACK routines to choose problem-dependent + + pure integer(ilp) function stdlib_ilaenv2stage( ispec, name, opts, n1, n2, n3, n4 ) + !> ILAENV2STAGE is called from the LAPACK routines to choose problem-dependent !> parameters for the local environment. See ISPEC for a description of !> the parameters. !> It sets problem and machine dependent parameters useful for *_2STAGE and @@ -1932,8 +1934,6 @@ module stdlib_linalg_lapack_aux !> the option and problem size information in the arguments. !> This routine will not function correctly if it is converted to all !> lower case. Converting it to all upper case is allowed. - - pure integer(ilp) function stdlib_ilaenv2stage( ispec, name, opts, n1, n2, n3, n4 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_lapack_c.fypp b/src/stdlib_linalg_lapack_c.fypp index 39aaa2f84..58f1d549e 100644 --- a/src/stdlib_linalg_lapack_c.fypp +++ b/src/stdlib_linalg_lapack_c.fypp @@ -497,7 +497,9 @@ module stdlib_linalg_lapack_c contains - !> CGBEQU: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_cgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) + !> CGBEQU 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 @@ -506,8 +508,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_cgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -632,7 +632,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgbequ - !> CGBEQUB: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_cgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) + !> CGBEQUB 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 @@ -647,8 +649,6 @@ module stdlib_linalg_lapack_c !> 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). - - pure subroutine stdlib_cgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -782,11 +782,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgbequb - !> CGBTF2: computes an LU factorization of a complex m-by-n band matrix - !> A using partial pivoting with row interchanges. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. pure subroutine stdlib_cgbtf2( m, n, kl, ku, ab, ldab, ipiv, info ) + !> CGBTF2 computes an LU factorization of a complex m-by-n band matrix + !> A using partial pivoting with row interchanges. + !> This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -868,11 +868,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgbtf2 - !> CGEBAK: 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. pure subroutine stdlib_cgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) + !> CGEBAK 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -965,7 +965,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgebak - !> CGEBAL: balances a general complex matrix A. This involves, first, + + pure subroutine stdlib_cgebal( job, n, a, lda, ilo, ihi, scale, info ) + !> CGEBAL 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 @@ -973,8 +975,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_cgebal( job, n, a, lda, ilo, ihi, scale, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1135,7 +1135,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgebal - !> CGEEQU: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_cgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) + !> CGEEQU 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 @@ -1144,8 +1146,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_cgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1263,7 +1263,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeequ - !> CGEEQUB: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_cgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) + !> CGEEQUB 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 @@ -1278,8 +1280,6 @@ module stdlib_linalg_lapack_c !> 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). - - pure subroutine stdlib_cgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1407,13 +1407,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeequb - !> CGETC2: computes an LU factorization, using complete pivoting, of the + + pure subroutine stdlib_cgetc2( n, a, lda, ipiv, jpiv, info ) + !> CGETC2 computes an LU factorization, using complete pivoting, of the !> n-by-n matrix A. The factorization has the form A = P * L * U * Q, !> where P and Q are permutation matrices, L is lower triangular with !> unit diagonal elements and U is upper triangular. !> This is a level 1 BLAS version of the algorithm. - - pure subroutine stdlib_cgetc2( n, a, lda, ipiv, jpiv, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1491,7 +1491,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgetc2 - !> CGETF2: computes an LU factorization of a general m-by-n matrix A + + pure subroutine stdlib_cgetf2( m, n, a, lda, ipiv, info ) + !> CGETF2 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 @@ -1499,8 +1501,6 @@ module stdlib_linalg_lapack_c !> diagonal elements (lower trapezoidal if m > n), and U is upper !> triangular (upper trapezoidal if m < n). !> This is the right-looking Level 2 BLAS version of the algorithm. - - pure subroutine stdlib_cgetf2( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1564,12 +1564,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgetf2 - !> CGGBAK: forms the right or left eigenvectors of a complex generalized + + pure subroutine stdlib_cggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) + !> CGGBAK 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. - - pure subroutine stdlib_cggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1677,7 +1677,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cggbak - !> CGGBAL: balances a pair of general complex matrices (A,B). This + + pure subroutine stdlib_cggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) + !> CGGBAL 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 @@ -1686,8 +1688,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_cggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1981,14 +1981,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cggbal - !> CGTSV: solves the equation + + pure subroutine stdlib_cgtsv( n, nrhs, dl, d, du, b, ldb, info ) + !> CGTSV 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. - - pure subroutine stdlib_cgtsv( n, nrhs, dl, d, du, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2073,15 +2073,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgtsv - !> CGTTRF: computes an LU factorization of a complex tridiagonal matrix A + + pure subroutine stdlib_cgttrf( n, dl, d, du, du2, ipiv, info ) + !> CGTTRF 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. - - pure subroutine stdlib_cgttrf( n, dl, d, du, du2, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2169,12 +2169,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgttrf - !> CGTTS2: solves one of the systems of equations + + pure subroutine stdlib_cgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) + !> CGTTS2 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. - - pure subroutine stdlib_cgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2340,10 +2340,10 @@ module stdlib_linalg_lapack_c end if end subroutine stdlib_cgtts2 - !> CHESWAPR: applies an elementary permutation on the rows and the columns of - !> a hermitian matrix. pure subroutine stdlib_cheswapr( uplo, n, a, lda, i1, i2) + !> CHESWAPR applies an elementary permutation on the rows and the columns of + !> a hermitian matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2412,15 +2412,15 @@ module stdlib_linalg_lapack_c endif end subroutine stdlib_cheswapr - !> CHETF2: computes the factorization of a complex Hermitian matrix A + + pure subroutine stdlib_chetf2( uplo, n, a, lda, ipiv, info ) + !> CHETF2 computes the factorization of a complex Hermitian 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, 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. - - pure subroutine stdlib_chetf2( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2730,7 +2730,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetf2 - !> CHETF2_RK: computes the factorization of a complex Hermitian matrix A + + pure subroutine stdlib_chetf2_rk( uplo, n, a, lda, e, ipiv, info ) + !> CHETF2_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, @@ -2739,8 +2741,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_chetf2_rk( uplo, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3261,15 +3261,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetf2_rk - !> CHETF2_ROOK: computes the factorization of a complex Hermitian matrix A + + pure subroutine stdlib_chetf2_rook( uplo, n, a, lda, ipiv, info ) + !> CHETF2_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. - - pure subroutine stdlib_chetf2_rook( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3750,11 +3750,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetf2_rook - !> CHETRI: 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. pure subroutine stdlib_chetri( uplo, n, a, lda, ipiv, work, info ) + !> CHETRI 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3954,11 +3954,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetri - !> CHETRI_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. pure subroutine stdlib_chetri_rook( uplo, n, a, lda, ipiv, work, info ) + !> CHETRI_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4222,7 +4222,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetri_rook - !> CHETRS_3: solves a system of linear equations A * X = B with a complex + + pure subroutine stdlib_chetrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) + !> CHETRS_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), @@ -4231,8 +4233,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_chetrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4382,16 +4382,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrs_3 + + pure subroutine stdlib_chfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) !> Level 3 BLAS like routine for C in RFP Format. - !> CHFRK: performs one of the Hermitian rank--k operations + !> CHFRK 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. - - pure subroutine stdlib_chfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4642,15 +4642,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chfrk - !> CHPGST: reduces a complex Hermitian-definite generalized + + pure subroutine stdlib_chpgst( itype, uplo, n, ap, bp, info ) + !> CHPGST 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. - - pure subroutine stdlib_chpgst( itype, uplo, n, ap, bp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4771,14 +4771,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpgst - !> CHPTRF: computes the factorization of a complex Hermitian packed + + pure subroutine stdlib_chptrf( uplo, n, ap, ipiv, info ) + !> CHPTRF 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. - - pure subroutine stdlib_chptrf( uplo, n, ap, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5121,11 +5121,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chptrf - !> CHPTRI: 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. pure subroutine stdlib_chptri( uplo, n, ap, ipiv, work, info ) + !> CHPTRI 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5340,7 +5340,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chptri - !> CLA_GBAMV: performs one of the matrix-vector operations + + subroutine stdlib_cla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) + !> CLA_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 @@ -5353,8 +5355,6 @@ module stdlib_linalg_lapack_c !> "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. - - subroutine stdlib_cla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5535,14 +5535,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cla_gbamv - !> CLA_GBRPVGRW: computes the reciprocal pivot growth factor + + pure real(sp) function stdlib_cla_gbrpvgrw( n, kl, ku, ncols, ab, ldab, afb,ldafb ) + !> CLA_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. - - pure real(sp) function stdlib_cla_gbrpvgrw( n, kl, ku, ncols, ab, ldab, afb,ldafb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5580,7 +5580,9 @@ module stdlib_linalg_lapack_c stdlib_cla_gbrpvgrw = rpvgrw end function stdlib_cla_gbrpvgrw - !> CLA_GEAMV: performs one of the matrix-vector operations + + subroutine stdlib_cla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) + !> CLA_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 @@ -5593,8 +5595,6 @@ module stdlib_linalg_lapack_c !> "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. - - subroutine stdlib_cla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5769,14 +5769,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cla_geamv - !> CLA_GERPVGRW: computes the reciprocal pivot growth factor + + pure real(sp) function stdlib_cla_gerpvgrw( n, ncols, a, lda, af, ldaf ) + !> CLA_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. - - pure real(sp) function stdlib_cla_gerpvgrw( n, ncols, a, lda, af, ldaf ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5813,6 +5813,8 @@ module stdlib_linalg_lapack_c stdlib_cla_gerpvgrw = rpvgrw end function stdlib_cla_gerpvgrw + + subroutine stdlib_cla_heamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) !> 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 @@ -5825,8 +5827,6 @@ module stdlib_linalg_lapack_c !> "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. - - subroutine stdlib_cla_heamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6007,13 +6007,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cla_heamv - !> CLA_LIN_BERR: computes componentwise relative backward error from + + pure subroutine stdlib_cla_lin_berr( n, nz, nrhs, res, ayb, berr ) + !> CLA_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. - - pure subroutine stdlib_cla_lin_berr( n, nz, nrhs, res, ayb, berr ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6053,14 +6053,14 @@ module stdlib_linalg_lapack_c end do end subroutine stdlib_cla_lin_berr - !> CLA_PORPVGRW: computes the reciprocal pivot growth factor + + real(sp) function stdlib_cla_porpvgrw( uplo, ncols, a, lda, af, ldaf, work ) + !> CLA_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. - - real(sp) function stdlib_cla_porpvgrw( uplo, ncols, a, lda, af, ldaf, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6146,7 +6146,9 @@ module stdlib_linalg_lapack_c stdlib_cla_porpvgrw = rpvgrw end function stdlib_cla_porpvgrw - !> CLA_SYAMV: performs the matrix-vector operation + + subroutine stdlib_cla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) + !> 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. @@ -6158,8 +6160,6 @@ module stdlib_linalg_lapack_c !> "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. - - subroutine stdlib_cla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6341,11 +6341,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cla_syamv - !> CLA_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. pure subroutine stdlib_cla_wwaddw( n, x, y, w ) + !> CLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6368,9 +6368,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cla_wwaddw - !> CLACGV: conjugates a complex vector of length N. pure subroutine stdlib_clacgv( n, x, incx ) + !> CLACGV conjugates a complex vector of length N. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6399,10 +6399,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clacgv - !> CLACN2: estimates the 1-norm of a square, complex matrix A. - !> Reverse communication is used for evaluating matrix-vector products. pure subroutine stdlib_clacn2( n, v, x, est, kase, isave ) + !> CLACN2 estimates the 1-norm of a square, complex matrix A. + !> Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6526,10 +6526,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clacn2 - !> CLACON: estimates the 1-norm of a square, complex matrix A. - !> Reverse communication is used for evaluating matrix-vector products. subroutine stdlib_clacon( n, v, x, est, kase ) + !> CLACON estimates the 1-norm of a square, complex matrix A. + !> Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6653,10 +6653,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clacon - !> CLACP2: copies all or part of a real two-dimensional matrix A to a - !> complex matrix B. pure subroutine stdlib_clacp2( uplo, m, n, a, lda, b, ldb ) + !> CLACP2 copies all or part of a real two-dimensional matrix A to a + !> complex matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6694,10 +6694,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clacp2 - !> CLACPY: copies all or part of a two-dimensional matrix A to another - !> matrix B. pure subroutine stdlib_clacpy( uplo, m, n, a, lda, b, ldb ) + !> CLACPY copies all or part of a two-dimensional matrix A to another + !> matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6735,12 +6735,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clacpy - !> CLACRM: performs a very simple matrix-matrix multiplication: + + pure subroutine stdlib_clacrm( m, n, a, lda, b, ldb, c, ldc, rwork ) + !> CLACRM 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. - - pure subroutine stdlib_clacrm( m, n, a, lda, b, ldb, c, ldc, rwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6789,12 +6789,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clacrm - !> CLACRT: performs the operation + + pure subroutine stdlib_clacrt( n, cx, incx, cy, incy, c, s ) + !> CLACRT 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. - - pure subroutine stdlib_clacrt( n, cx, incx, cy, incy, c, s ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6833,11 +6833,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clacrt - !> CLADIV: := X / Y, where X and Y are complex. The computation of X / Y - !> will not overflow on an intermediary step unless the results - !> overflows. pure complex(sp) function stdlib_cladiv( x, y ) + !> CLADIV := X / Y, where X and Y are complex. The computation of X / Y + !> will not overflow on an intermediary step unless the results + !> overflows. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6855,14 +6855,14 @@ module stdlib_linalg_lapack_c return end function stdlib_cladiv - !> CLAED8: merges the two sets of eigenvalues together into a single + + pure subroutine stdlib_claed8( k, n, qsiz, q, ldq, d, rho, cutpnt, z, dlamda,q2, ldq2, w, & + !> CLAED8 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. - - pure subroutine stdlib_claed8( k, n, qsiz, q, ldq, d, rho, cutpnt, z, dlamda,q2, ldq2, w, & indxp, indx, indxq, perm, givptr,givcol, givnum, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7058,7 +7058,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claed8 - !> CLAESY: computes the eigendecomposition of a 2-by-2 symmetric matrix + + pure subroutine stdlib_claesy( a, b, c, rt1, rt2, evscal, cs1, sn1 ) + !> CLAESY 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. @@ -7067,8 +7069,6 @@ module stdlib_linalg_lapack_c !> 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 ] - - pure subroutine stdlib_claesy( a, b, c, rt1, rt2, evscal, cs1, sn1 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7148,7 +7148,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claesy - !> CLAEV2: computes the eigendecomposition of a 2-by-2 Hermitian matrix + + pure subroutine stdlib_claev2( a, b, c, rt1, rt2, cs1, sn1 ) + !> CLAEV2 computes the eigendecomposition of a 2-by-2 Hermitian matrix !> [ A B ] !> [ CONJG(B) C ]. !> On return, RT1 is the eigenvalue of larger absolute value, RT2 is the @@ -7156,8 +7158,6 @@ module stdlib_linalg_lapack_c !> eigenvector for RT1, giving the decomposition !> [ CS1 CONJG(SN1) ] [ A B ] [ CS1 -CONJG(SN1) ] = [ RT1 0 ] !> [-SN1 CS1 ] [ CONJG(B) C ] [ SN1 CS1 ] [ 0 RT2 ]. - - pure subroutine stdlib_claev2( a, b, c, rt1, rt2, cs1, sn1 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7185,13 +7185,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claev2 - !> CLAG2Z: converts a COMPLEX matrix, SA, to a COMPLEX*16 matrix, A. + + pure subroutine stdlib_clag2z( m, n, sa, ldsa, a, lda, info ) + !> CLAG2Z converts a COMPLEX matrix, SA, to a COMPLEX*16 matrix, A. !> Note that while it is possible to overflow while converting !> from double to single, it is not possible to overflow when !> converting from single to double. !> This is an auxiliary routine so there is no argument checking. - - pure subroutine stdlib_clag2z( m, n, sa, ldsa, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7214,13 +7214,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clag2z - !> CLAGTM: performs a matrix-vector product of the form + + pure subroutine stdlib_clagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) + !> CLAGTM 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. - - pure subroutine stdlib_clagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7350,7 +7350,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clagtm - !> CLAHEF: computes a partial factorization of a complex Hermitian + + pure subroutine stdlib_clahef( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) + !> CLAHEF 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: @@ -7363,8 +7365,6 @@ module stdlib_linalg_lapack_c !> CLAHEF 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'). - - pure subroutine stdlib_clahef( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7889,7 +7889,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clahef - !> CLAHEF_RK: computes a partial factorization of a complex Hermitian + + pure subroutine stdlib_clahef_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) + !> CLAHEF_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: @@ -7901,8 +7903,6 @@ module stdlib_linalg_lapack_c !> CLAHEF_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'). - - pure subroutine stdlib_clahef_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8528,7 +8528,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clahef_rk - !> CLAHEF_ROOK: computes a partial factorization of a complex Hermitian + + pure subroutine stdlib_clahef_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) + !> CLAHEF_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: @@ -8541,8 +8543,6 @@ module stdlib_linalg_lapack_c !> CLAHEF_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'). - - pure subroutine stdlib_clahef_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9200,7 +9200,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clahef_rook - !> CLAIC1: applies one step of incremental condition estimation in + + pure subroutine stdlib_claic1( job, j, x, sest, w, gamma, sestpr, s, c ) + !> CLAIC1 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 @@ -9220,8 +9222,6 @@ module stdlib_linalg_lapack_c !> diag(sest*sest, 0) + [alpha gamma] * [ conjg(alpha) ] !> [ conjg(gamma) ] !> where alpha = x**H*w. - - pure subroutine stdlib_claic1( job, j, x, sest, w, gamma, sestpr, s, c ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9416,14 +9416,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claic1 - !> CLAPMR: rearranges the rows of the M by N matrix X as specified + + pure subroutine stdlib_clapmr( forwrd, m, n, x, ldx, k ) + !> CLAPMR 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. - - pure subroutine stdlib_clapmr( forwrd, m, n, x, ldx, k ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9484,14 +9484,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clapmr - !> CLAPMT: rearranges the columns of the M by N matrix X as specified + + pure subroutine stdlib_clapmt( forwrd, m, n, x, ldx, k ) + !> CLAPMT 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. - - pure subroutine stdlib_clapmt( forwrd, m, n, x, ldx, k ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9552,11 +9552,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clapmt - !> CLAQGB: 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. pure subroutine stdlib_claqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) + !> CLAQGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -9622,10 +9622,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claqgb - !> CLAQGE: equilibrates a general M by N matrix A using the row and - !> column scaling factors in the vectors R and C. pure subroutine stdlib_claqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed ) + !> CLAQGE equilibrates a general M by N matrix A using the row and + !> column scaling factors in the vectors R and C. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9688,10 +9688,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claqge - !> CLAQHB: equilibrates an Hermitian band matrix A using the scaling - !> factors in the vector S. pure subroutine stdlib_claqhb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) + !> CLAQHB equilibrates an Hermitian band matrix A using the scaling + !> factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9750,10 +9750,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claqhb - !> CLAQHE: equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_claqhe( uplo, n, a, lda, s, scond, amax, equed ) + !> CLAQHE equilibrates a Hermitian matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9812,10 +9812,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claqhe - !> CLAQHP: equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_claqhp( uplo, n, ap, s, scond, amax, equed ) + !> CLAQHP equilibrates a Hermitian matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9878,14 +9878,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claqhp + + pure subroutine stdlib_claqr1( n, h, ldh, s1, s2, v ) !> Given a 2-by-2 or 3-by-3 matrix H, CLAQR1: 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. - - pure subroutine stdlib_claqr1( n, h, ldh, s1, s2, v ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9941,10 +9941,10 @@ module stdlib_linalg_lapack_c end if end subroutine stdlib_claqr1 - !> CLAQSB: equilibrates a symmetric band matrix A using the scaling - !> factors in the vector S. pure subroutine stdlib_claqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) + !> CLAQSB equilibrates a symmetric band matrix A using the scaling + !> factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10001,10 +10001,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claqsb - !> CLAQSP: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_claqsp( uplo, n, ap, s, scond, amax, equed ) + !> CLAQSP equilibrates a symmetric matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10063,10 +10063,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claqsp - !> CLAQSY: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_claqsy( uplo, n, a, lda, s, scond, amax, equed ) + !> CLAQSY equilibrates a symmetric matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10121,7 +10121,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claqsy - !> CLAR1V: computes the (scaled) r-th column of the inverse of + + pure subroutine stdlib_clar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & + !> CLAR1V 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 @@ -10136,8 +10138,6 @@ module stdlib_linalg_lapack_c !> (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. - - pure subroutine stdlib_clar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10344,15 +10344,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clar1v - !> CLAR2V: applies a vector of complex plane rotations with real cosines + + pure subroutine stdlib_clar2v( n, x, y, z, incx, c, s, incc ) + !> CLAR2V 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) ) - - pure subroutine stdlib_clar2v( n, x, y, z, incx, c, s, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10398,12 +10398,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clar2v - !> CLARCM: performs a very simple matrix-matrix multiplication: + + pure subroutine stdlib_clarcm( m, n, a, lda, b, ldb, c, ldc, rwork ) + !> CLARCM 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. - - pure subroutine stdlib_clarcm( m, n, a, lda, b, ldb, c, ldc, rwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10452,7 +10452,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarcm - !> CLARF: applies a complex elementary reflector H to a complex M-by-N + + pure subroutine stdlib_clarf( side, m, n, v, incv, tau, c, ldc, work ) + !> CLARF 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 @@ -10460,8 +10462,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_clarf( side, m, n, v, incv, tau, c, ldc, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10532,10 +10532,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarf - !> CLARFB: 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. pure subroutine stdlib_clarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, ldc, & + !> CLARFB 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. work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10860,15 +10860,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarfb - !> CLARFB_GETT: applies a complex Householder block reflector H from the + + pure subroutine stdlib_clarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) + !> CLARFB_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. - - pure subroutine stdlib_clarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10999,7 +10999,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarfb_gett - !> CLARFG: generates a complex elementary reflector H of order n, such + + pure subroutine stdlib_clarfg( n, alpha, x, incx, tau ) + !> CLARFG generates a complex elementary reflector H of order n, such !> that !> H**H * ( alpha ) = ( beta ), H**H * H = I. !> ( x ) ( 0 ) @@ -11012,8 +11014,6 @@ module stdlib_linalg_lapack_c !> 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 . - - pure subroutine stdlib_clarfg( n, alpha, x, incx, tau ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11073,7 +11073,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarfg - !> CLARFGP: generates a complex elementary reflector H of order n, such + + subroutine stdlib_clarfgp( n, alpha, x, incx, tau ) + !> CLARFGP generates a complex elementary reflector H of order n, such !> that !> H**H * ( alpha ) = ( beta ), H**H * H = I. !> ( x ) ( 0 ) @@ -11085,8 +11087,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_clarfgp( n, alpha, x, incx, tau ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11209,7 +11209,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarfgp - !> CLARFT: forms the triangular factor T of a complex block reflector H + + pure subroutine stdlib_clarft( direct, storev, n, k, v, ldv, tau, t, ldt ) + !> CLARFT 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. @@ -11219,8 +11221,6 @@ module stdlib_linalg_lapack_c !> 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 - - pure subroutine stdlib_clarft( direct, storev, n, k, v, ldv, tau, t, ldt ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11336,15 +11336,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarft - !> CLARFX: applies a complex elementary reflector H to a complex m by n + + pure subroutine stdlib_clarfx( side, m, n, v, tau, c, ldc, work ) + !> CLARFX 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 !> This version uses inline code if H has order < 11. - - pure subroutine stdlib_clarfx( side, m, n, v, tau, c, ldc, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11840,14 +11840,14 @@ module stdlib_linalg_lapack_c 410 return end subroutine stdlib_clarfx - !> CLARFY: applies an elementary reflector, or Householder matrix, H, + + pure subroutine stdlib_clarfy( uplo, n, v, incv, tau, c, ldc, work ) + !> CLARFY 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. - - pure subroutine stdlib_clarfy( uplo, n, v, incv, tau, c, ldc, work ) ! -- lapack test routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11874,10 +11874,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarfy - !> CLARNV: returns a vector of n random complex numbers from a uniform or - !> normal distribution. pure subroutine stdlib_clarnv( idist, iseed, n, x ) + !> CLARNV returns a vector of n random complex numbers from a uniform or + !> normal distribution. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11939,9 +11939,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarnv + + pure subroutine stdlib_clartg( f, g, c, s, r ) !> ! !> - !> CLARTG: generates a plane rotation so that + !> CLARTG 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. @@ -11963,8 +11965,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_clartg( f, g, c, s, r ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12059,12 +12059,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clartg - !> CLARTV: applies a vector of complex plane rotations with real cosines + + pure subroutine stdlib_clartv( n, x, incx, y, incy, c, s, incc ) + !> CLARTV 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) ) - - pure subroutine stdlib_clartv( n, x, incx, y, incy, c, s, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12096,7 +12096,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clartv - !> CLARZ: applies a complex elementary reflector H to a complex + + pure subroutine stdlib_clarz( side, m, n, l, v, incv, tau, c, ldc, work ) + !> CLARZ 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 @@ -12105,8 +12107,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_clarz( side, m, n, l, v, incv, tau, c, ldc, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12155,11 +12155,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarz - !> CLARZB: 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. pure subroutine stdlib_clarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & + !> CLARZB 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. ldc, work, ldwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12257,7 +12257,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarzb - !> CLARZT: forms the triangular factor T of a complex block reflector + + pure subroutine stdlib_clarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) + !> CLARZT 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; @@ -12269,8 +12271,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_clarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12321,13 +12321,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarzt - !> CLASCL: multiplies the M by N complex matrix A by the real scalar + + pure subroutine stdlib_clascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) + !> CLASCL 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. - - pure subroutine stdlib_clascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12491,10 +12491,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clascl - !> CLASET: initializes a 2-D array A to BETA on the diagonal and - !> ALPHA on the offdiagonals. pure subroutine stdlib_claset( uplo, m, n, alpha, beta, a, lda ) + !> CLASET initializes a 2-D array A to BETA on the diagonal and + !> ALPHA on the offdiagonals. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12547,7 +12547,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claset - !> CLASR: applies a sequence of real plane rotations to a complex matrix + + pure subroutine stdlib_clasr( side, pivot, direct, m, n, c, s, a, lda ) + !> CLASR 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 @@ -12598,8 +12600,6 @@ module stdlib_linalg_lapack_c !> ( -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. - - pure subroutine stdlib_clasr( side, pivot, direct, m, n, c, s, a, lda ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12807,9 +12807,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clasr + + pure subroutine stdlib_classq( n, x, incx, scl, sumsq ) !> ! !> - !> CLASSQ: returns the values scl and smsq such that + !> CLASSQ 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. @@ -12827,8 +12829,6 @@ module stdlib_linalg_lapack_c !> and !> TINY*EPS -- tiniest representable number; !> HUGE -- biggest representable number. - - pure subroutine stdlib_classq( n, x, incx, scl, sumsq ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12933,10 +12933,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_classq - !> CLASWP: performs a series of row interchanges on the matrix A. - !> One row interchange is initiated for each of rows K1 through K2 of A. pure subroutine stdlib_claswp( n, a, lda, k1, k2, ipiv, incx ) + !> CLASWP performs a series of row interchanges on the matrix A. + !> One row interchange is initiated for each of rows K1 through K2 of A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13000,7 +13000,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claswp - !> CLASYF: computes a partial factorization of a complex symmetric matrix + + pure subroutine stdlib_clasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) + !> CLASYF 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: @@ -13013,8 +13015,6 @@ module stdlib_linalg_lapack_c !> CLASYF 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'). - - pure subroutine stdlib_clasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13444,7 +13444,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clasyf - !> CLASYF_RK: computes a partial factorization of a complex symmetric + + pure subroutine stdlib_clasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) + !> CLASYF_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: @@ -13456,8 +13458,6 @@ module stdlib_linalg_lapack_c !> CLASYF_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'). - - pure subroutine stdlib_clasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13890,7 +13890,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clasyf_rk - !> CLASYF_ROOK: computes a partial factorization of a complex symmetric + + pure subroutine stdlib_clasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) + !> CLASYF_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: @@ -13902,8 +13904,6 @@ module stdlib_linalg_lapack_c !> CLASYF_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'). - - pure subroutine stdlib_clasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14356,7 +14356,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clasyf_rook - !> CLATBS: solves one of the triangular systems + + pure subroutine stdlib_clatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & + !> CLATBS 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 @@ -14366,8 +14368,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_clatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -14911,7 +14911,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clatbs - !> CLATPS: solves one of the triangular systems + + pure subroutine stdlib_clatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) + !> CLATPS 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 @@ -14922,8 +14924,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_clatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15461,7 +15461,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clatps - !> CLATRD: reduces NB rows and columns of a complex Hermitian matrix A to + + pure subroutine stdlib_clatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) + !> CLATRD reduces NB rows and columns of a complex Hermitian matrix A to !> Hermitian tridiagonal form by a unitary similarity !> transformation Q**H * A * Q, and returns the matrices V and W which are !> needed to apply the transformation to the unreduced part of A. @@ -15470,8 +15472,6 @@ module stdlib_linalg_lapack_c !> if UPLO = 'L', CLATRD reduces the first NB rows and columns of a !> matrix, of which the lower triangle is supplied. !> This is an auxiliary routine called by CHETRD. - - pure subroutine stdlib_clatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15577,7 +15577,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clatrd - !> CLATRS: solves one of the triangular systems + + pure subroutine stdlib_clatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) + !> CLATRS 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. Here A is an upper or lower !> triangular matrix, A**T denotes the transpose of A, A**H denotes the @@ -15587,8 +15589,6 @@ module stdlib_linalg_lapack_c !> unscaled problem will not cause overflow, the Level 2 BLAS routine !> CTRSV 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. - - pure subroutine stdlib_clatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16105,12 +16105,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clatrs - !> CLATRZ: factors the M-by-(M+L) complex upper trapezoidal matrix + + pure subroutine stdlib_clatrz( m, n, l, a, lda, tau, work ) + !> CLATRZ factors the M-by-(M+L) complex upper trapezoidal matrix !> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z by means !> of unitary transformations, where Z is an (M+L)-by-(M+L) unitary !> matrix and, R and A1 are M-by-M upper triangular matrices. - - pure subroutine stdlib_clatrz( m, n, l, a, lda, tau, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16151,7 +16151,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clatrz - !> CLAUNHR_COL_GETRFNP2: computes the modified LU factorization without + + pure recursive subroutine stdlib_claunhr_col_getrfnp2( m, n, a, lda, d, info ) + !> CLAUNHR_COL_GETRFNP2 computes the modified LU factorization without !> pivoting of a complex general M-by-N matrix A. The factorization has !> the form: !> A - S = L * U, @@ -16199,8 +16201,6 @@ module stdlib_linalg_lapack_c !> [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. - - pure recursive subroutine stdlib_claunhr_col_getrfnp2( m, n, a, lda, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16287,7 +16287,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claunhr_col_getrfnp2 - !> CLAUU2: computes the product U * U**H or L**H * L, where the triangular + + pure subroutine stdlib_clauu2( uplo, n, a, lda, info ) + !> CLAUU2 computes the product U * U**H or L**H * L, where the triangular !> factor U or L is stored in the upper or lower triangular part of !> the array A. !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, @@ -16295,8 +16297,6 @@ module stdlib_linalg_lapack_c !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, !> overwriting the factor L in A. !> This is the unblocked form of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_clauu2( uplo, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16365,7 +16365,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clauu2 - !> CLAUUM: computes the product U * U**H or L**H * L, where the triangular + + pure subroutine stdlib_clauum( uplo, n, a, lda, info ) + !> CLAUUM computes the product U * U**H or L**H * L, where the triangular !> factor U or L is stored in the upper or lower triangular part of !> the array A. !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, @@ -16373,8 +16375,6 @@ module stdlib_linalg_lapack_c !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, !> overwriting the factor L in A. !> This is the blocked form of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_clauum( uplo, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16449,7 +16449,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clauum - !> CPBEQU: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_cpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) + !> CPBEQU computes row and column scalings intended to equilibrate a !> Hermitian positive definite band matrix A and reduce its condition !> number (with respect to the two-norm). S contains the scale factors, !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with @@ -16457,8 +16459,6 @@ module stdlib_linalg_lapack_c !> choice of S puts the condition number of B within a factor N of the !> smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_cpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16536,7 +16536,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpbequ - !> CPBSTF: computes a split Cholesky factorization of a complex + + pure subroutine stdlib_cpbstf( uplo, n, kd, ab, ldab, info ) + !> CPBSTF computes a split Cholesky factorization of a complex !> Hermitian positive definite band matrix A. !> This routine is designed to be used in conjunction with CHBGST. !> The factorization has the form A = S**H*S where S is a band matrix @@ -16545,8 +16547,6 @@ module stdlib_linalg_lapack_c !> ( M L ) !> where U is upper triangular of order m = (n+kd)/2, and L is lower !> triangular of order n-m. - - pure subroutine stdlib_cpbstf( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16670,7 +16670,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpbstf - !> CPBTF2: computes the Cholesky factorization of a complex Hermitian + + pure subroutine stdlib_cpbtf2( uplo, n, kd, ab, ldab, info ) + !> CPBTF2 computes the Cholesky factorization of a complex Hermitian !> positive definite band matrix A. !> The factorization has the form !> A = U**H * U , if UPLO = 'U', or @@ -16678,8 +16680,6 @@ module stdlib_linalg_lapack_c !> where U is an upper triangular matrix, U**H is the conjugate transpose !> of U, and L is lower triangular. !> This is the unblocked version of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_cpbtf2( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16765,11 +16765,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpbtf2 - !> CPBTRS: solves a system of linear equations A*X = B with a Hermitian - !> positive definite band matrix A using the Cholesky factorization - !> A = U**H*U or A = L*L**H computed by CPBTRF. pure subroutine stdlib_cpbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) + !> CPBTRS solves a system of linear equations A*X = B with a Hermitian + !> positive definite band matrix A using the Cholesky factorization + !> A = U**H*U or A = L*L**H computed by CPBTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16833,7 +16833,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpbtrs - !> CPOEQU: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_cpoequ( n, a, lda, s, scond, amax, info ) + !> CPOEQU computes row and column scalings intended to equilibrate a !> Hermitian positive definite matrix A and reduce its condition number !> (with respect to the two-norm). S contains the scale factors, !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with @@ -16841,8 +16843,6 @@ module stdlib_linalg_lapack_c !> choice of S puts the condition number of B within a factor N of the !> smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_cpoequ( n, a, lda, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16907,7 +16907,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpoequ - !> CPOEQUB: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_cpoequb( n, a, lda, s, scond, amax, info ) + !> CPOEQUB computes row and column scalings intended to equilibrate a !> Hermitian positive definite matrix A and reduce its condition number !> (with respect to the two-norm). S contains the scale factors, !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with @@ -16920,8 +16922,6 @@ module stdlib_linalg_lapack_c !> these factors introduces no additional rounding errors. However, the !> scaled diagonal entries are no longer approximately 1 but lie !> between sqrt(radix) and 1/sqrt(radix). - - pure subroutine stdlib_cpoequb( n, a, lda, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16989,15 +16989,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpoequb - !> CPOTF2: computes the Cholesky factorization of a complex Hermitian + + pure subroutine stdlib_cpotf2( uplo, n, a, lda, info ) + !> CPOTF2 computes the Cholesky factorization of a complex Hermitian !> positive definite matrix A. !> The factorization has the form !> A = U**H * U , if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the unblocked version of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_cpotf2( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17083,7 +17083,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpotf2 - !> CPOTRF2: computes the Cholesky factorization of a Hermitian + + pure recursive subroutine stdlib_cpotrf2( uplo, n, a, lda, info ) + !> CPOTRF2 computes the Cholesky factorization of a Hermitian !> positive definite matrix A using the recursive algorithm. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or @@ -17096,8 +17098,6 @@ module stdlib_linalg_lapack_c !> [ A21 | A22 ] n2 = n-n1 !> The subroutine calls itself to factor A11. Update and scale A21 !> or A12, update A22 then calls itself to factor A22. - - pure recursive subroutine stdlib_cpotrf2( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17184,11 +17184,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpotrf2 - !> CPOTRS: solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A using the Cholesky factorization - !> A = U**H*U or A = L*L**H computed by CPOTRF. pure subroutine stdlib_cpotrs( uplo, n, nrhs, a, lda, b, ldb, info ) + !> CPOTRS solves a system of linear equations A*X = B with a Hermitian + !> positive definite matrix A using the Cholesky factorization + !> A = U**H*U or A = L*L**H computed by CPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17246,7 +17246,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpotrs - !> CPPEQU: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_cppequ( uplo, n, ap, s, scond, amax, info ) + !> CPPEQU computes row and column scalings intended to equilibrate a !> Hermitian positive definite matrix A in packed storage and reduce !> its condition number (with respect to the two-norm). S contains the !> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix @@ -17254,8 +17256,6 @@ module stdlib_linalg_lapack_c !> This choice of S puts the condition number of B within a factor N of !> the smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_cppequ( uplo, n, ap, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17339,14 +17339,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cppequ - !> CPPTRF: computes the Cholesky factorization of a complex Hermitian + + pure subroutine stdlib_cpptrf( uplo, n, ap, info ) + !> CPPTRF computes the Cholesky factorization of a complex Hermitian !> positive definite matrix A stored in packed format. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. - - pure subroutine stdlib_cpptrf( uplo, n, ap, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17425,11 +17425,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpptrf - !> CPPTRS: solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A in packed storage using the Cholesky - !> factorization A = U**H*U or A = L*L**H computed by CPPTRF. pure subroutine stdlib_cpptrs( uplo, n, nrhs, ap, b, ldb, info ) + !> CPPTRS solves a system of linear equations A*X = B with a Hermitian + !> positive definite matrix A in packed storage using the Cholesky + !> factorization A = U**H*U or A = L*L**H computed by CPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17489,7 +17489,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpptrs - !> CPSTF2: computes the Cholesky factorization with complete + + pure subroutine stdlib_cpstf2( uplo, n, a, lda, piv, rank, tol, work, info ) + !> CPSTF2 computes the Cholesky factorization with complete !> pivoting of a complex Hermitian positive semidefinite matrix A. !> The factorization has the form !> P**T * A * P = U**H * U , if UPLO = 'U', @@ -17498,8 +17500,6 @@ module stdlib_linalg_lapack_c !> P is stored as vector PIV. !> This algorithm does not attempt to check that A is positive !> semidefinite. This version of the algorithm calls level 2 BLAS. - - pure subroutine stdlib_cpstf2( uplo, n, a, lda, piv, rank, tol, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17683,7 +17683,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpstf2 - !> CPSTRF: computes the Cholesky factorization with complete + + pure subroutine stdlib_cpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) + !> CPSTRF computes the Cholesky factorization with complete !> pivoting of a complex Hermitian positive semidefinite matrix A. !> The factorization has the form !> P**T * A * P = U**H * U , if UPLO = 'U', @@ -17692,8 +17694,6 @@ module stdlib_linalg_lapack_c !> P is stored as vector PIV. !> This algorithm does not attempt to check that A is positive !> semidefinite. This version of the algorithm calls level 3 BLAS. - - pure subroutine stdlib_cpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17909,15 +17909,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpstrf - !> CPTCON: computes the reciprocal of the condition number (in the + + pure subroutine stdlib_cptcon( n, d, e, anorm, rcond, rwork, info ) + !> CPTCON computes the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite tridiagonal matrix !> using the factorization A = L*D*L**H or A = U**H*D*U computed by !> CPTTRF. !> Norm(inv(A)) is computed by a direct method, and the reciprocal of !> the condition number is computed as !> RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_cptcon( n, d, e, anorm, rcond, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17983,11 +17983,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cptcon - !> CPTTRF: computes the L*D*L**H factorization of a complex Hermitian - !> positive definite tridiagonal matrix A. The factorization may also - !> be regarded as having the form A = U**H *D*U. pure subroutine stdlib_cpttrf( n, d, e, info ) + !> CPTTRF computes the L*D*L**H factorization of a complex Hermitian + !> positive definite tridiagonal matrix A. The factorization may also + !> be regarded as having the form A = U**H *D*U. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18082,14 +18082,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpttrf - !> CPTTS2: solves a tridiagonal system of the form + + pure subroutine stdlib_cptts2( iuplo, n, nrhs, d, e, b, ldb ) + !> CPTTS2 solves a tridiagonal system of the form !> A * X = B !> using the factorization A = U**H*D*U or A = L*D*L**H computed by CPTTRF. !> D is a diagonal matrix specified in the vector D, U (or L) is a unit !> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in !> the vector E, and X and B are N by NRHS matrices. - - pure subroutine stdlib_cptts2( iuplo, n, nrhs, d, e, b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18182,10 +18182,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cptts2 - !> CROT: applies a plane rotation, where the cos (C) is real and the - !> sin (S) is complex, and the vectors CX and CY are complex. pure subroutine stdlib_crot( n, cx, incx, cy, incy, c, s ) + !> CROT applies a plane rotation, where the cos (C) is real and the + !> sin (S) is complex, and the vectors CX and CY are complex. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18227,12 +18227,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_crot - !> CSPMV: performs the matrix-vector operation + + pure subroutine stdlib_cspmv( uplo, n, alpha, ap, x, incx, beta, y, incy ) + !> CSPMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix, supplied in packed form. - - pure subroutine stdlib_cspmv( uplo, n, alpha, ap, x, incx, beta, y, incy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18385,12 +18385,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cspmv - !> CSPR: performs the symmetric rank 1 operation + + pure subroutine stdlib_cspr( uplo, n, alpha, x, incx, ap ) + !> CSPR performs the symmetric rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a complex scalar, x is an n element vector and A is an !> n by n symmetric matrix, supplied in packed form. - - pure subroutine stdlib_cspr( uplo, n, alpha, x, incx, ap ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18505,15 +18505,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cspr - !> CSPTRF: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_csptrf( uplo, n, ap, ipiv, info ) + !> CSPTRF computes the factorization of a complex symmetric matrix A !> stored in packed format using the Bunch-Kaufman diagonal pivoting !> method: !> 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 symmetric and block diagonal with !> 1-by-1 and 2-by-2 diagonal blocks. - - pure subroutine stdlib_csptrf( uplo, n, ap, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18834,11 +18834,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csptrf - !> CSPTRI: computes the inverse of a complex symmetric indefinite matrix - !> A in packed storage using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by CSPTRF. pure subroutine stdlib_csptri( uplo, n, ap, ipiv, work, info ) + !> CSPTRI computes the inverse of a complex symmetric indefinite matrix + !> A in packed storage using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by CSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19045,11 +19045,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csptri - !> CSPTRS: solves a system of linear equations A*X = B with a complex - !> symmetric matrix A stored in packed format using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by CSPTRF. pure subroutine stdlib_csptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) + !> CSPTRS solves a system of linear equations A*X = B with a complex + !> symmetric matrix A stored in packed format using the factorization + !> A = U*D*U**T or A = L*D*L**T computed by CSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19265,11 +19265,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csptrs - !> CSRSCL: multiplies an n-element complex vector x by the real scalar - !> 1/a. This is done without overflow or underflow as long as - !> the final result x/a does not overflow or underflow. pure subroutine stdlib_csrscl( n, sa, sx, incx ) + !> CSRSCL multiplies an n-element complex vector x by the real scalar + !> 1/a. This is done without overflow or underflow as long as + !> the final result x/a does not overflow or underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19319,7 +19319,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csrscl - !> CSTEIN: computes the eigenvectors of a real symmetric tridiagonal + + pure subroutine stdlib_cstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & + !> CSTEIN computes the eigenvectors of a real symmetric tridiagonal !> matrix T corresponding to specified eigenvalues, using inverse !> iteration. !> The maximum number of iterations allowed for each eigenvector is @@ -19328,8 +19330,6 @@ module stdlib_linalg_lapack_c !> array, which may be passed to CUNMTR or CUPMTR for back !> transformation to the eigenvectors of a complex Hermitian matrix !> which was reduced to tridiagonal form. - - pure subroutine stdlib_cstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19529,13 +19529,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cstein - !> CSTEQR: computes all eigenvalues and, optionally, eigenvectors of a + + pure subroutine stdlib_csteqr( compz, n, d, e, z, ldz, work, info ) + !> CSTEQR computes all eigenvalues and, optionally, eigenvectors of a !> symmetric tridiagonal matrix using the implicit QL or QR method. !> The eigenvectors of a full or band complex Hermitian matrix can also !> be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this !> matrix to tridiagonal form. - - pure subroutine stdlib_csteqr( compz, n, d, e, z, ldz, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19849,11 +19849,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csteqr - !> CSYCONV: convert A given by TRF into L and D and vice-versa. - !> Get Non-diag elements of D (returned in workspace) and - !> apply or reverse permutation done in TRF. pure subroutine stdlib_csyconv( uplo, way, n, a, lda, ipiv, e, info ) + !> CSYCONV convert A given by TRF into L and D and vice-versa. + !> Get Non-diag elements of D (returned in workspace) and + !> apply or reverse permutation done in TRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20054,8 +20054,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csyconv + + pure subroutine stdlib_csyconvf( uplo, way, n, a, lda, e, ipiv, info ) !> If parameter WAY = 'C': - !> CSYCONVF: converts the factorization output format used in + !> CSYCONVF converts the factorization output format used in !> CSYTRF provided on entry in parameter A into the factorization !> output format used in CSYTRF_RK (or CSYTRF_BK) that is stored !> on exit in parameters A and E. It also converts in place details of @@ -20071,8 +20073,6 @@ module stdlib_linalg_lapack_c !> (or CSYTRF_BK) into the format used in CSYTRF. !> CSYCONVF can also convert in Hermitian matrix case, i.e. between !> formats used in CHETRF and CHETRF_RK (or CHETRF_BK). - - pure subroutine stdlib_csyconvf( uplo, way, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20311,8 +20311,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csyconvf + + pure subroutine stdlib_csyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) !> If parameter WAY = 'C': - !> CSYCONVF_ROOK: converts the factorization output format used in + !> CSYCONVF_ROOK converts the factorization output format used in !> CSYTRF_ROOK provided on entry in parameter A into the factorization !> output format used in CSYTRF_RK (or CSYTRF_BK) that is stored !> on exit in parameters A and E. IPIV format for CSYTRF_ROOK and @@ -20326,8 +20328,6 @@ module stdlib_linalg_lapack_c !> CSYTRF_RK (or CSYTRF_BK) is the same and is not converted. !> CSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between !> formats used in CHETRF_ROOK and CHETRF_RK (or CHETRF_BK). - - pure subroutine stdlib_csyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20566,15 +20566,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csyconvf_rook - !> CSYEQUB: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_csyequb( uplo, n, a, lda, s, scond, amax, work, info ) + !> CSYEQUB computes row and column scalings intended to equilibrate a !> symmetric 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. - - pure subroutine stdlib_csyequb( uplo, n, a, lda, s, scond, amax, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20748,12 +20748,12 @@ module stdlib_linalg_lapack_c scond = max( smin, smlnum ) / min( smax, bignum ) end subroutine stdlib_csyequb - !> CSYMV: performs the matrix-vector operation + + pure subroutine stdlib_csymv( uplo, n, alpha, a, lda, x, incx, beta, y, incy ) + !> CSYMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix. - - pure subroutine stdlib_csymv( uplo, n, alpha, a, lda, x, incx, beta, y, incy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20902,12 +20902,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csymv - !> CSYR: performs the symmetric rank 1 operation + + pure subroutine stdlib_csyr( uplo, n, alpha, x, incx, a, lda ) + !> CSYR performs the symmetric rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a complex scalar, x is an n element vector and A is an !> n by n symmetric matrix. - - pure subroutine stdlib_csyr( uplo, n, alpha, x, incx, a, lda ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21006,10 +21006,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csyr - !> CSYSWAPR: applies an elementary permutation on the rows and the columns of - !> a symmetric matrix. pure subroutine stdlib_csyswapr( uplo, n, a, lda, i1, i2) + !> CSYSWAPR applies an elementary permutation on the rows and the columns of + !> a symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21074,15 +21074,15 @@ module stdlib_linalg_lapack_c endif end subroutine stdlib_csyswapr - !> CSYTF2: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_csytf2( uplo, n, a, lda, ipiv, info ) + !> CSYTF2 computes the factorization of a complex symmetric matrix A !> using the Bunch-Kaufman diagonal pivoting method: !> 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, U**T is the transpose of U, and D is symmetric 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. - - pure subroutine stdlib_csytf2( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21365,7 +21365,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytf2 - !> CSYTF2_RK: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_csytf2_rk( uplo, n, a, lda, e, ipiv, info ) + !> CSYTF2_RK computes the factorization of a complex symmetric matrix A !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), !> where U (or L) is unit upper (or lower) triangular matrix, @@ -21374,8 +21376,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_csytf2_rk( uplo, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21822,15 +21822,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytf2_rk - !> CSYTF2_ROOK: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_csytf2_rook( uplo, n, a, lda, ipiv, info ) + !> CSYTF2_ROOK computes the factorization of a complex symmetric matrix A !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: !> 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, U**T is the transpose of U, and D is symmetric 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. - - pure subroutine stdlib_csytf2_rook( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22238,7 +22238,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytf2_rook - !> CSYTRF: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_csytrf( uplo, n, a, lda, ipiv, work, lwork, info ) + !> CSYTRF computes the factorization of a complex symmetric matrix A !> using the Bunch-Kaufman diagonal pivoting method. The form of the !> factorization is !> A = U*D*U**T or A = L*D*L**T @@ -22246,8 +22248,6 @@ module stdlib_linalg_lapack_c !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_csytrf( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22364,7 +22364,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytrf - !> CSYTRF_RK: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_csytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) + !> CSYTRF_RK computes the factorization of a complex symmetric matrix A !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), !> where U (or L) is unit upper (or lower) triangular matrix, @@ -22373,8 +22375,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_csytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22530,7 +22530,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytrf_rk - !> CSYTRF_ROOK: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_csytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) + !> CSYTRF_ROOK computes the factorization of a complex symmetric 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 @@ -22538,8 +22540,6 @@ module stdlib_linalg_lapack_c !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_csytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22658,11 +22658,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytrf_rook - !> CSYTRI: computes the inverse of a complex symmetric indefinite matrix - !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by - !> CSYTRF. pure subroutine stdlib_csytri( uplo, n, a, lda, ipiv, work, info ) + !> CSYTRI computes the inverse of a complex symmetric indefinite matrix + !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by + !> CSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22846,11 +22846,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytri - !> CSYTRI_ROOK: computes the inverse of a complex symmetric - !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T - !> computed by CSYTRF_ROOK. pure subroutine stdlib_csytri_rook( uplo, n, a, lda, ipiv, work, info ) + !> CSYTRI_ROOK computes the inverse of a complex symmetric + !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T + !> computed by CSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23074,11 +23074,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytri_rook - !> CSYTRS: solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by CSYTRF. pure subroutine stdlib_csytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) + !> CSYTRS solves a system of linear equations A*X = B with a complex + !> symmetric matrix A using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by CSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23284,11 +23284,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytrs - !> CSYTRS2: solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by CSYTRF and converted by CSYCONV. pure subroutine stdlib_csytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) + !> CSYTRS2 solves a system of linear equations A*X = B with a complex + !> symmetric matrix A using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by CSYTRF and converted by CSYCONV. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23462,7 +23462,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytrs2 - !> CSYTRS_3: solves a system of linear equations A * X = B with a complex + + pure subroutine stdlib_csytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) + !> CSYTRS_3 solves a system of linear equations A * X = B with a complex !> symmetric matrix A using the factorization computed !> by CSYTRF_RK or CSYTRF_BK: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), @@ -23471,8 +23473,6 @@ module stdlib_linalg_lapack_c !> matrix, P**T is the transpose of P, and D is symmetric and block !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. !> This algorithm is using Level 3 BLAS. - - pure subroutine stdlib_csytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23619,11 +23619,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytrs_3 - !> CSYTRS_AA: solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U**T*T*U or - !> A = L*T*L**T computed by CSYTRF_AA. pure subroutine stdlib_csytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) + !> CSYTRS_AA solves a system of linear equations A*X = B with a complex + !> symmetric matrix A using the factorization A = U**T*T*U or + !> A = L*T*L**T computed by CSYTRF_AA. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23738,11 +23738,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytrs_aa - !> CSYTRS_ROOK: solves a system of linear equations A*X = B with - !> a complex symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by CSYTRF_ROOK. pure subroutine stdlib_csytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) + !> CSYTRS_ROOK solves a system of linear equations A*X = B with + !> a complex symmetric matrix A using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by CSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23960,14 +23960,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytrs_rook - !> CTBRFS: provides error bounds and backward error estimates for the + + pure subroutine stdlib_ctbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& + !> CTBRFS provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular band !> coefficient matrix. !> The solution matrix X must be computed by CTBTRS or some other !> means before entering this routine. CTBRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_ctbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24203,12 +24203,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctbrfs - !> CTBTRS: solves a triangular system of the form + + pure subroutine stdlib_ctbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) + !> CTBTRS solves a triangular system of the form !> A * X = B, A**T * X = B, or A**H * X = B, !> where A is a triangular band matrix of order N, and B is an !> N-by-NRHS matrix. A check is made to verify that A is nonsingular. - - pure subroutine stdlib_ctbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24276,16 +24276,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctbtrs + + pure subroutine stdlib_ctfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) !> Level 3 BLAS like routine for A in RFP Format. - !> CTFSM: solves the matrix equation + !> CTFSM solves the matrix equation !> op( A )*X = alpha*B or X*op( A ) = alpha*B !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**H. !> A is in Rectangular Full Packed (RFP) Format. !> The matrix X is overwritten on B. - - pure subroutine stdlib_ctfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24778,10 +24778,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctfsm - !> CTFTTP: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard packed format (TP). pure subroutine stdlib_ctfttp( transr, uplo, n, arf, ap, info ) + !> CTFTTP copies a triangular matrix A from rectangular full packed + !> format (TF) to standard packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25037,10 +25037,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctfttp - !> CTFTTR: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard full format (TR). pure subroutine stdlib_ctfttr( transr, uplo, n, arf, a, lda, info ) + !> CTFTTR copies a triangular matrix A from rectangular full packed + !> format (TF) to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25287,7 +25287,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctfttr - !> CTGEVC: computes some or all of the right and/or left eigenvectors of + + pure subroutine stdlib_ctgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & + !> CTGEVC computes some or all of the right and/or left eigenvectors of !> a pair of complex matrices (S,P), where S and P are upper triangular. !> Matrix pairs of this type are produced by the generalized Schur !> factorization of a complex matrix pair (A,B): @@ -25305,8 +25307,6 @@ module stdlib_linalg_lapack_c !> If Q and Z are the unitary factors from the generalized Schur !> factorization of a matrix pair (A,B), then Z*X and Q*Y !> are the matrices of right and left eigenvectors of (A,B). - - pure subroutine stdlib_ctgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & mm, m, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25700,7 +25700,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctgevc - !> CTGEX2: swaps adjacent diagonal 1 by 1 blocks (A11,B11) and (A22,B22) + + pure subroutine stdlib_ctgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, info ) + !> CTGEX2 swaps adjacent diagonal 1 by 1 blocks (A11,B11) and (A22,B22) !> in an upper triangular matrix pair (A, B) by an unitary equivalence !> transformation. !> (A, B) must be in generalized Schur canonical form, that is, A and @@ -25709,8 +25711,6 @@ module stdlib_linalg_lapack_c !> updated. !> Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H !> Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H - - pure subroutine stdlib_ctgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25840,7 +25840,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctgex2 - !> CTGEXC: reorders the generalized Schur decomposition of a complex + + pure subroutine stdlib_ctgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & + !> CTGEXC reorders the generalized Schur decomposition of a complex !> matrix pair (A,B), using an unitary equivalence transformation !> (A, B) := Q * (A, B) * Z**H, so that the diagonal block of (A, B) with !> row index IFST is moved to row ILST. @@ -25850,8 +25852,6 @@ module stdlib_linalg_lapack_c !> updated. !> Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H !> Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H - - pure subroutine stdlib_ctgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25924,11 +25924,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctgexc - !> CTPLQT2: computes a LQ a factorization of a complex "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. pure subroutine stdlib_ctplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) + !> CTPLQT2 computes a LQ a factorization of a complex "triangular-pentagonal" + !> matrix C, which is composed of a triangular block A and pentagonal block B, + !> using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26040,11 +26040,11 @@ module stdlib_linalg_lapack_c end do end subroutine stdlib_ctplqt2 - !> CTPQRT2: computes a QR factorization of a complex "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. pure subroutine stdlib_ctpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) + !> CTPQRT2 computes a QR factorization of a complex "triangular-pentagonal" + !> matrix C, which is composed of a triangular block A and pentagonal block B, + !> using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26131,11 +26131,11 @@ module stdlib_linalg_lapack_c end do end subroutine stdlib_ctpqrt2 - !> CTPRFB: applies a complex "triangular-pentagonal" block reflector H or its - !> conjugate transpose H**H to a complex matrix C, which is composed of two - !> blocks A and B, either from the left or right. pure subroutine stdlib_ctprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & + !> CTPRFB applies a complex "triangular-pentagonal" block reflector H or its + !> conjugate transpose H**H to a complex matrix C, which is composed of two + !> blocks A and B, either from the left or right. lda, b, ldb, work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26551,14 +26551,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctprfb - !> CTPRFS: provides error bounds and backward error estimates for the + + pure subroutine stdlib_ctprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & + !> CTPRFS provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular packed !> coefficient matrix. !> The solution matrix X must be computed by CTPTRS or some other !> means before entering this routine. CTPRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_ctprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26802,10 +26802,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctprfs - !> CTPTRI: computes the inverse of a complex upper or lower triangular - !> matrix A stored in packed format. pure subroutine stdlib_ctptri( uplo, diag, n, ap, info ) + !> CTPTRI computes the inverse of a complex upper or lower triangular + !> matrix A stored in packed format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26892,13 +26892,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctptri - !> CTPTRS: solves a triangular system of the form + + pure subroutine stdlib_ctptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) + !> CTPTRS solves a triangular system of the form !> A * X = B, A**T * X = B, or A**H * X = B, !> where A is a triangular matrix of order N stored in packed format, !> and B is an N-by-NRHS matrix. A check is made to verify that A is !> nonsingular. - - pure subroutine stdlib_ctptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26965,10 +26965,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctptrs - !> CTPTTF: copies a triangular matrix A from standard packed format (TP) - !> to rectangular full packed format (TF). pure subroutine stdlib_ctpttf( transr, uplo, n, ap, arf, info ) + !> CTPTTF copies a triangular matrix A from standard packed format (TP) + !> to rectangular full packed format (TF). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27223,10 +27223,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctpttf - !> CTPTTR: copies a triangular matrix A from standard packed format (TP) - !> to standard full format (TR). pure subroutine stdlib_ctpttr( uplo, n, ap, a, lda, info ) + !> CTPTTR copies a triangular matrix A from standard packed format (TP) + !> to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27277,7 +27277,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctpttr - !> CTREVC: computes some or all of the right and/or left eigenvectors of + + pure subroutine stdlib_ctrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & + !> CTREVC computes some or all of the right and/or left eigenvectors of !> a complex upper triangular matrix T. !> Matrices of this type are produced by the Schur factorization of !> a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. @@ -27292,8 +27294,6 @@ module stdlib_linalg_lapack_c !> input matrix. If Q is the unitary factor that reduces a matrix A to !> Schur form T, then Q*X and Q*Y are the matrices of right and left !> eigenvectors of A. - - pure subroutine stdlib_ctrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27477,7 +27477,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrevc - !> CTREVC3: computes some or all of the right and/or left eigenvectors of + + pure subroutine stdlib_ctrevc3( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & + !> CTREVC3 computes some or all of the right and/or left eigenvectors of !> a complex upper triangular matrix T. !> Matrices of this type are produced by the Schur factorization of !> a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. @@ -27493,8 +27495,6 @@ module stdlib_linalg_lapack_c !> Schur form T, then Q*X and Q*Y are the matrices of right and left !> eigenvectors of A. !> This uses a Level 3 BLAS version of the back transformation. - - pure subroutine stdlib_ctrevc3( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & work, lwork, rwork, lrwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27774,14 +27774,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrevc3 - !> CTREXC: reorders the Schur factorization of a complex matrix + + pure subroutine stdlib_ctrexc( compq, n, t, ldt, q, ldq, ifst, ilst, info ) + !> CTREXC reorders the Schur factorization of a complex matrix !> A = Q*T*Q**H, so that the diagonal element of T with row index IFST !> is moved to row ILST. !> The Schur form T is reordered by a unitary similarity transformation !> Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by !> postmultplying it with Z. - - pure subroutine stdlib_ctrexc( compq, n, t, ldt, q, ldq, ifst, ilst, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27853,14 +27853,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrexc - !> CTRRFS: provides error bounds and backward error estimates for the + + pure subroutine stdlib_ctrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& + !> CTRRFS provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular !> coefficient matrix. !> The solution matrix X must be computed by CTRTRS or some other !> means before entering this routine. CTRRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_ctrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28094,11 +28094,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrrfs - !> CTRSNA: estimates reciprocal condition numbers for specified - !> eigenvalues and/or right eigenvectors of a complex upper triangular - !> matrix T (or of any matrix Q*T*Q**H with Q unitary). pure subroutine stdlib_ctrsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm,& + !> CTRSNA estimates reciprocal condition numbers for specified + !> eigenvalues and/or right eigenvectors of a complex upper triangular + !> matrix T (or of any matrix Q*T*Q**H with Q unitary). m, work, ldwork, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28243,11 +28243,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrsna - !> CTRTI2: computes the inverse of a complex upper or lower triangular - !> matrix. - !> This is the Level 2 BLAS version of the algorithm. pure subroutine stdlib_ctrti2( uplo, diag, n, a, lda, info ) + !> CTRTI2 computes the inverse of a complex upper or lower triangular + !> matrix. + !> This is the Level 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28317,11 +28317,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrti2 - !> CTRTRI: computes the inverse of a complex upper or lower triangular - !> matrix A. - !> This is the Level 3 BLAS version of the algorithm. pure subroutine stdlib_ctrtri( uplo, diag, n, a, lda, info ) + !> CTRTRI computes the inverse of a complex upper or lower triangular + !> matrix A. + !> This is the Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28404,12 +28404,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrtri - !> CTRTRS: solves a triangular system of the form + + pure subroutine stdlib_ctrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) + !> CTRTRS solves a triangular system of the form !> A * X = B, A**T * X = B, or A**H * X = B, !> where A is a triangular matrix of order N, and B is an N-by-NRHS !> matrix. A check is made to verify that A is nonsingular. - - pure subroutine stdlib_ctrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28464,10 +28464,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrtrs - !> CTRTTF: copies a triangular matrix A from standard full format (TR) - !> to rectangular full packed format (TF) . pure subroutine stdlib_ctrttf( transr, uplo, n, a, lda, arf, info ) + !> CTRTTF copies a triangular matrix A from standard full format (TR) + !> to rectangular full packed format (TF) . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28713,10 +28713,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrttf - !> CTRTTP: copies a triangular matrix A from full format (TR) to standard - !> packed format (TP). pure subroutine stdlib_ctrttp( uplo, n, a, lda, ap, info ) + !> CTRTTP copies a triangular matrix A from full format (TR) to standard + !> packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28767,14 +28767,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrttp - !> CTZRZF: reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A + + pure subroutine stdlib_ctzrzf( m, n, a, lda, tau, work, lwork, info ) + !> CTZRZF reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A !> to upper triangular form by means of unitary transformations. !> The upper trapezoidal matrix A is factored as !> A = ( R 0 ) * Z, !> where Z is an N-by-N unitary matrix and R is an M-by-M upper !> triangular matrix. - - pure subroutine stdlib_ctzrzf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28883,7 +28883,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctzrzf - !> CUNBDB: simultaneously bidiagonalizes the blocks of an M-by-M + + subroutine stdlib_cunbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & + !> CUNBDB simultaneously bidiagonalizes the blocks of an M-by-M !> partitioned unitary matrix X: !> [ B11 | B12 0 0 ] !> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**H @@ -28899,8 +28901,6 @@ module stdlib_linalg_lapack_c !> represented implicitly by Householder vectors. !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_cunbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29206,7 +29206,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunbdb - !> CUNBDB6: orthogonalizes the column vector + + pure subroutine stdlib_cunbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & + !> CUNBDB6 orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] !> with respect to the columns of @@ -29215,8 +29217,6 @@ module stdlib_linalg_lapack_c !> The columns of Q must be orthonormal. !> If the projection is zero according to Kahan's "twice is enough" !> criterion, then the zero vector is returned. - - pure subroutine stdlib_cunbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29334,13 +29334,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunbdb6 - !> CUNG2L: generates an m by n complex matrix Q with orthonormal columns, + + pure subroutine stdlib_cung2l( m, n, k, a, lda, tau, work, info ) + !> CUNG2L generates an m by n complex matrix Q with orthonormal columns, !> which is defined as the last n columns of a product of k elementary !> reflectors of order m !> Q = H(k) . . . H(2) H(1) !> as returned by CGEQLF. - - pure subroutine stdlib_cung2l( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29398,13 +29398,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cung2l - !> CUNG2R: generates an m by n complex matrix Q with orthonormal columns, + + pure subroutine stdlib_cung2r( m, n, k, a, lda, tau, work, info ) + !> CUNG2R generates an m by n complex matrix Q with orthonormal columns, !> which is defined as the first n columns of a product of k elementary !> reflectors of order m !> Q = H(1) H(2) . . . H(k) !> as returned by CGEQRF. - - pure subroutine stdlib_cung2r( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29463,13 +29463,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cung2r - !> CUNGL2: generates an m-by-n complex matrix Q with orthonormal rows, + + pure subroutine stdlib_cungl2( m, n, k, a, lda, tau, work, info ) + !> CUNGL2 generates an m-by-n complex matrix Q with orthonormal rows, !> which is defined as the first m rows of a product of k elementary !> reflectors of order n !> Q = H(k)**H . . . H(2)**H H(1)**H !> as returned by CGELQF. - - pure subroutine stdlib_cungl2( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29534,13 +29534,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungl2 - !> CUNGLQ: generates an M-by-N complex matrix Q with orthonormal rows, + + pure subroutine stdlib_cunglq( m, n, k, a, lda, tau, work, lwork, info ) + !> CUNGLQ generates an M-by-N complex matrix Q with orthonormal rows, !> which is defined as the first M rows of a product of K elementary !> reflectors of order N !> Q = H(k)**H . . . H(2)**H H(1)**H !> as returned by CGELQF. - - pure subroutine stdlib_cunglq( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29650,13 +29650,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunglq - !> CUNGQL: generates an M-by-N complex matrix Q with orthonormal columns, + + pure subroutine stdlib_cungql( m, n, k, a, lda, tau, work, lwork, info ) + !> CUNGQL generates an M-by-N complex matrix Q with orthonormal columns, !> which is defined as the last N columns of a product of K elementary !> reflectors of order M !> Q = H(k) . . . H(2) H(1) !> as returned by CGEQLF. - - pure subroutine stdlib_cungql( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29771,13 +29771,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungql - !> CUNGQR: generates an M-by-N complex matrix Q with orthonormal columns, + + pure subroutine stdlib_cungqr( m, n, k, a, lda, tau, work, lwork, info ) + !> CUNGQR generates an M-by-N complex matrix Q with orthonormal columns, !> which is defined as the first N columns of a product of K elementary !> reflectors of order M !> Q = H(1) H(2) . . . H(k) !> as returned by CGEQRF. - - pure subroutine stdlib_cungqr( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29887,13 +29887,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungqr - !> CUNGR2: generates an m by n complex matrix Q with orthonormal rows, + + pure subroutine stdlib_cungr2( m, n, k, a, lda, tau, work, info ) + !> CUNGR2 generates an m by n complex matrix Q with orthonormal rows, !> which is defined as the last m rows of a product of k elementary !> reflectors of order n !> Q = H(1)**H H(2)**H . . . H(k)**H !> as returned by CGERQF. - - pure subroutine stdlib_cungr2( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29955,13 +29955,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungr2 - !> CUNGRQ: generates an M-by-N complex matrix Q with orthonormal rows, + + pure subroutine stdlib_cungrq( m, n, k, a, lda, tau, work, lwork, info ) + !> CUNGRQ generates an M-by-N complex matrix Q with orthonormal rows, !> which is defined as the last M rows of a product of K elementary !> reflectors of order N !> Q = H(1)**H H(2)**H . . . H(k)**H !> as returned by CGERQF. - - pure subroutine stdlib_cungrq( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30077,7 +30077,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungrq - !> CUNGTSQR_ROW: generates an M-by-N complex matrix Q_out with + + pure subroutine stdlib_cungtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) + !> CUNGTSQR_ROW generates an M-by-N complex matrix Q_out with !> orthonormal columns from the output of CLATSQR. These N orthonormal !> columns are the first N columns of a product of complex unitary !> matrices Q(k)_in of order M, which are returned by CLATSQR in @@ -30092,8 +30094,6 @@ module stdlib_linalg_lapack_c !> starting in the bottom row block and continues to the top row block !> (hence _ROW in the routine name). This sweep is in reverse order of !> the order in which CLATSQR generates the output blocks. - - pure subroutine stdlib_cungtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30402,7 +30402,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunm22 - !> CUNM2L: overwrites the general complex m-by-n matrix C with + + pure subroutine stdlib_cunm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> CUNM2L overwrites the general complex m-by-n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -30412,8 +30414,6 @@ module stdlib_linalg_lapack_c !> Q = H(k) . . . H(2) H(1) !> as returned by CGEQLF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_cunm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30501,7 +30501,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunm2l - !> CUNM2R: overwrites the general complex m-by-n matrix C with + + pure subroutine stdlib_cunm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> CUNM2R overwrites the general complex m-by-n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -30511,8 +30513,6 @@ module stdlib_linalg_lapack_c !> Q = H(1) H(2) . . . H(k) !> as returned by CGEQRF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_cunm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30604,7 +30604,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunm2r - !> CUNML2: overwrites the general complex m-by-n matrix C with + + pure subroutine stdlib_cunml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> CUNML2 overwrites the general complex m-by-n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -30614,8 +30616,6 @@ module stdlib_linalg_lapack_c !> Q = H(k)**H . . . H(2)**H H(1)**H !> as returned by CGELQF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_cunml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30710,7 +30710,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunml2 - !> CUNMLQ: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_cunmlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> CUNMLQ 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 @@ -30719,8 +30721,6 @@ module stdlib_linalg_lapack_c !> Q = H(k)**H . . . H(2)**H H(1)**H !> as returned by CGELQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_cunmlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30858,7 +30858,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmlq - !> CUNMQL: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_cunmql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> CUNMQL 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 @@ -30867,8 +30869,6 @@ module stdlib_linalg_lapack_c !> Q = H(k) . . . H(2) H(1) !> as returned by CGEQLF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_cunmql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30996,7 +30996,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmql - !> CUNMQR: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_cunmqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> CUNMQR 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 @@ -31005,8 +31007,6 @@ module stdlib_linalg_lapack_c !> Q = H(1) H(2) . . . H(k) !> as returned by CGEQRF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_cunmqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31133,7 +31133,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmqr - !> CUNMR2: overwrites the general complex m-by-n matrix C with + + pure subroutine stdlib_cunmr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> CUNMR2 overwrites the general complex m-by-n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -31143,8 +31145,6 @@ module stdlib_linalg_lapack_c !> Q = H(1)**H H(2)**H . . . H(k)**H !> as returned by CGERQF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_cunmr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31234,7 +31234,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmr2 - !> CUNMR3: overwrites the general complex m by n matrix C with + + pure subroutine stdlib_cunmr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) + !> CUNMR3 overwrites the general complex m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -31244,8 +31246,6 @@ module stdlib_linalg_lapack_c !> Q = H(1) H(2) . . . H(k) !> as returned by CTZRZF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_cunmr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31339,7 +31339,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmr3 - !> CUNMRQ: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_cunmrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> CUNMRQ 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 @@ -31348,8 +31350,6 @@ module stdlib_linalg_lapack_c !> Q = H(1)**H H(2)**H . . . H(k)**H !> as returned by CGERQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_cunmrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31482,7 +31482,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmrq - !> CUNMRZ: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_cunmrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & + !> CUNMRZ 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 @@ -31491,8 +31493,6 @@ module stdlib_linalg_lapack_c !> Q = H(1) H(2) . . . H(k) !> as returned by CTZRZF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_cunmrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31636,7 +31636,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmrz - !> CBBCSD: computes the CS decomposition of a unitary matrix in + + pure subroutine stdlib_cbbcsd( jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q,theta, phi, u1, & + !> CBBCSD computes the CS decomposition of a unitary matrix in !> bidiagonal-block form, !> [ B11 | B12 0 0 ] !> [ 0 | 0 -I 0 ] @@ -31657,8 +31659,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_cbbcsd( 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 ) ! -- lapack computational routine -- @@ -32249,7 +32249,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cbbcsd - !> CBDSQR: computes the singular values and, optionally, the right and/or + + pure subroutine stdlib_cbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, rwork,& + !> CBDSQR 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 @@ -32273,8 +32275,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_cbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, rwork,& info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32712,14 +32712,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cbdsqr - !> CGBCON: estimates the reciprocal of the condition number of a complex + + pure subroutine stdlib_cgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, rwork, & + !> CGBCON 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)) ). - - pure subroutine stdlib_cgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, rwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32846,11 +32846,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgbcon - !> CGBTRF: 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. pure subroutine stdlib_cgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) + !> CGBTRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33096,12 +33096,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgbtrf - !> CGBTRS: solves a system of linear equations + + pure subroutine stdlib_cgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) + !> CGBTRS 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. - - pure subroutine stdlib_cgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33209,11 +33209,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgbtrs - !> CGEBD2: reduces a complex general m by n matrix A to upper or lower - !> real 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. pure subroutine stdlib_cgebd2( m, n, a, lda, d, e, tauq, taup, work, info ) + !> CGEBD2 reduces a complex general m by n matrix A to upper or lower + !> real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33307,14 +33307,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgebd2 - !> CGECON: estimates the reciprocal of the condition number of a general + + pure subroutine stdlib_cgecon( norm, n, a, lda, anorm, rcond, work, rwork,info ) + !> CGECON 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)) ). - - pure subroutine stdlib_cgecon( norm, n, a, lda, anorm, rcond, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33413,10 +33413,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgecon - !> CGEHD2: reduces a complex general matrix A to upper Hessenberg form H - !> by a unitary similarity transformation: Q**H * A * Q = H . pure subroutine stdlib_cgehd2( n, ilo, ihi, a, lda, tau, work, info ) + !> CGEHD2 reduces a complex general matrix A to upper Hessenberg form H + !> by a unitary similarity transformation: Q**H * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33465,14 +33465,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgehd2 - !> CGELQ2: computes an LQ factorization of a complex m-by-n matrix A: + + pure subroutine stdlib_cgelq2( m, n, a, lda, tau, work, info ) + !> CGELQ2 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. - - pure subroutine stdlib_cgelq2( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33521,14 +33521,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelq2 - !> CGELQF: computes an LQ factorization of a complex M-by-N matrix A: + + pure subroutine stdlib_cgelqf( m, n, a, lda, tau, work, lwork, info ) + !> CGELQF 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. - - pure subroutine stdlib_cgelqf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33618,12 +33618,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelqf - !> CGELQT3: recursively computes a LQ factorization of a complex M-by-N + + pure recursive subroutine stdlib_cgelqt3( m, n, a, lda, t, ldt, info ) + !> CGELQT3 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. - - pure recursive subroutine stdlib_cgelqt3( m, n, a, lda, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33708,7 +33708,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelqt3 - !> CGEMLQT: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_cgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) + !> CGEMLQT 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 @@ -33717,8 +33719,6 @@ module stdlib_linalg_lapack_c !> 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'. - - pure subroutine stdlib_cgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33806,7 +33806,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgemlqt - !> CGEMQRT: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_cgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) + !> CGEMQRT 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 @@ -33815,8 +33817,6 @@ module stdlib_linalg_lapack_c !> 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'. - - pure subroutine stdlib_cgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33904,10 +33904,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgemqrt - !> CGEQL2: computes a QL factorization of a complex m by n matrix A: - !> A = Q * L. pure subroutine stdlib_cgeql2( m, n, a, lda, tau, work, info ) + !> CGEQL2 computes a QL factorization of a complex m by n matrix A: + !> A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33953,10 +33953,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeql2 - !> CGEQLF: computes a QL factorization of a complex M-by-N matrix A: - !> A = Q * L. pure subroutine stdlib_cgeqlf( m, n, a, lda, tau, work, lwork, info ) + !> CGEQLF computes a QL factorization of a complex M-by-N matrix A: + !> A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34059,15 +34059,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeqlf - !> CGEQR2: computes a QR factorization of a complex m-by-n matrix A: + + pure subroutine stdlib_cgeqr2( m, n, a, lda, tau, work, info ) + !> CGEQR2 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. - - pure subroutine stdlib_cgeqr2( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34114,7 +34114,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeqr2 - !> CGEQR2P: computes a QR factorization of a complex m-by-n matrix A: + + subroutine stdlib_cgeqr2p( m, n, a, lda, tau, work, info ) + !> CGEQR2P computes a QR factorization of a complex m-by-n matrix A: !> A = Q * ( R ), !> ( 0 ) !> where: @@ -34122,8 +34124,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_cgeqr2p( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34170,15 +34170,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeqr2p - !> CGEQRF: computes a QR factorization of a complex M-by-N matrix A: + + pure subroutine stdlib_cgeqrf( m, n, a, lda, tau, work, lwork, info ) + !> CGEQRF 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. - - pure subroutine stdlib_cgeqrf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34272,6 +34272,8 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeqrf + + subroutine stdlib_cgeqrfp( m, n, a, lda, tau, work, lwork, info ) !> CGEQR2P computes a QR factorization of a complex M-by-N matrix A: !> A = Q * ( R ), !> ( 0 ) @@ -34280,8 +34282,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_cgeqrfp( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34371,10 +34371,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeqrfp - !> CGEQRT2: computes a QR factorization of a complex M-by-N matrix A, - !> using the compact WY representation of Q. pure subroutine stdlib_cgeqrt2( m, n, a, lda, t, ldt, info ) + !> CGEQRT2 computes a QR factorization of a complex M-by-N matrix A, + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34439,12 +34439,12 @@ module stdlib_linalg_lapack_c end do end subroutine stdlib_cgeqrt2 - !> CGEQRT3: recursively computes a QR factorization of a complex M-by-N matrix A, + + pure recursive subroutine stdlib_cgeqrt3( m, n, a, lda, t, ldt, info ) + !> CGEQRT3 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. - - pure recursive subroutine stdlib_cgeqrt3( m, n, a, lda, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34527,10 +34527,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeqrt3 - !> CGERQ2: computes an RQ factorization of a complex m by n matrix A: - !> A = R * Q. pure subroutine stdlib_cgerq2( m, n, a, lda, tau, work, info ) + !> CGERQ2 computes an RQ factorization of a complex m by n matrix A: + !> A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34578,10 +34578,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgerq2 - !> CGERQF: computes an RQ factorization of a complex M-by-N matrix A: - !> A = R * Q. pure subroutine stdlib_cgerqf( m, n, a, lda, tau, work, lwork, info ) + !> CGERQF computes an RQ factorization of a complex M-by-N matrix A: + !> A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34684,12 +34684,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgerqf - !> CGESC2: solves a system of linear equations + + pure subroutine stdlib_cgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) + !> CGESC2 solves a system of linear equations !> A * X = scale* RHS !> with a general N-by-N matrix A using the LU factorization with !> complete pivoting computed by CGETC2. - - pure subroutine stdlib_cgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34743,7 +34743,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgesc2 - !> CGETRF2: computes an LU factorization of a general M-by-N matrix A + + pure recursive subroutine stdlib_cgetrf2( m, n, a, lda, ipiv, info ) + !> CGETRF2 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 @@ -34762,8 +34764,6 @@ module stdlib_linalg_lapack_c !> do the swaps on [ --- ], solve A12, update A22, !> [ A22 ] !> then calls itself to factor A22 and do the swaps on A21. - - pure recursive subroutine stdlib_cgetrf2( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34859,12 +34859,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgetrf2 - !> CGETRI: computes the inverse of a matrix using the LU factorization + + pure subroutine stdlib_cgetri( n, a, lda, ipiv, work, lwork, info ) + !> CGETRI 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). - - pure subroutine stdlib_cgetri( n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34961,12 +34961,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgetri - !> CGETRS: solves a system of linear equations + + pure subroutine stdlib_cgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) + !> CGETRS 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. - - pure subroutine stdlib_cgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35030,7 +35030,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgetrs - !> CGGHRD: reduces a pair of complex matrices (A,B) to generalized upper + + pure subroutine stdlib_cgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & + !> CGGHRD 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 @@ -35053,8 +35055,6 @@ module stdlib_linalg_lapack_c !> If Q1 is the unitary matrix from the QR factorization of B in the !> original equation A*x = lambda*B*x, then CGGHRD reduces the original !> problem to generalized Hessenberg form. - - pure subroutine stdlib_cgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35162,7 +35162,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgghrd - !> CGGQRF: computes a generalized QR factorization of an N-by-M matrix A + + pure subroutine stdlib_cggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) + !> CGGQRF 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, @@ -35180,8 +35182,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_cggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35240,7 +35240,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cggqrf - !> CGGRQF: computes a generalized RQ factorization of an M-by-N matrix A + + pure subroutine stdlib_cggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) + !> CGGRQF 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 @@ -35258,8 +35260,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_cggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35318,12 +35318,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cggrqf - !> CGTTRS: solves one of the systems of equations + + pure subroutine stdlib_cgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) + !> CGTTRS 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. - - pure subroutine stdlib_cgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35384,10 +35384,10 @@ module stdlib_linalg_lapack_c end if end subroutine stdlib_cgttrs - !> CHB2ST_KERNELS: is an internal routine used by the CHETRD_HB2ST - !> subroutine. pure subroutine stdlib_chb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, lda, & + !> CHB2ST_KERNELS is an internal routine used by the CHETRD_HB2ST + !> subroutine. v, tau, ldvt, work) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35529,15 +35529,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chb2st_kernels - !> CHEEQUB: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_cheequb( uplo, n, a, lda, s, scond, amax, work, info ) + !> CHEEQUB 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. - - pure subroutine stdlib_cheequb( uplo, n, a, lda, s, scond, amax, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35711,15 +35711,15 @@ module stdlib_linalg_lapack_c scond = max( smin, smlnum ) / min( smax, bignum ) end subroutine stdlib_cheequb - !> CHEGS2: reduces a complex Hermitian-definite generalized + + pure subroutine stdlib_chegs2( itype, uplo, n, a, lda, b, ldb, info ) + !> CHEGS2 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 ZPOTRF. - - pure subroutine stdlib_chegs2( itype, uplo, n, a, lda, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35844,15 +35844,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chegs2 - !> CHEGST: reduces a complex Hermitian-definite generalized + + pure subroutine stdlib_chegst( itype, uplo, n, a, lda, b, ldb, info ) + !> CHEGST 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. - - pure subroutine stdlib_chegst( itype, uplo, n, a, lda, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35983,11 +35983,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chegst - !> CHETD2: reduces a complex Hermitian matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. pure subroutine stdlib_chetd2( uplo, n, a, lda, d, e, tau, info ) + !> CHETD2 reduces a complex Hermitian matrix A to real symmetric + !> tridiagonal form T by a unitary similarity transformation: + !> Q**H * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36087,11 +36087,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetd2 - !> CHETRD: reduces a complex Hermitian matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. pure subroutine stdlib_chetrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) + !> CHETRD reduces a complex Hermitian matrix A to real symmetric + !> tridiagonal form T by a unitary similarity transformation: + !> Q**H * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36215,11 +36215,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrd - !> CHETRD_HB2ST: reduces a complex Hermitian band matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. pure subroutine stdlib_chetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & + !> CHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric + !> tridiagonal form T by a unitary similarity transformation: + !> Q**H * A * Q = T. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36488,11 +36488,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrd_hb2st - !> CHETRD_HE2HB: reduces a complex Hermitian matrix A to complex Hermitian - !> band-diagonal form AB by a unitary similarity transformation: - !> Q**H * A * Q = AB. pure subroutine stdlib_chetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) + !> CHETRD_HE2HB reduces a complex Hermitian matrix A to complex Hermitian + !> band-diagonal form AB by a unitary similarity transformation: + !> Q**H * A * Q = AB. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36664,7 +36664,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrd_he2hb - !> CHETRF: computes the factorization of a complex Hermitian matrix A + + pure subroutine stdlib_chetrf( uplo, n, a, lda, ipiv, work, lwork, info ) + !> CHETRF 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 @@ -36672,8 +36674,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_chetrf( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36790,7 +36790,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrf - !> CHETRF_RK: computes the factorization of a complex Hermitian matrix A + + pure subroutine stdlib_chetrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) + !> CHETRF_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, @@ -36799,8 +36801,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_chetrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36956,7 +36956,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrf_rk - !> CHETRF_ROOK: computes the factorization of a complex Hermitian matrix A + + pure subroutine stdlib_chetrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) + !> CHETRF_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 @@ -36964,8 +36966,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_chetrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37084,11 +37084,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrf_rook - !> CHETRS: 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. pure subroutine stdlib_chetrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) + !> CHETRS 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37315,11 +37315,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrs - !> CHETRS2: 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. pure subroutine stdlib_chetrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) + !> CHETRS2 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37496,11 +37496,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrs2 - !> CHETRS_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. pure subroutine stdlib_chetrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) + !> CHETRS_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37625,11 +37625,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrs_aa - !> CHETRS_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. pure subroutine stdlib_chetrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) + !> CHETRS_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37864,11 +37864,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrs_rook - !> CHPTRD: 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. pure subroutine stdlib_chptrd( uplo, n, ap, d, e, tau, info ) + !> CHPTRD 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37968,11 +37968,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chptrd - !> CHPTRS: 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. pure subroutine stdlib_chptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) + !> CHPTRS 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38209,10 +38209,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chptrs - !> CLA_GBRCOND_C: Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a REAL vector. real(sp) function stdlib_cla_gbrcond_c( trans, n, kl, ku, ab, ldab, afb,ldafb, ipiv, c, & + !> CLA_GBRCOND_C Computes the infinity norm condition number of + !> op(A) * inv(diag(C)) where C is a REAL vector. capply, info, work,rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38357,10 +38357,10 @@ module stdlib_linalg_lapack_c return end function stdlib_cla_gbrcond_c - !> CLA_GERCOND_C: computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a REAL vector. real(sp) function stdlib_cla_gercond_c( trans, n, a, lda, af, ldaf, ipiv, c,capply, info, & + !> CLA_GERCOND_C computes the infinity norm condition number of + !> op(A) * inv(diag(C)) where C is a REAL vector. work, rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38498,10 +38498,10 @@ module stdlib_linalg_lapack_c return end function stdlib_cla_gercond_c - !> CLA_HERCOND_C: computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a REAL vector. real(sp) function stdlib_cla_hercond_c( uplo, n, a, lda, af, ldaf, ipiv, c,capply, info, & + !> CLA_HERCOND_C computes the infinity norm condition number of + !> op(A) * inv(diag(C)) where C is a REAL vector. work, rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38648,14 +38648,14 @@ module stdlib_linalg_lapack_c return end function stdlib_cla_hercond_c - !> CLA_HERPVGRW: computes the reciprocal pivot growth factor + + real(sp) function stdlib_cla_herpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work ) + !> CLA_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. - - real(sp) function stdlib_cla_herpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38837,10 +38837,10 @@ module stdlib_linalg_lapack_c stdlib_cla_herpvgrw = rpvgrw end function stdlib_cla_herpvgrw - !> CLA_PORCOND_C: Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a REAL vector real(sp) function stdlib_cla_porcond_c( uplo, n, a, lda, af, ldaf, c, capply,info, work, & + !> CLA_PORCOND_C Computes the infinity norm condition number of + !> op(A) * inv(diag(C)) where C is a REAL vector rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38987,10 +38987,10 @@ module stdlib_linalg_lapack_c return end function stdlib_cla_porcond_c - !> CLA_SYRCOND_C: Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a REAL vector. real(sp) function stdlib_cla_syrcond_c( uplo, n, a, lda, af, ldaf, ipiv, c,capply, info, & + !> CLA_SYRCOND_C Computes the infinity norm condition number of + !> op(A) * inv(diag(C)) where C is a REAL vector. work, rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39138,14 +39138,14 @@ module stdlib_linalg_lapack_c return end function stdlib_cla_syrcond_c - !> CLA_SYRPVGRW: computes the reciprocal pivot growth factor + + real(sp) function stdlib_cla_syrpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work ) + !> CLA_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. - - real(sp) function stdlib_cla_syrpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39327,15 +39327,15 @@ module stdlib_linalg_lapack_c stdlib_cla_syrpvgrw = rpvgrw end function stdlib_cla_syrpvgrw - !> CLABRD: reduces the first NB rows and columns of a complex general + + pure subroutine stdlib_clabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) + !> CLABRD 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 - - pure subroutine stdlib_clabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39477,7 +39477,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clabrd - !> CLAED7: computes the updated eigensystem of a diagonal + + pure subroutine stdlib_claed7( n, cutpnt, qsiz, tlvls, curlvl, curpbm, d, q,ldq, rho, indxq, & + !> CLAED7 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 @@ -39501,8 +39503,6 @@ module stdlib_linalg_lapack_c !> directly using the updated eigenvalues. The eigenvectors for !> the current problem are multiplied with the eigenvectors from !> the overall problem. - - pure subroutine stdlib_claed7( n, cutpnt, qsiz, tlvls, curlvl, curpbm, d, q,ldq, rho, indxq, & qstore, qptr, prmptr, perm,givptr, givcol, givnum, work, rwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39604,11 +39604,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claed7 - !> CLAEIN: uses inverse iteration to find a right or left eigenvector - !> corresponding to the eigenvalue W of a complex upper Hessenberg - !> matrix H. pure subroutine stdlib_claein( rightv, noinit, n, h, ldh, w, v, b, ldb, rwork,eps3, smlnum, & + !> CLAEIN uses inverse iteration to find a right or left eigenvector + !> corresponding to the eigenvalue W of a complex upper Hessenberg + !> matrix H. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39748,7 +39748,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claein - !> CLAGS2: computes 2-by-2 unitary matrices U, V and Q, such + + pure subroutine stdlib_clags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) + !> CLAGS2 computes 2-by-2 unitary matrices U, V and Q, such !> that if ( UPPER ) then !> U**H *A*Q = U**H *( A1 A2 )*Q = ( x 0 ) !> ( 0 A3 ) ( x x ) @@ -39772,8 +39774,6 @@ module stdlib_linalg_lapack_c !> then the transformed (2,2) element of B is not zero, except when the !> first rows of input A and B are parallel and the second rows are !> zero. - - pure subroutine stdlib_clags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39935,12 +39935,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clags2 - !> CLAHQR: is an auxiliary routine called by CHSEQR to update the + + pure subroutine stdlib_clahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, info & + !> CLAHQR 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. - - pure subroutine stdlib_clahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, info & ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40221,14 +40221,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clahqr - !> CLAHR2: reduces the first NB columns of A complex general n-BY-(n-k+1) + + pure subroutine stdlib_clahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) + !> CLAHR2 reduces the first NB columns of A complex general n-BY-(n-k+1) !> matrix A so that elements below the k-th subdiagonal are zero. The !> reduction is performed by an unitary similarity transformation !> Q**H * A * Q. The routine returns the matrices V and T which determine !> Q as a block reflector I - V*T*v**H, and also the matrix Y = A * V * T. !> This is an auxiliary routine called by CGEHRD. - - pure subroutine stdlib_clahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -40311,7 +40311,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clahr2 - !> CLALS0: applies back the multiplying factors of either the left or the + + pure subroutine stdlib_clals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, & + !> CLALS0 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. @@ -40331,8 +40333,6 @@ module stdlib_linalg_lapack_c !> null space. !> (3R) The inverse transformation of (2L). !> (4R) The inverse transformation of (1L). - - pure subroutine stdlib_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 ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40556,7 +40556,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clals0 - !> CLALSA: is an itermediate step in solving the least squares problem + + pure subroutine stdlib_clalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, difl,& + !> CLALSA 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.). @@ -40565,8 +40567,6 @@ module stdlib_linalg_lapack_c !> ICOMPQ = 1, CLALSA applies the right singular vector matrix to the !> right hand side. The singular vector matrices were generated in !> compact form by CLALSA. - - pure subroutine stdlib_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 ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40859,7 +40859,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clalsa - !> CLALSD: uses the singular value decomposition of A to solve the least + + pure subroutine stdlib_clalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, rwork, & + !> CLALSD 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. @@ -40873,8 +40875,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_clalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, rwork, & iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41270,11 +41270,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clalsd - !> CLANGB: 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. real(sp) function stdlib_clangb( norm, n, kl, ku, ab, ldab,work ) + !> CLANGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41345,11 +41345,11 @@ module stdlib_linalg_lapack_c return end function stdlib_clangb - !> CLANGE: 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. real(sp) function stdlib_clange( norm, m, n, a, lda, work ) + !> CLANGE 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41417,11 +41417,11 @@ module stdlib_linalg_lapack_c return end function stdlib_clange - !> CLANGT: 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. pure real(sp) function stdlib_clangt( norm, n, dl, d, du ) + !> CLANGT 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41493,11 +41493,11 @@ module stdlib_linalg_lapack_c return end function stdlib_clangt - !> CLANHB: 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. real(sp) function stdlib_clanhb( norm, uplo, n, k, ab, ldab,work ) + !> CLANHB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41612,11 +41612,11 @@ module stdlib_linalg_lapack_c return end function stdlib_clanhb - !> CLANHE: 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. real(sp) function stdlib_clanhe( norm, uplo, n, a, lda, work ) + !> CLANHE 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41722,11 +41722,11 @@ module stdlib_linalg_lapack_c return end function stdlib_clanhe - !> CLANHF: 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. real(sp) function stdlib_clanhf( norm, transr, uplo, n, a, work ) + !> CLANHF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42942,11 +42942,11 @@ module stdlib_linalg_lapack_c return end function stdlib_clanhf - !> CLANHP: 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. real(sp) function stdlib_clanhp( norm, uplo, n, ap, work ) + !> CLANHP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43070,11 +43070,11 @@ module stdlib_linalg_lapack_c return end function stdlib_clanhp - !> CLANHS: 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. real(sp) function stdlib_clanhs( norm, n, a, lda, work ) + !> CLANHS 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43142,11 +43142,11 @@ module stdlib_linalg_lapack_c return end function stdlib_clanhs - !> CLANHT: 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. pure real(sp) function stdlib_clanht( norm, n, d, e ) + !> CLANHT 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43205,11 +43205,11 @@ module stdlib_linalg_lapack_c return end function stdlib_clanht - !> CLANSB: 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. real(sp) function stdlib_clansb( norm, uplo, n, k, ab, ldab,work ) + !> CLANSB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43310,11 +43310,11 @@ module stdlib_linalg_lapack_c return end function stdlib_clansb - !> CLANSP: 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. real(sp) function stdlib_clansp( norm, uplo, n, ap, work ) + !> CLANSP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43443,11 +43443,11 @@ module stdlib_linalg_lapack_c return end function stdlib_clansp - !> CLANSY: 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. real(sp) function stdlib_clansy( norm, uplo, n, a, lda, work ) + !> CLANSY 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43539,11 +43539,11 @@ module stdlib_linalg_lapack_c return end function stdlib_clansy - !> CLANTB: 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. real(sp) function stdlib_clantb( norm, uplo, diag, n, k, ab,ldab, work ) + !> CLANTB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43732,11 +43732,11 @@ module stdlib_linalg_lapack_c return end function stdlib_clantb - !> CLANTP: 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. real(sp) function stdlib_clantp( norm, uplo, diag, n, ap, work ) + !> CLANTP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43938,11 +43938,11 @@ module stdlib_linalg_lapack_c return end function stdlib_clantp - !> CLANTR: 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. real(sp) function stdlib_clantr( norm, uplo, diag, m, n, a, lda,work ) + !> CLANTR 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44124,14 +44124,14 @@ module stdlib_linalg_lapack_c return end function stdlib_clantr + + pure subroutine stdlib_clapll( n, x, incx, y, incy, ssmin ) !> 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. - - pure subroutine stdlib_clapll( n, x, incx, y, incy, ssmin ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44168,11 +44168,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clapll - !> CLAQP2: computes a QR factorization with column pivoting of - !> the block A(OFFSET+1:M,1:N). - !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. pure subroutine stdlib_claqp2( m, n, offset, a, lda, jpvt, tau, vn1, vn2,work ) + !> CLAQP2 computes a QR factorization with column pivoting of + !> the block A(OFFSET+1:M,1:N). + !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44248,7 +44248,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claqp2 - !> CLAQPS: computes a step of QR factorization with column pivoting + + pure subroutine stdlib_claqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & + !> CLAQPS 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. @@ -44256,8 +44258,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_claqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -44391,10 +44391,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claqps - !> CLAQR5: called by CLAQR0 performs a - !> single small-bulge multi-shift QR sweep. pure subroutine stdlib_claqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts, s,h, ldh, iloz, & + !> CLAQR5 called by CLAQR0 performs a + !> single small-bulge multi-shift QR sweep. ihiz, z, ldz, v, ldv, u, ldu, nv,wv, ldwv, nh, wh, ldwh ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -44789,9 +44789,9 @@ module stdlib_linalg_lapack_c end do loop_180 end subroutine stdlib_claqr5 - !> CLAQZ1: chases a 1x1 shift bulge in a matrix pencil down a single position pure subroutine stdlib_claqz1( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, qstart, & + !> CLAQZ1 chases a 1x1 shift bulge in a matrix pencil down a single position q, ldq, nz, zstart, z, ldz ) ! arguments logical(lk), intent( in ) :: ilq, ilz @@ -44843,9 +44843,9 @@ module stdlib_linalg_lapack_c end if end subroutine stdlib_claqz1 - !> CLAQZ3: Executes a single multishift QZ sweep pure subroutine stdlib_claqz3( ilschur, ilq, ilz, n, ilo, ihi, nshifts,nblock_desired, alpha,& + !> CLAQZ3 Executes a single multishift QZ sweep beta, a, lda, b, ldb,q, ldq, z, ldz, qc, ldqc, zc, ldzc, work,lwork, info ) ! function arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -45083,7 +45083,9 @@ module stdlib_linalg_lapack_c end if end subroutine stdlib_claqz3 - !> CLARGV: generates a vector of complex plane rotations with real + + pure subroutine stdlib_clargv( n, x, incx, y, incy, c, incc ) + !> CLARGV 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) ) @@ -45093,8 +45095,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_clargv( n, x, incx, y, incy, c, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45237,11 +45237,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clargv - !> CLARRV: 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. pure subroutine stdlib_clarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, & + !> CLARRV 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. rtol2, w, werr, wgap,iblock, indexw, gers, z, ldz, isuppz,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45887,7 +45887,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarrv - !> CLATDF: computes the contribution to the reciprocal Dif-estimate + + pure subroutine stdlib_clatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) + !> CLATDF 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 @@ -45895,8 +45897,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_clatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46001,7 +46001,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clatdf - !> CLAUNHR_COL_GETRFNP: computes the modified LU factorization without + + pure subroutine stdlib_claunhr_col_getrfnp( m, n, a, lda, d, info ) + !> CLAUNHR_COL_GETRFNP computes the modified LU factorization without !> pivoting of a complex general M-by-N matrix A. The factorization has !> the form: !> A - S = L * U, @@ -46034,8 +46036,6 @@ module stdlib_linalg_lapack_c !> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, !> E. Solomonik, J. Parallel Distrib. Comput., !> vol. 85, pp. 3-31, 2015. - - pure subroutine stdlib_claunhr_col_getrfnp( m, n, a, lda, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46095,14 +46095,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claunhr_col_getrfnp - !> CPBCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_cpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,rwork, info ) + !> CPBCON estimates the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite band matrix using !> the Cholesky factorization A = U**H*U or A = L*L**H computed by !> CPBTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_cpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46199,12 +46199,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpbcon - !> CPBRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_cpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & + !> CPBRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite !> and banded, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_cpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46397,14 +46397,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpbrfs - !> CPBTRF: computes the Cholesky factorization of a complex Hermitian + + pure subroutine stdlib_cpbtrf( uplo, n, kd, ab, ldab, info ) + !> CPBTRF computes the Cholesky factorization of a complex Hermitian !> positive definite band matrix A. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. - - pure subroutine stdlib_cpbtrf( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46597,11 +46597,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpbtrf - !> CPFTRS: solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A using the Cholesky factorization - !> A = U**H*U or A = L*L**H computed by CPFTRF. pure subroutine stdlib_cpftrs( transr, uplo, n, nrhs, a, b, ldb, info ) + !> CPFTRS solves a system of linear equations A*X = B with a Hermitian + !> positive definite matrix A using the Cholesky factorization + !> A = U**H*U or A = L*L**H computed by CPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46651,13 +46651,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpftrs - !> CPOCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_cpocon( uplo, n, a, lda, anorm, rcond, work, rwork,info ) + !> CPOCON estimates the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite matrix using the !> Cholesky factorization A = U**H*U or A = L*L**H computed by CPOTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_cpocon( uplo, n, a, lda, anorm, rcond, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46751,12 +46751,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpocon - !> CPORFS: improves the computed solution to a system of linear + + pure subroutine stdlib_cporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & + !> CPORFS improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite, !> and provides error bounds and backward error estimates for the !> solution. - - pure subroutine stdlib_cporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46944,15 +46944,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cporfs - !> CPOTRF: computes the Cholesky factorization of a complex Hermitian + + pure subroutine stdlib_cpotrf( uplo, n, a, lda, info ) + !> CPOTRF computes the Cholesky factorization of a complex Hermitian !> positive definite matrix A. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the block version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_cpotrf( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47039,11 +47039,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpotrf - !> CPOTRI: computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by CPOTRF. pure subroutine stdlib_cpotri( uplo, n, a, lda, info ) + !> CPOTRI computes the inverse of a complex Hermitian positive definite + !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !> computed by CPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47080,14 +47080,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpotri - !> CPPCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_cppcon( uplo, n, ap, anorm, rcond, work, rwork, info ) + !> CPPCON estimates the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite packed matrix using !> the Cholesky factorization A = U**H*U or A = L*L**H computed by !> CPPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_cppcon( uplo, n, ap, anorm, rcond, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47179,12 +47179,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cppcon - !> CPPRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_cpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & + !> CPPRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite !> and packed, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_cpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47375,7 +47375,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpprfs - !> CPPSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_cppsv( uplo, n, nrhs, ap, b, ldb, info ) + !> CPPSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite matrix stored in !> packed format and X and B are N-by-NRHS matrices. @@ -47385,8 +47387,6 @@ module stdlib_linalg_lapack_c !> where U is an upper triangular matrix and L is a lower triangular !> matrix. The factored form of A is then used to solve the system of !> equations A * X = B. - - pure subroutine stdlib_cppsv( uplo, n, nrhs, ap, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47424,15 +47424,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cppsv - !> CPPSVX: uses the Cholesky factorization A = U**H*U or A = L*L**H to + + subroutine stdlib_cppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& + !> CPPSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to !> compute the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite matrix stored in !> packed format and X and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_cppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47564,11 +47564,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cppsvx - !> CPPTRI: computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by CPPTRF. pure subroutine stdlib_cpptri( uplo, n, ap, info ) + !> CPPTRI computes the inverse of a complex Hermitian positive definite + !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !> computed by CPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47628,7 +47628,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpptri - !> CPTEQR: computes all eigenvalues and, optionally, eigenvectors of a + + pure subroutine stdlib_cpteqr( compz, n, d, e, z, ldz, work, info ) + !> CPTEQR computes all eigenvalues and, optionally, eigenvectors of a !> symmetric positive definite tridiagonal matrix by first factoring the !> matrix using SPTTRF and then calling CBDSQR to compute the singular !> values of the bidiagonal factor. @@ -47643,8 +47645,6 @@ module stdlib_linalg_lapack_c !> tridiagonal form, however, may preclude the possibility of obtaining !> high relative accuracy in the small eigenvalues of the original !> matrix, if these eigenvalues range over many orders of magnitude.) - - pure subroutine stdlib_cpteqr( compz, n, d, e, z, ldz, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47723,14 +47723,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpteqr - !> CPTTRS: solves a tridiagonal system of the form + + pure subroutine stdlib_cpttrs( uplo, n, nrhs, d, e, b, ldb, info ) + !> CPTTRS solves a tridiagonal system of the form !> A * X = B !> using the factorization A = U**H*D*U or A = L*D*L**H computed by CPTTRF. !> D is a diagonal matrix specified in the vector D, U (or L) is a unit !> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in !> the vector E, and X and B are N by NRHS matrices. - - pure subroutine stdlib_cpttrs( uplo, n, nrhs, d, e, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47790,13 +47790,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpttrs - !> CSPCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_cspcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) + !> CSPCON estimates the reciprocal of the condition number (in the !> 1-norm) of a complex symmetric packed matrix A using the !> factorization A = U*D*U**T or A = L*D*L**T computed by CSPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_cspcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47871,12 +47871,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cspcon - !> CSPRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_csprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& + !> CSPRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric indefinite !> and packed, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_csprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48068,7 +48068,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csprfs - !> CSPSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_cspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) + !> CSPSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix stored in packed format and X !> and B are N-by-NRHS matrices. @@ -48079,8 +48081,6 @@ module stdlib_linalg_lapack_c !> triangular matrices, D is symmetric 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. - - pure subroutine stdlib_cspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48119,14 +48119,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cspsv - !> CSPSVX: uses the diagonal pivoting factorization A = U*D*U**T or + + subroutine stdlib_cspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & + !> CSPSVX uses the diagonal pivoting factorization A = U*D*U**T or !> A = L*D*L**T to compute the solution to a complex system of linear !> equations A * X = B, where A is an N-by-N symmetric matrix stored !> in packed format and X and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_cspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48197,7 +48197,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cspsvx - !> CSTEMR: computes selected eigenvalues and, optionally, eigenvectors + + pure subroutine stdlib_cstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & + !> CSTEMR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has !> a well defined set of pairwise different real eigenvalues, the corresponding !> real eigenvectors are pairwise orthogonal. @@ -48256,8 +48258,6 @@ module stdlib_linalg_lapack_c !> Since LAPACK drivers overwrite the matrix data with the eigenvectors, !> CSTEMR accepts complex workspace to facilitate interoperability !> with CUNMTR or CUPMTR. - - pure subroutine stdlib_cstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48631,13 +48631,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cstemr - !> CSYCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_csycon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) + !> CSYCON estimates the reciprocal of the condition number (in the !> 1-norm) of a complex symmetric matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by CSYTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_csycon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48712,13 +48712,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csycon - !> CSYCON_ROOK: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_csycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) + !> CSYCON_ROOK estimates the reciprocal of the condition number (in the !> 1-norm) of a complex symmetric matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by CSYTRF_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))). - - pure subroutine stdlib_csycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48794,11 +48794,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csycon_rook - !> CSYRFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite, and - !> provides error bounds and backward error estimates for the solution. pure subroutine stdlib_csyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & + !> CSYRFS improves the computed solution to a system of linear + !> equations when the coefficient matrix is symmetric indefinite, and + !> provides error bounds and backward error estimates for the solution. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48987,7 +48987,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csyrfs - !> CSYSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_csysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) + !> CSYSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS !> matrices. @@ -48998,8 +49000,6 @@ module stdlib_linalg_lapack_c !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_csysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49065,7 +49065,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csysv - !> CSYSV_RK: computes the solution to a complex system of linear + + pure subroutine stdlib_csysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) + !> CSYSV_RK computes the solution to a complex system of linear !> equations A * X = B, where A is an N-by-N symmetric matrix !> and X and B are N-by-NRHS matrices. !> The bounded Bunch-Kaufman (rook) diagonal pivoting method is used @@ -49079,8 +49081,6 @@ module stdlib_linalg_lapack_c !> CSYTRF_RK is called to compute the factorization of a complex !> symmetric matrix. The factored form of A is then used to solve !> the system of equations A * X = B by calling BLAS3 routine CSYTRS_3. - - pure subroutine stdlib_csysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49141,7 +49141,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csysv_rk - !> CSYSV_ROOK: computes the solution to a complex system of linear + + pure subroutine stdlib_csysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) + !> CSYSV_ROOK computes the solution to a complex system of linear !> equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS @@ -49157,8 +49159,6 @@ module stdlib_linalg_lapack_c !> pivoting method. !> The factored form of A is then used to solve the system !> of equations A * X = B by calling CSYTRS_ROOK. - - pure subroutine stdlib_csysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49220,14 +49220,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csysv_rook - !> CSYSVX: uses the diagonal pivoting factorization to compute the + + subroutine stdlib_csysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & + !> CSYSVX uses the diagonal pivoting factorization to compute the !> solution to a complex system of linear equations A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS !> matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_csysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & ferr, berr, work, lwork,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49317,14 +49317,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csysvx - !> CTBCON: estimates the reciprocal of the condition number of a + + subroutine stdlib_ctbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,rwork, info ) + !> CTBCON estimates the reciprocal of the condition number of a !> triangular band matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_ctbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49426,11 +49426,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctbcon - !> CTFTRI: computes the inverse of a triangular matrix A stored in RFP - !> format. - !> This is a Level 3 BLAS version of the algorithm. pure subroutine stdlib_ctftri( transr, uplo, diag, n, a, info ) + !> CTFTRI computes the inverse of a triangular matrix A stored in RFP + !> format. + !> This is a Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49609,7 +49609,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctftri - !> CTGSJA: computes the generalized singular value decomposition (GSVD) + + pure subroutine stdlib_ctgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & + !> CTGSJA computes the generalized singular value decomposition (GSVD) !> of two complex upper triangular (or trapezoidal) matrices A and B. !> On entry, it is assumed that matrices A and B have the following !> forms, which may be obtained by the preprocessing subroutine CGGSVP @@ -49671,8 +49673,6 @@ module stdlib_linalg_lapack_c !> The computation of the unitary transformation matrices U, V or Q !> is optional. These matrices may either be formed explicitly, or they !> may be postmultiplied into input matrices U1, V1, or Q1. - - pure subroutine stdlib_ctgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & alpha, beta, u, ldu, v, ldv,q, ldq, work, ncycle, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49858,7 +49858,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctgsja - !> CTGSY2: solves the generalized Sylvester equation + + pure subroutine stdlib_ctgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & + !> CTGSY2 solves the generalized Sylvester equation !> A * R - L * B = scale * C (1) !> D * R - L * E = scale * F !> using Level 1 and 2 BLAS, where R and L are unknown M-by-N matrices, @@ -49883,8 +49885,6 @@ module stdlib_linalg_lapack_c !> of an upper bound on the separation between to matrix pairs. Then !> the input (A, D), (B, E) are sub-pencils of two matrix pairs in !> CTGSYL. - - pure subroutine stdlib_ctgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & ldf, scale, rdsum, rdscal,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50048,7 +50048,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctgsy2 - !> CTGSYL: solves the generalized Sylvester equation: + + pure subroutine stdlib_ctgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & + !> CTGSYL solves the generalized Sylvester equation: !> A * R - L * B = scale * C (1) !> D * R - L * E = scale * F !> where R and L are unknown m-by-n matrices, (A, D), (B, E) and @@ -50075,8 +50077,6 @@ module stdlib_linalg_lapack_c !> Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the !> reciprocal of the smallest singular value of Z. !> This is a level-3 BLAS algorithm. - - pure subroutine stdlib_ctgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50398,14 +50398,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctgsyl - !> CTPCON: estimates the reciprocal of the condition number of a packed + + subroutine stdlib_ctpcon( norm, uplo, diag, n, ap, rcond, work, rwork,info ) + !> CTPCON estimates the reciprocal of the condition number of a packed !> triangular matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_ctpcon( norm, uplo, diag, n, ap, rcond, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50502,12 +50502,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctpcon - !> CTPLQT: computes a blocked LQ factorization of a complex + + pure subroutine stdlib_ctplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) + !> CTPLQT computes a blocked LQ factorization of a complex !> "triangular-pentagonal" matrix C, which is composed of a !> triangular block A and pentagonal block B, using the compact !> WY representation for Q. - - pure subroutine stdlib_ctplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50564,11 +50564,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctplqt - !> CTPMLQT: applies a complex unitary matrix Q obtained from a - !> "triangular-pentagonal" complex block reflector H to a general - !> complex matrix C, which consists of two blocks A and B. pure subroutine stdlib_ctpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, ldb, & + !> CTPMLQT applies a complex unitary matrix Q obtained from a + !> "triangular-pentagonal" complex block reflector H to a general + !> complex matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50682,11 +50682,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctpmlqt - !> CTPMQRT: applies a complex orthogonal matrix Q obtained from a - !> "triangular-pentagonal" complex block reflector H to a general - !> complex matrix C, which consists of two blocks A and B. pure subroutine stdlib_ctpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, ldb, & + !> CTPMQRT applies a complex orthogonal matrix Q obtained from a + !> "triangular-pentagonal" complex block reflector H to a general + !> complex matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50802,12 +50802,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctpmqrt - !> CTPQRT: computes a blocked QR factorization of a complex + + pure subroutine stdlib_ctpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) + !> CTPQRT computes a blocked QR factorization of a complex !> "triangular-pentagonal" matrix C, which is composed of a !> triangular block A and pentagonal block B, using the compact !> WY representation for Q. - - pure subroutine stdlib_ctpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50864,14 +50864,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctpqrt - !> CTRCON: estimates the reciprocal of the condition number of a + + subroutine stdlib_ctrcon( norm, uplo, diag, n, a, lda, rcond, work,rwork, info ) + !> CTRCON estimates the reciprocal of the condition number of a !> triangular matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_ctrcon( norm, uplo, diag, n, a, lda, rcond, work,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50970,15 +50970,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrcon - !> CTRSYL: solves the complex Sylvester matrix equation: + + subroutine stdlib_ctrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) + !> CTRSYL solves the complex Sylvester matrix equation: !> op(A)*X + X*op(B) = scale*C or !> op(A)*X - X*op(B) = scale*C, !> where op(A) = A or A**H, and A and B are both upper triangular. A is !> M-by-M and B is N-by-N; the right hand side C and the solution X are !> M-by-N; and scale is an output scale factor, set <= 1 to avoid !> overflow in X. - - subroutine stdlib_ctrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51196,7 +51196,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrsyl - !> CUNBDB5: orthogonalizes the column vector + + pure subroutine stdlib_cunbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & + !> CUNBDB5 orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] !> with respect to the columns of @@ -51207,8 +51209,6 @@ module stdlib_linalg_lapack_c !> criterion, then some other vector from the orthogonal complement !> is returned. This vector is chosen in an arbitrary but deterministic !> way. - - pure subroutine stdlib_cunbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51295,7 +51295,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunbdb5 - !> CUNCSD: computes the CS decomposition of an M-by-M partitioned + + recursive subroutine stdlib_cuncsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & + !> CUNCSD computes the CS decomposition of an M-by-M partitioned !> unitary matrix X: !> [ I 0 0 | 0 0 0 ] !> [ 0 C 0 | 0 -S 0 ] @@ -51308,8 +51310,6 @@ module stdlib_linalg_lapack_c !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in !> which R = MIN(P,M-P,Q,M-Q). - - recursive subroutine stdlib_cuncsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, ldv1t, v2t,ldv2t, & work, lwork, rwork, lrwork,iwork, info ) ! -- lapack computational routine -- @@ -51585,12 +51585,12 @@ module stdlib_linalg_lapack_c ! end stdlib_cuncsd end subroutine stdlib_cuncsd - !> CUNGHR: generates a complex unitary matrix Q which is defined as the + + pure subroutine stdlib_cunghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) + !> CUNGHR generates a complex unitary matrix Q which is defined as the !> product of IHI-ILO elementary reflectors of order N, as returned by !> CGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - - pure subroutine stdlib_cunghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51675,13 +51675,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunghr - !> CUNGTR: generates a complex unitary matrix Q which is defined as the + + pure subroutine stdlib_cungtr( uplo, n, a, lda, tau, work, lwork, info ) + !> CUNGTR generates a complex unitary matrix Q which is defined as the !> product of n-1 elementary reflectors of order N, as returned by !> CHETRD: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - - pure subroutine stdlib_cungtr( uplo, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51776,7 +51776,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungtr - !> CUNHR_COL: takes an M-by-N complex matrix Q_in with orthonormal columns + + pure subroutine stdlib_cunhr_col( m, n, nb, a, lda, t, ldt, d, info ) + !> CUNHR_COL takes an M-by-N complex matrix Q_in with orthonormal columns !> as input, stored in A, and performs Householder Reconstruction (HR), !> i.e. reconstructs Householder vectors V(i) implicitly representing !> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, @@ -51785,8 +51787,6 @@ module stdlib_linalg_lapack_c !> stored in A on output, and the diagonal entries of S are stored in D. !> Block reflectors are also returned in T !> (same output format as CGEQRT). - - pure subroutine stdlib_cunhr_col( m, n, nb, a, lda, t, ldt, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51913,7 +51913,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunhr_col - !> CUNMHR: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_cunmhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & + !> CUNMHR 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 @@ -51921,8 +51923,6 @@ module stdlib_linalg_lapack_c !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of !> IHI-ILO elementary reflectors, as returned by CGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - - pure subroutine stdlib_cunmhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52012,7 +52012,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmhr - !> CUNMTR: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_cunmtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & + !> CUNMTR 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 @@ -52021,8 +52023,6 @@ module stdlib_linalg_lapack_c !> nq-1 elementary reflectors, as returned by CHETRD: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - - pure subroutine stdlib_cunmtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52128,13 +52128,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmtr - !> CUPGTR: generates a complex unitary matrix Q which is defined as the + + pure subroutine stdlib_cupgtr( uplo, n, ap, tau, q, ldq, work, info ) + !> CUPGTR generates a complex unitary matrix Q which is defined as the !> product of n-1 elementary reflectors H(i) of order n, as returned by !> CHPTRD using packed storage: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - - pure subroutine stdlib_cupgtr( uplo, n, ap, tau, q, ldq, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52215,7 +52215,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cupgtr - !> CUPMTR: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_cupmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) + !> CUPMTR 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 @@ -52225,8 +52227,6 @@ module stdlib_linalg_lapack_c !> storage: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - - pure subroutine stdlib_cupmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52372,12 +52372,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cupmtr - !> CGBBRD: reduces a complex general m-by-n band matrix A to real upper + + pure subroutine stdlib_cgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & + !> CGBBRD 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. - - pure subroutine stdlib_cgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & ldc, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52649,11 +52649,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgbbrd - !> CGBRFS: 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. pure subroutine stdlib_cgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, x, & + !> CGBRFS 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. ldx, ferr, berr, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52855,7 +52855,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgbrfs - !> CGBSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_cgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) + !> CGBSV 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 @@ -52863,8 +52865,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_cgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52907,14 +52907,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgbsv - !> CGBSVX: uses the LU factorization to compute the solution to a complex + + subroutine stdlib_cgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & + !> CGBSVX uses the LU factorization to compute the solution to a complex !> system of linear equations A * X = B, A**T * X = B, or A**H * 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. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_cgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & c, b, ldb, x, ldx,rcond, ferr, berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53134,11 +53134,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgbsvx - !> CGEBRD: 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. pure subroutine stdlib_cgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) + !> CGEBRD 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53241,10 +53241,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgebrd - !> CGEHRD: reduces a complex general matrix A to upper Hessenberg form H by - !> an unitary similarity transformation: Q**H * A * Q = H . pure subroutine stdlib_cgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info ) + !> CGEHRD reduces a complex general matrix A to upper Hessenberg form H by + !> an unitary similarity transformation: Q**H * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53371,10 +53371,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgehrd - !> CGELQT: computes a blocked LQ factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. pure subroutine stdlib_cgelqt( m, n, mb, a, lda, t, ldt, work, info ) + !> CGELQT computes a blocked LQ factorization of a complex M-by-N matrix A + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53422,7 +53422,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelqt - !> CGELS: solves overdetermined or underdetermined complex linear systems + + subroutine stdlib_cgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) + !> CGELS 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: @@ -53440,8 +53442,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_cgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53640,10 +53640,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgels - !> CGEQP3: computes a QR factorization with column pivoting of a - !> matrix A: A*P = Q*R using Level 3 BLAS. pure subroutine stdlib_cgeqp3( m, n, a, lda, jpvt, tau, work, lwork, rwork,info ) + !> CGEQP3 computes a QR factorization with column pivoting of a + !> matrix A: A*P = Q*R using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53792,10 +53792,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeqp3 - !> CGEQRT: computes a blocked QR factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. pure subroutine stdlib_cgeqrt( m, n, nb, a, lda, t, ldt, work, info ) + !> CGEQRT computes a blocked QR factorization of a complex M-by-N matrix A + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53849,11 +53849,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeqrt - !> CGERFS: improves the computed solution to a system of linear - !> equations and provides error bounds and backward error estimates for - !> the solution. pure subroutine stdlib_cgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & + !> CGERFS improves the computed solution to a system of linear + !> equations and provides error bounds and backward error estimates for + !> the solution. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54046,7 +54046,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgerfs - !> CGETRF: computes an LU factorization of a general M-by-N matrix A + + pure subroutine stdlib_cgetrf( m, n, a, lda, ipiv, info ) + !> CGETRF 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 @@ -54054,8 +54056,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_cgetrf( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54124,7 +54124,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgetrf - !> CGGGLM: solves a general Gauss-Markov linear model (GLM) problem: + + pure subroutine stdlib_cggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) + !> CGGGLM 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 @@ -54142,8 +54144,6 @@ module stdlib_linalg_lapack_c !> minimize || inv(B)*(d-A*x) ||_2 !> x !> where inv(B) denotes the inverse of B. - - pure subroutine stdlib_cggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54260,7 +54260,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cggglm - !> CGGHD3: reduces a pair of complex matrices (A,B) to generalized upper + + pure subroutine stdlib_cgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & + !> CGGHD3 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 @@ -54285,8 +54287,6 @@ module stdlib_linalg_lapack_c !> problem to generalized Hessenberg form. !> This is a blocked variant of CGGHRD, using matrix-matrix !> multiplications for parts of the computation to enhance performance. - - pure subroutine stdlib_cgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54790,7 +54790,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgghd3 - !> CGGLSE: solves the linear equality-constrained least squares (LSE) + + pure subroutine stdlib_cgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) + !> CGGLSE 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 @@ -54802,8 +54804,6 @@ module stdlib_linalg_lapack_c !> which is obtained using a generalized RQ factorization of the !> matrices (B, A) given by !> B = (0 R)*Q, A = Z*T*Q. - - pure subroutine stdlib_cgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54922,13 +54922,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgglse - !> CGTCON: estimates the reciprocal of the condition number of a complex + + pure subroutine stdlib_cgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, info ) + !> CGTCON 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))). - - pure subroutine stdlib_cgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55006,11 +55006,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgtcon - !> CGTRFS: 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. pure subroutine stdlib_cgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, x, & + !> CGTRFS 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. ldx, ferr, berr, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55213,14 +55213,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgtrfs - !> CGTSVX: uses the LU factorization to compute the solution to a complex + + pure subroutine stdlib_cgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & + !> CGTSVX uses the LU factorization to compute the solution to a complex !> system of linear equations A * X = B, A**T * X = B, or A**H * X = B, !> where A is a tridiagonal matrix of order N and X and B are N-by-NRHS !> matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - pure subroutine stdlib_cgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & ldb, x, ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55301,15 +55301,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgtsvx - !> CHBGST: reduces a complex Hermitian-definite banded generalized + + pure subroutine stdlib_chbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, rwork,& + !> CHBGST 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. - - pure subroutine stdlib_chbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, rwork,& info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56233,11 +56233,11 @@ module stdlib_linalg_lapack_c go to 490 end subroutine stdlib_chbgst - !> CHBTRD: reduces a complex Hermitian band matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. pure subroutine stdlib_chbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) + !> CHBTRD reduces a complex Hermitian band matrix A to real symmetric + !> tridiagonal form T by a unitary similarity transformation: + !> Q**H * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56597,13 +56597,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chbtrd - !> CHECON: estimates the reciprocal of the condition number of a complex + + pure subroutine stdlib_checon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) + !> CHECON 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))). - - pure subroutine stdlib_checon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56678,13 +56678,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_checon - !> CHECON_ROOK: estimates the reciprocal of the condition number of a complex + + pure subroutine stdlib_checon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) + !> CHECON_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))). - - pure subroutine stdlib_checon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56759,10 +56759,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_checon_rook - !> CHEEV: computes all eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix A. subroutine stdlib_cheev( jobz, uplo, n, a, lda, w, work, lwork, rwork,info ) + !> CHEEV computes all eigenvalues and, optionally, eigenvectors of a + !> complex Hermitian matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56870,7 +56870,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cheev - !> CHEEVR: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_cheevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> CHEEVR 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. @@ -56920,8 +56922,6 @@ module stdlib_linalg_lapack_c !> hence may abort due to a floating point exception in environments !> which do not handle NaNs and infinities in the ieee standard default !> manner. - - subroutine stdlib_cheevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & isuppz, work, lwork,rwork, lrwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57209,12 +57209,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cheevr - !> CHEEVX: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_cheevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> CHEEVX 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. - - subroutine stdlib_cheevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & work, lwork, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57456,13 +57456,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cheevx - !> CHEGV: computes all the eigenvalues, and optionally, the eigenvectors + + subroutine stdlib_chegv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, info ) + !> CHEGV 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. - - subroutine stdlib_chegv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57557,14 +57557,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chegv - !> CHEGVX: computes selected eigenvalues, and optionally, eigenvectors + + subroutine stdlib_chegvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& + !> CHEGVX computes selected eigenvalues, and optionally, 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. !> Eigenvalues and eigenvectors can be selected by specifying either a !> range of values or a range of indices for the desired eigenvalues. - - subroutine stdlib_chegvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& m, w, z, ldz, work,lwork, rwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57685,11 +57685,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chegvx - !> CHERFS: 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. pure subroutine stdlib_cherfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & + !> CHERFS 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. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57878,7 +57878,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cherfs - !> CHESV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_chesv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) + !> CHESV 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. @@ -57889,8 +57891,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_chesv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57956,7 +57956,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chesv - !> CHESV_RK: computes the solution to a complex system of linear + + pure subroutine stdlib_chesv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) + !> CHESV_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 @@ -57970,8 +57972,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_chesv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58032,7 +58032,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chesv_rk - !> CHESV_ROOK: computes the solution to a complex system of linear equations + + pure subroutine stdlib_chesv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) + !> CHESV_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. @@ -58048,8 +58050,6 @@ module stdlib_linalg_lapack_c !> 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). - - pure subroutine stdlib_chesv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58111,14 +58111,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chesv_rook - !> CHESVX: uses the diagonal pivoting factorization to compute the + + subroutine stdlib_chesvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & + !> CHESVX uses the diagonal pivoting factorization to compute 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. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_chesvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & ferr, berr, work, lwork,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58208,7 +58208,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chesvx - !> CHGEQZ: computes the eigenvalues of a complex matrix pair (H,T), + + subroutine stdlib_chgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alpha, beta, q, ldq,& + !> CHGEQZ 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 @@ -58241,8 +58243,6 @@ module stdlib_linalg_lapack_c !> Ref: C.B. Moler !> Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973), !> pp. 241--256. - - subroutine stdlib_chgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alpha, beta, q, ldq,& z, ldz, work, lwork,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58708,13 +58708,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chgeqz - !> CHPCON: estimates the reciprocal of the condition number of a complex + + pure subroutine stdlib_chpcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) + !> CHPCON 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))). - - pure subroutine stdlib_chpcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58789,10 +58789,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpcon - !> CHPEV: computes all the eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix in packed storage. subroutine stdlib_chpev( jobz, uplo, n, ap, w, z, ldz, work, rwork,info ) + !> CHPEV computes all the eigenvalues and, optionally, eigenvectors of a + !> complex Hermitian matrix in packed storage. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58886,12 +58886,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpev - !> CHPEVX: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_chpevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> CHPEVX computes selected eigenvalues and, optionally, eigenvectors !> of a complex Hermitian matrix A in packed storage. !> Eigenvalues/vectors can be selected by specifying either a range of !> values or a range of indices for the desired eigenvalues. - - subroutine stdlib_chpevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & work, rwork, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59103,13 +59103,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpevx - !> CHPGV: computes all the eigenvalues and, optionally, the eigenvectors + + subroutine stdlib_chpgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,rwork, info ) + !> CHPGV 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. - - subroutine stdlib_chpgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59188,15 +59188,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpgv - !> CHPGVX: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_chpgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & + !> CHPGVX computes selected eigenvalues and, optionally, 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. Eigenvalues and eigenvectors can be selected by !> specifying either a range of values or a range of indices for the !> desired eigenvalues. - - subroutine stdlib_chpgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & z, ldz, work, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59300,12 +59300,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpgvx - !> CHPRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_chprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& + !> CHPRFS 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. - - pure subroutine stdlib_chprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59497,7 +59497,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chprfs - !> CHPSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_chpsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) + !> CHPSV 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. @@ -59508,8 +59510,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_chpsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59548,14 +59548,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpsv - !> CHPSVX: uses the diagonal pivoting factorization A = U*D*U**H or + + subroutine stdlib_chpsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & + !> CHPSVX uses the diagonal pivoting factorization A = U*D*U**H or !> A = L*D*L**H to compute 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. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_chpsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59626,14 +59626,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpsvx - !> CHSEIN: uses inverse iteration to find specified right and/or left + + subroutine stdlib_chsein( side, eigsrc, initv, select, n, h, ldh, w, vl,ldvl, vr, ldvr, mm, & + !> CHSEIN 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. - - subroutine stdlib_chsein( side, eigsrc, initv, select, n, h, ldh, w, vl,ldvl, vr, ldvr, mm, & m, work, rwork, ifaill,ifailr, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59800,12 +59800,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chsein + + pure subroutine stdlib_claed0( qsiz, n, d, e, q, ldq, qstore, ldqs, rwork,iwork, info ) !> Using the divide and conquer method, CLAED0: 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. - - pure subroutine stdlib_claed0( qsiz, n, d, e, q, ldq, qstore, ldqs, rwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59978,15 +59978,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claed0 - !> CLAMSWLQ: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_clamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & + !> CLAMSWLQ 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) - - pure subroutine stdlib_clamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60136,15 +60136,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clamswlq - !> CLAMTSQR: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_clamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & + !> CLAMTSQR 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) - - pure subroutine stdlib_clamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60298,7 +60298,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clamtsqr - !> CLAQR2: is identical to CLAQR3 except that it avoids + + pure subroutine stdlib_claqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & + !> CLAQR2 is identical to CLAQR3 except that it avoids !> recursion by calling CLAHQR instead of CLAQR4. !> Aggressive early deflation: !> This subroutine accepts as input an upper Hessenberg matrix @@ -60309,8 +60311,6 @@ module stdlib_linalg_lapack_c !> an unitary similarity transformation of H. It is to be !> hoped that the final version of H has many zero subdiagonal !> entries. - - pure subroutine stdlib_claqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & ns, nd, sh, v, ldv, nh, t, ldt,nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60512,7 +60512,9 @@ module stdlib_linalg_lapack_c work( 1 ) = cmplx( lwkopt, 0,KIND=sp) end subroutine stdlib_claqr2 - !> CLASWLQ: computes a blocked Tall-Skinny LQ factorization of + + pure subroutine stdlib_claswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) + !> CLASWLQ computes a blocked Tall-Skinny LQ factorization of !> a complex M-by-N matrix A for M <= N: !> A = ( L 0 ) * Q, !> where: @@ -60522,8 +60524,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_claswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -60596,7 +60596,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claswlq - !> CLATSQR: computes a blocked Tall-Skinny QR factorization of + + pure subroutine stdlib_clatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) + !> CLATSQR computes a blocked Tall-Skinny QR factorization of !> a complex M-by-N matrix A for M >= N: !> A = Q * ( R ), !> ( 0 ) @@ -60607,8 +60609,6 @@ module stdlib_linalg_lapack_c !> R is an upper-triangular N-by-N matrix, stored on exit in !> the elements on and above the diagonal of the array A. !> 0 is a (M-N)-by-N zero matrix, and is not stored. - - pure subroutine stdlib_clatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -60681,7 +60681,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clatsqr - !> CPBSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_cpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) + !> CPBSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite band matrix and X !> and B are N-by-NRHS matrices. @@ -60692,8 +60694,6 @@ module stdlib_linalg_lapack_c !> triangular band matrix, with the same number of superdiagonals or !> subdiagonals as A. The factored form of A is then used to solve the !> system of equations A * X = B. - - pure subroutine stdlib_cpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60735,15 +60735,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpbsv - !> CPBSVX: uses the Cholesky factorization A = U**H*U or A = L*L**H to + + subroutine stdlib_cpbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & + !> CPBSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to !> compute the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite band matrix and X !> and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_cpbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60892,15 +60892,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpbsvx - !> CPFTRF: computes the Cholesky factorization of a complex Hermitian + + pure subroutine stdlib_cpftrf( transr, uplo, n, a, info ) + !> CPFTRF computes the Cholesky factorization of a complex Hermitian !> positive definite matrix A. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the block version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_cpftrf( transr, uplo, n, a, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61068,11 +61068,11 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpftrf - !> CPFTRI: computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by CPFTRF. pure subroutine stdlib_cpftri( transr, uplo, n, a, info ) + !> CPFTRI computes the inverse of a complex Hermitian positive definite + !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !> computed by CPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61227,7 +61227,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpftri - !> CPOSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_cposv( uplo, n, nrhs, a, lda, b, ldb, info ) + !> CPOSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite matrix and X and B !> are N-by-NRHS matrices. @@ -61237,8 +61239,6 @@ module stdlib_linalg_lapack_c !> where U is an upper triangular matrix and L is a lower triangular !> matrix. The factored form of A is then used to solve the system of !> equations A * X = B. - - pure subroutine stdlib_cposv( uplo, n, nrhs, a, lda, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61278,15 +61278,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cposv - !> CPOSVX: uses the Cholesky factorization A = U**H*U or A = L*L**H to + + subroutine stdlib_cposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & + !> CPOSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to !> compute the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite matrix and X and B !> are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_cposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & rcond, ferr, berr, work,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61422,12 +61422,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cposvx - !> CPTRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_cptrfs( uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx,ferr, berr, work, & + !> CPTRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite !> and tridiagonal, and provides error bounds and backward error !> estimates for the solution. - - pure subroutine stdlib_cptrfs( uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx,ferr, berr, work, & rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61640,13 +61640,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cptrfs - !> CPTSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_cptsv( n, nrhs, d, e, b, ldb, info ) + !> CPTSV computes the solution to a complex system of linear equations !> A*X = B, where A is an N-by-N Hermitian positive definite tridiagonal !> matrix, and X and B are N-by-NRHS matrices. !> A is factored as A = L*D*L**H, and the factored form of A is then !> used to solve the system of equations. - - pure subroutine stdlib_cptsv( n, nrhs, d, e, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61682,14 +61682,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cptsv - !> CPTSVX: uses the factorization A = L*D*L**H to compute the solution + + pure subroutine stdlib_cptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& + !> CPTSVX uses the factorization A = L*D*L**H to compute the solution !> to a complex system of linear equations A*X = B, where A is an !> N-by-N Hermitian positive definite tridiagonal matrix and X and B !> are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - pure subroutine stdlib_cptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61759,7 +61759,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cptsvx - !> CSTEDC: computes all eigenvalues and, optionally, eigenvectors of a + + pure subroutine stdlib_cstedc( compz, n, d, e, z, ldz, work, lwork, rwork,lrwork, iwork, & + !> CSTEDC computes all eigenvalues and, optionally, eigenvectors of a !> symmetric tridiagonal matrix using the divide and conquer method. !> The eigenvectors of a full or band complex Hermitian matrix can also !> be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this @@ -61770,8 +61772,6 @@ module stdlib_linalg_lapack_c !> 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 SLAED3 for details. - - pure subroutine stdlib_cstedc( compz, n, d, e, z, ldz, work, lwork, rwork,lrwork, iwork, & liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61973,7 +61973,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cstedc - !> CSTEGR: computes selected eigenvalues and, optionally, eigenvectors + + pure subroutine stdlib_cstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> CSTEGR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has !> a well defined set of pairwise different real eigenvalues, the corresponding !> real eigenvectors are pairwise orthogonal. @@ -61989,8 +61991,6 @@ module stdlib_linalg_lapack_c !> NaNs. Normal execution may create these exceptiona values and hence !> may abort due to a floating point exception in environments which !> do not conform to the IEEE-754 standard. - - pure subroutine stdlib_cstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62015,7 +62015,9 @@ module stdlib_linalg_lapack_c tryrac, work, lwork,iwork, liwork, info ) end subroutine stdlib_cstegr - !> CTGSEN: reorders the generalized Schur decomposition of a complex + + pure subroutine stdlib_ctgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alpha, beta, q, & + !> CTGSEN reorders the generalized Schur decomposition of a complex !> matrix pair (A, B) (in terms of an unitary equivalence trans- !> formation Q**H * (A, B) * Z), so that a selected cluster of eigenvalues !> appears in the leading diagonal blocks of the pair (A,B). The leading @@ -62033,8 +62035,6 @@ module stdlib_linalg_lapack_c !> the selected cluster and the eigenvalues outside the cluster, resp., !> and norms of "projections" onto left and right eigenspaces w.r.t. !> the selected cluster in the (1,1)-block. - - pure subroutine stdlib_ctgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alpha, beta, q, & ldq, z, ldz, m, pl, pr, dif,work, lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62294,12 +62294,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctgsen - !> CTGSNA: estimates reciprocal condition numbers for specified + + pure subroutine stdlib_ctgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & + !> CTGSNA estimates reciprocal condition numbers for specified !> eigenvalues and/or eigenvectors of a matrix pair (A, B). !> (A, B) must be in generalized Schur canonical form, that is, A and !> B are both upper triangular. - - pure subroutine stdlib_ctgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & dif, mm, m, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62451,15 +62451,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctgsna - !> CTRSEN: reorders the Schur factorization of a complex matrix + + subroutine stdlib_ctrsen( job, compq, select, n, t, ldt, q, ldq, w, m, s,sep, work, lwork, & + !> CTRSEN reorders the Schur factorization of a complex matrix !> A = Q*T*Q**H, so that a selected cluster of eigenvalues appears in !> the leading positions on the diagonal of the upper triangular matrix !> T, and the leading columns of Q form an orthonormal basis of the !> corresponding right invariant subspace. !> Optionally the routine computes the reciprocal condition numbers of !> the cluster of eigenvalues and/or the invariant subspace. - - subroutine stdlib_ctrsen( job, compq, select, n, t, ldt, q, ldq, w, m, s,sep, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62588,7 +62588,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrsen - !> CUNBDB1: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_cunbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> CUNBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -62603,8 +62605,6 @@ module stdlib_linalg_lapack_c !> Householder vectors. !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by !> angles THETA, PHI. - - subroutine stdlib_cunbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62693,7 +62693,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunbdb1 - !> CUNBDB2: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_cunbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> CUNBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -62708,8 +62710,6 @@ module stdlib_linalg_lapack_c !> Householder vectors. !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by !> angles THETA, PHI. - - subroutine stdlib_cunbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62808,7 +62808,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunbdb2 - !> CUNBDB3: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_cunbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> CUNBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -62823,8 +62825,6 @@ module stdlib_linalg_lapack_c !> Householder vectors. !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_cunbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62922,7 +62922,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunbdb3 - !> CUNBDB4: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_cunbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> CUNBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -62937,8 +62939,6 @@ module stdlib_linalg_lapack_c !> Householder vectors. !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_cunbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63071,7 +63071,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunbdb4 - !> CUNCSD2BY1: computes the CS decomposition of an M-by-Q matrix X with + + subroutine stdlib_cuncsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & + !> CUNCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with !> orthonormal columns that has been partitioned into a 2-by-1 block !> structure: !> [ I1 0 0 ] @@ -63086,8 +63088,6 @@ module stdlib_linalg_lapack_c !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). - - subroutine stdlib_cuncsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, rwork, lrwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63508,7 +63508,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cuncsd2by1 - !> CUNGBR: generates one of the complex unitary matrices Q or P**H + + pure subroutine stdlib_cungbr( vect, m, n, k, a, lda, tau, work, lwork, info ) + !> CUNGBR generates one of the complex unitary matrices Q or P**H !> determined by CGEBRD when reducing a complex matrix A to bidiagonal !> form: A = Q * B * P**H. Q and P**H are defined as products of !> elementary reflectors H(i) or G(i) respectively. @@ -63524,8 +63526,6 @@ module stdlib_linalg_lapack_c !> rows of P**H, where n >= m >= k; !> if k >= n, P**H = G(n-1) . . . G(2) G(1) and CUNGBR returns P**H as !> an N-by-N matrix. - - pure subroutine stdlib_cungbr( vect, m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63657,13 +63657,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungbr - !> CUNGTSQR: generates an M-by-N complex matrix Q_out with orthonormal + + pure subroutine stdlib_cungtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) + !> CUNGTSQR generates an M-by-N complex matrix Q_out with orthonormal !> columns, which are the first N columns of a product of comlpex unitary !> matrices of order M which are returned by CLATSQR !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). !> See the documentation for CLATSQR. - - pure subroutine stdlib_cungtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63755,6 +63755,8 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungtsqr + + pure subroutine stdlib_cunmbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & !> If VECT = 'Q', CUNMBR: overwrites the general complex M-by-N matrix C !> with !> SIDE = 'L' SIDE = 'R' @@ -63777,8 +63779,6 @@ module stdlib_linalg_lapack_c !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: !> if k < nq, P = G(1) G(2) . . . G(k); !> if k >= nq, P = G(1) G(2) . . . G(nq-1). - - pure subroutine stdlib_cunmbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63916,14 +63916,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmbr - !> CGELQ: computes an LQ factorization of a complex M-by-N matrix A: + + pure subroutine stdlib_cgelq( m, n, a, lda, t, tsize, work, lwork,info ) + !> CGELQ 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. - - pure subroutine stdlib_cgelq( m, n, a, lda, t, tsize, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -64041,7 +64041,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelq - !> CGELSD: computes the minimum-norm solution to a real linear least + + subroutine stdlib_cgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & + !> CGELSD 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 @@ -64066,8 +64068,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_cgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64379,7 +64379,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelsd - !> CGELSS: computes the minimum norm solution to a complex linear + + subroutine stdlib_cgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & + !> CGELSS 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 @@ -64391,8 +64393,6 @@ module stdlib_linalg_lapack_c !> The effective rank of A is determined by treating as zero those !> singular values which are less than RCOND times the largest singular !> value. - - subroutine stdlib_cgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64837,7 +64837,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelss - !> CGELSY: computes the minimum-norm solution to a complex linear least + + subroutine stdlib_cgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, rwork, & + !> CGELSY 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 @@ -64869,8 +64871,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_cgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, rwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65062,15 +65062,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelsy - !> CGEMLQ: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_cgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & + !> CGEMLQ 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) - - pure subroutine stdlib_cgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65159,15 +65159,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgemlq - !> CGEMQR: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_cgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & + !> CGEMQR 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) - - pure subroutine stdlib_cgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65256,15 +65256,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgemqr - !> CGEQR: computes a QR factorization of a complex M-by-N matrix A: + + pure subroutine stdlib_cgeqr( m, n, a, lda, t, tsize, work, lwork,info ) + !> CGEQR 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. - - pure subroutine stdlib_cgeqr( m, n, a, lda, t, tsize, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -65371,7 +65371,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeqr - !> CGESDD: computes the singular value decomposition (SVD) of a complex + + subroutine stdlib_cgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, iwork, & + !> CGESDD 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) @@ -65388,8 +65390,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_cgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, iwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66866,7 +66866,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgesdd - !> CGESV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_cgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) + !> CGESV 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 @@ -66875,8 +66877,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_cgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -66914,7 +66914,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgesv - !> CGESVD: computes the singular value decomposition (SVD) of a complex + + subroutine stdlib_cgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, & + !> CGESVD 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) @@ -66925,8 +66927,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_cgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69361,7 +69361,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgesvd - !> CGESVDQ: computes the singular value decomposition (SVD) of a complex + + subroutine stdlib_cgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & + !> CGESVDQ 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] @@ -69370,8 +69372,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_cgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & numrank, iwork, liwork,cwork, lcwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -70240,14 +70240,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgesvdq - !> CGESVX: uses the LU factorization to compute the solution to a complex + + subroutine stdlib_cgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & + !> CGESVX uses the LU factorization to compute 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. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_cgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & x, ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70445,7 +70445,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgesvx - !> CGETSLS: solves overdetermined or underdetermined complex linear systems + + subroutine stdlib_cgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) + !> CGETSLS 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: @@ -70463,8 +70465,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_cgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -70682,7 +70682,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgetsls - !> CGETSQRHRT: computes a NB2-sized column blocked QR-factorization + + pure subroutine stdlib_cgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) + !> CGETSQRHRT 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 @@ -70694,8 +70696,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_cgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70815,7 +70815,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgetsqrhrt - !> CGGES: computes for a pair of N-by-N complex nonsymmetric matrices + + subroutine stdlib_cgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alpha, beta, & + !> CGGES 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 @@ -70835,8 +70837,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_cgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alpha, beta, & vsl, ldvsl, vsr, ldvsr, work,lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71067,7 +71067,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgges - !> CGGESX: computes for a pair of N-by-N complex nonsymmetric matrices + + subroutine stdlib_cggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, alpha,& + !> CGGESX computes for a pair of N-by-N complex nonsymmetric matrices !> (A,B), the generalized eigenvalues, the complex Schur form (S,T), !> and, optionally, the left and/or right matrices of Schur vectors (VSL !> and VSR). This gives the generalized Schur factorization @@ -71089,8 +71091,6 @@ module stdlib_linalg_lapack_c !> A pair of matrices (S,T) is in generalized complex Schur form if T is !> upper triangular with non-negative diagonal and S is upper !> triangular. - - subroutine stdlib_cggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, alpha,& beta, vsl, ldvsl, vsr,ldvsr, rconde, rcondv, work, lwork, rwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- @@ -71377,7 +71377,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cggesx - !> CGGEV: computes for a pair of N-by-N complex nonsymmetric matrices + + subroutine stdlib_cggev( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & + !> CGGEV 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 @@ -71392,8 +71394,6 @@ module stdlib_linalg_lapack_c !> 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). - - subroutine stdlib_cggev( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71647,7 +71647,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cggev - !> CGGEVX: computes for a pair of N-by-N complex nonsymmetric matrices + + subroutine stdlib_cggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alpha, beta, vl, & + !> CGGEVX 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. !> Optionally, it also computes a balancing transformation to improve @@ -71667,8 +71669,6 @@ module stdlib_linalg_lapack_c !> 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). - - subroutine stdlib_cggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alpha, beta, vl, & ldvl, vr, ldvr, ilo, ihi,lscale, rscale, abnrm, bbnrm, rconde, rcondv,work, lwork, rwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -71995,10 +71995,10 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cggevx - !> CHBEV: computes all the eigenvalues and, optionally, eigenvectors of - !> a complex Hermitian band matrix A. subroutine stdlib_chbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,rwork, info ) + !> CHBEV computes all the eigenvalues and, optionally, eigenvectors of + !> a complex Hermitian band matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72099,7 +72099,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chbev - !> CHBEVD: computes all the eigenvalues and, optionally, eigenvectors of + + subroutine stdlib_chbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, rwork, lrwork, & + !> CHBEVD 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 @@ -72108,8 +72110,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_chbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, rwork, lrwork, & iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72249,12 +72249,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chbevd - !> CHBEVX: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_chbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & + !> CHBEVX computes selected eigenvalues and, optionally, eigenvectors !> of a complex Hermitian band matrix A. Eigenvalues and eigenvectors !> can be selected by specifying either a range of values or a range of !> indices for the desired eigenvalues. - - subroutine stdlib_chbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & m, w, z, ldz, work, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72480,12 +72480,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chbevx - !> CHBGV: computes all the eigenvalues, and optionally, the eigenvectors + + pure subroutine stdlib_chbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & + !> CHBGV 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. - - pure subroutine stdlib_chbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72560,7 +72560,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chbgv - !> CHBGVD: computes all the eigenvalues, and optionally, the eigenvectors + + pure subroutine stdlib_chbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & + !> CHBGVD 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 @@ -72571,8 +72573,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_chbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & lwork, rwork, lrwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72687,14 +72687,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chbgvd - !> CHBGVX: computes all the eigenvalues, and optionally, the eigenvectors + + pure subroutine stdlib_chbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & + !> CHBGVX 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. Eigenvalues and !> eigenvectors can be selected by specifying either all eigenvalues, !> a range of values or a range of indices for the desired eigenvalues. - - pure subroutine stdlib_chbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & vu, il, iu, abstol, m, w, z,ldz, work, rwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72876,7 +72876,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chbgvx - !> CHEEVD: computes all eigenvalues and, optionally, eigenvectors of a + + subroutine stdlib_cheevd( jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, liwork,& + !> CHEEVD 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 @@ -72885,8 +72887,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_cheevd( jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, liwork,& info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73029,7 +73029,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cheevd - !> CHEGVD: computes all the eigenvalues, and optionally, the eigenvectors + + subroutine stdlib_chegvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, lrwork,& + !> CHEGVD 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. @@ -73040,8 +73042,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_chegvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, lrwork,& iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73161,7 +73161,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chegvd - !> CHPEVD: computes all the eigenvalues and, optionally, eigenvectors of + + subroutine stdlib_chpevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,rwork, lrwork, iwork, & + !> CHPEVD 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 @@ -73170,8 +73172,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_chpevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,rwork, lrwork, iwork, & liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73303,7 +73303,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpevd - !> CHPGVD: computes all the eigenvalues and, optionally, the eigenvectors + + subroutine stdlib_chpgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, rwork, lrwork,& + !> CHPGVD 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 @@ -73315,8 +73317,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_chpgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, rwork, lrwork,& iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73436,7 +73436,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpgvd - !> CGEES: computes for an N-by-N complex nonsymmetric matrix A, the + + subroutine stdlib_cgees( jobvs, sort, select, n, a, lda, sdim, w, vs,ldvs, work, lwork, & + !> CGEES 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 @@ -73444,8 +73446,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_cgees( jobvs, sort, select, n, a, lda, sdim, w, vs,ldvs, work, lwork, & rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73607,7 +73607,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgees - !> CGEESX: computes for an N-by-N complex nonsymmetric matrix A, the + + subroutine stdlib_cgeesx( jobvs, sort, select, sense, n, a, lda, sdim, w,vs, ldvs, rconde, & + !> CGEESX 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 @@ -73621,8 +73623,6 @@ module stdlib_linalg_lapack_c !> and RCONDV, see Section 4.10_sp of the LAPACK Users' Guide (where !> these quantities are called s and sep respectively). !> A complex matrix is in Schur form if it is upper triangular. - - subroutine stdlib_cgeesx( jobvs, sort, select, sense, n, a, lda, sdim, w,vs, ldvs, rconde, & rcondv, work, lwork, rwork,bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73809,7 +73809,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeesx - !> CGEEV: computes for an N-by-N complex nonsymmetric matrix A, the + + subroutine stdlib_cgeev( jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr,work, lwork, rwork, & + !> CGEEV 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) @@ -73819,8 +73821,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_cgeev( jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr,work, lwork, rwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74058,7 +74058,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeev - !> CGEEVX: computes for an N-by-N complex nonsymmetric matrix A, the + + subroutine stdlib_cgeevx( balanc, jobvl, jobvr, sense, n, a, lda, w, vl,ldvl, vr, ldvr, ilo, & + !> CGEEVX computes for an N-by-N complex nonsymmetric matrix A, the !> eigenvalues and, optionally, the left and/or right eigenvectors. !> Optionally also, it computes a balancing transformation to improve !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, @@ -74083,8 +74085,6 @@ module stdlib_linalg_lapack_c !> (in exact arithmetic) but diagonal scaling will. For further !> explanation of balancing, see section 4.10.2_sp of the LAPACK !> Users' Guide. - - subroutine stdlib_cgeevx( balanc, jobvl, jobvr, sense, n, a, lda, w, vl,ldvl, vr, ldvr, ilo, & ihi, scale, abnrm, rconde,rcondv, work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74360,7 +74360,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeevx - !> CGEJSV: computes the singular value decomposition (SVD) of a complex M-by-N + + pure subroutine stdlib_cgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & + !> CGEJSV 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 @@ -74370,8 +74372,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_cgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & v, ldv,cwork, lwork, rwork, lrwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75767,7 +75767,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgejsv - !> CGESVJ: computes the singular value decomposition (SVD) of a complex + + pure subroutine stdlib_cgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, cwork, lwork, & + !> CGESVJ 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] @@ -75776,8 +75778,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_cgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, cwork, lwork, & rwork, lrwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76619,7 +76619,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgesvj - !> CGGES3: computes for a pair of N-by-N complex nonsymmetric matrices + + subroutine stdlib_cgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alpha, beta, & + !> CGGES3 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 @@ -76639,8 +76641,6 @@ module stdlib_linalg_lapack_c !> 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. - - subroutine stdlib_cgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alpha, beta, & vsl, ldvsl, vsr, ldvsr,work, lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76870,7 +76870,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgges3 - !> CGGEV3: computes for a pair of N-by-N complex nonsymmetric matrices + + subroutine stdlib_cggev3( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & + !> CGGEV3 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 @@ -76885,8 +76887,6 @@ module stdlib_linalg_lapack_c !> 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). - - subroutine stdlib_cggev3( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77142,12 +77142,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cggev3 - !> CGSVJ0: is called from CGESVJ as a pre-processor and that is its main + + pure subroutine stdlib_cgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & + !> CGSVJ0 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. - - pure subroutine stdlib_cgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77683,7 +77683,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgsvj0 - !> CGSVJ1: is called from CGESVJ as a pre-processor and that is its main + + pure subroutine stdlib_cgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & + !> CGSVJ1 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 @@ -77707,8 +77709,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_cgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78056,7 +78056,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgsvj1 - !> CHESV_AA: computes the solution to a complex system of linear equations + + pure subroutine stdlib_chesv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) + !> CHESV_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. @@ -78066,8 +78068,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_chesv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78128,14 +78128,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chesv_aa - !> CHETRF_AA: computes the factorization of a complex hermitian matrix A + + pure subroutine stdlib_chetrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) + !> CHETRF_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. - - pure subroutine stdlib_chetrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78357,7 +78357,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrf_aa - !> CHSEQR: computes the eigenvalues of a Hessenberg matrix H + + pure subroutine stdlib_chseqr( job, compz, n, ilo, ihi, h, ldh, w, z, ldz,work, lwork, info ) + !> CHSEQR 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. @@ -78365,8 +78367,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_chseqr( job, compz, n, ilo, ihi, h, ldh, w, z, ldz,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78502,7 +78502,9 @@ module stdlib_linalg_lapack_c end if end subroutine stdlib_chseqr - !> CLAHEF_AA: factorizes a panel of a complex hermitian matrix A using + + pure subroutine stdlib_clahef_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) + !> CLAHEF_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 @@ -78512,8 +78514,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_clahef_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78746,7 +78746,9 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clahef_aa - !> CLAQR0: computes the eigenvalues of a Hessenberg matrix H + + pure subroutine stdlib_claqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& + !> CLAQR0 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. @@ -78754,8 +78756,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_claqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79093,8 +79093,10 @@ module stdlib_linalg_lapack_c work( 1 ) = cmplx( lwkopt, 0,KIND=sp) end subroutine stdlib_claqr0 + + pure subroutine stdlib_claqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & !> Aggressive early deflation: - !> CLAQR3: accepts as input an upper Hessenberg matrix + !> CLAQR3 accepts as input an upper Hessenberg matrix !> H and performs an unitary similarity transformation !> designed to detect and deflate fully converged eigenvalues from !> a trailing principal submatrix. On output H has been over- @@ -79102,8 +79104,6 @@ module stdlib_linalg_lapack_c !> an unitary similarity transformation of H. It is to be !> hoped that the final version of H has many zero subdiagonal !> entries. - - pure subroutine stdlib_claqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & ns, nd, sh, v, ldv, nh, t, ldt,nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79315,7 +79315,9 @@ module stdlib_linalg_lapack_c work( 1 ) = cmplx( lwkopt, 0,KIND=sp) end subroutine stdlib_claqr3 - !> CLAQR4: implements one level of recursion for CLAQR0. + + pure subroutine stdlib_claqr4( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& + !> CLAQR4 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 @@ -79329,8 +79331,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_claqr4( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79663,7 +79663,9 @@ module stdlib_linalg_lapack_c work( 1 ) = cmplx( lwkopt, 0,KIND=sp) end subroutine stdlib_claqr4 - !> CLAQZ0: computes the eigenvalues of a matrix pair (H,T), + + recursive subroutine stdlib_claqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alpha, & + !> CLAQZ0 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 @@ -79703,8 +79705,6 @@ module stdlib_linalg_lapack_c !> 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" - - recursive subroutine stdlib_claqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alpha, & beta, q, ldq, z,ldz, work, lwork, rwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -80016,9 +80016,9 @@ module stdlib_linalg_lapack_c info = norm_info end subroutine stdlib_claqz0 - !> CLAQZ2: performs AED recursive subroutine stdlib_claqz2( ilschur, ilq, ilz, n, ilo, ihi, nw,a, lda, b, ldb, q, & + !> CLAQZ2 performs AED ldq, z, ldz, ns,nd, alpha, beta, qc, ldqc, zc, ldzc,work, lwork, rwork, rec, info ) ! arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -80205,6 +80205,8 @@ module stdlib_linalg_lapack_c end if end subroutine stdlib_claqz2 + + pure subroutine stdlib_clasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) !> 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. @@ -80215,8 +80217,6 @@ module stdlib_linalg_lapack_c !> 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. - - pure subroutine stdlib_clasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -80441,6 +80441,8 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clasyf_aa + + pure subroutine stdlib_csysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) !> CSYSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS @@ -80451,8 +80453,6 @@ module stdlib_linalg_lapack_c !> where U (or L) is a product of permutation and unit upper (lower) !> triangular matrices, and T is symmetric tridiagonal. The factored !> form of A is then used to solve the system of equations A * X = B. - - pure subroutine stdlib_csysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80513,14 +80513,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csysv_aa - !> CSYTRF_AA: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_csytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) + !> CSYTRF_AA computes the factorization of a complex symmetric matrix A !> using the Aasen's algorithm. The form of the factorization is !> A = U**T*T*U or A = L*T*L**T !> where U (or L) is a product of permutation and unit upper (lower) !> triangular matrices, and T is a complex symmetric tridiagonal matrix. !> This is the blocked version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_csytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_lapack_d.fypp b/src/stdlib_linalg_lapack_d.fypp index e1eed9a92..6eccbe858 100644 --- a/src/stdlib_linalg_lapack_d.fypp +++ b/src/stdlib_linalg_lapack_d.fypp @@ -522,11 +522,11 @@ module stdlib_linalg_lapack_d contains - !> DGBTF2: computes an LU factorization of a real m-by-n band matrix A - !> using partial pivoting with row interchanges. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. pure subroutine stdlib_dgbtf2( m, n, kl, ku, ab, ldab, ipiv, info ) + !> DGBTF2 computes an LU factorization of a real m-by-n band matrix A + !> using partial pivoting with row interchanges. + !> This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -608,12 +608,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbtf2 - !> DGBTRS: solves a system of linear equations + + pure subroutine stdlib_dgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) + !> DGBTRS solves a system of linear equations !> A * X = B or A**T * X = B !> with a general band matrix A using the LU factorization computed !> by DGBTRF. - - pure subroutine stdlib_dgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -702,11 +702,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbtrs - !> DGEBAK: forms the right or left eigenvectors of a real general matrix - !> by backward transformation on the computed eigenvectors of the - !> balanced matrix output by DGEBAL. pure subroutine stdlib_dgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) + !> DGEBAK forms the right or left eigenvectors of a real general matrix + !> by backward transformation on the computed eigenvectors of the + !> balanced matrix output by DGEBAL. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -799,12 +799,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgebak - !> DGGBAK: forms the right or left eigenvectors of a real generalized + + pure subroutine stdlib_dggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) + !> DGGBAK forms the right or left eigenvectors of a real generalized !> eigenvalue problem A*x = lambda*B*x, by backward transformation on !> the computed eigenvectors of the balanced pair of matrices output by !> DGGBAL. - - pure subroutine stdlib_dggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -912,14 +912,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggbak - !> DGTSV: solves the equation + + pure subroutine stdlib_dgtsv( n, nrhs, dl, d, du, b, ldb, info ) + !> DGTSV 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. - - pure subroutine stdlib_dgtsv( n, nrhs, dl, d, du, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1091,15 +1091,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgtsv - !> DGTTRF: computes an LU factorization of a real tridiagonal matrix A + + pure subroutine stdlib_dgttrf( n, dl, d, du, du2, ipiv, info ) + !> DGTTRF computes an LU factorization of a real 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. - - pure subroutine stdlib_dgttrf( n, dl, d, du, du2, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1183,12 +1183,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgttrf - !> DGTTS2: solves one of the systems of equations + + pure subroutine stdlib_dgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) + !> DGTTS2 solves one of the systems of equations !> A*X = B or A**T*X = B, !> with a tridiagonal matrix A using the LU factorization computed !> by DGTTRF. - - pure subroutine stdlib_dgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1296,14 +1296,14 @@ module stdlib_linalg_lapack_d end if end subroutine stdlib_dgtts2 - !> DLA_GBRPVGRW: computes the reciprocal pivot growth factor + + pure real(dp) function stdlib_dla_gbrpvgrw( n, kl, ku, ncols, ab,ldab, afb, ldafb ) + !> DLA_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. - - pure real(dp) function stdlib_dla_gbrpvgrw( n, kl, ku, ncols, ab,ldab, afb, ldafb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1336,14 +1336,14 @@ module stdlib_linalg_lapack_d stdlib_dla_gbrpvgrw = rpvgrw end function stdlib_dla_gbrpvgrw - !> DLA_GERPVGRW: computes the reciprocal pivot growth factor + + pure real(dp) function stdlib_dla_gerpvgrw( n, ncols, a, lda, af,ldaf ) + !> DLA_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. - - pure real(dp) function stdlib_dla_gerpvgrw( n, ncols, a, lda, af,ldaf ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1375,11 +1375,11 @@ module stdlib_linalg_lapack_d stdlib_dla_gerpvgrw = rpvgrw end function stdlib_dla_gerpvgrw - !> DLA_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. pure subroutine stdlib_dla_wwaddw( n, x, y, w ) + !> DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1402,7 +1402,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dla_wwaddw - !> DLABAD: takes as input the values computed by DLAMCH for underflow and + + pure subroutine stdlib_dlabad( small, large ) + !> DLABAD 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 @@ -1410,8 +1412,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dlabad( small, large ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1430,10 +1430,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlabad - !> DLACN2: estimates the 1-norm of a square, real matrix A. - !> Reverse communication is used for evaluating matrix-vector products. pure subroutine stdlib_dlacn2( n, v, x, isgn, est, kase, isave ) + !> DLACN2 estimates the 1-norm of a square, real matrix A. + !> Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1563,10 +1563,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlacn2 - !> DLACON: estimates the 1-norm of a square, real matrix A. - !> Reverse communication is used for evaluating matrix-vector products. subroutine stdlib_dlacon( n, v, x, isgn, est, kase ) + !> DLACON estimates the 1-norm of a square, real matrix A. + !> Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1684,10 +1684,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlacon - !> DLACPY: copies all or part of a two-dimensional matrix A to another - !> matrix B. pure subroutine stdlib_dlacpy( uplo, m, n, a, lda, b, ldb ) + !> DLACPY copies all or part of a two-dimensional matrix A to another + !> matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1750,13 +1750,13 @@ module stdlib_linalg_lapack_d return end function stdlib_dladiv2 - !> DLAE2: computes the eigenvalues of a 2-by-2 symmetric matrix + + pure subroutine stdlib_dlae2( a, b, c, rt1, rt2 ) + !> DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix !> [ A B ] !> [ B C ]. !> On return, RT1 is the eigenvalue of larger absolute value, and RT2 !> is the eigenvalue of smaller absolute value. - - pure subroutine stdlib_dlae2( a, b, c, rt1, rt2 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1814,7 +1814,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlae2 - !> DLAEBZ: contains the iteration loops which compute and use the + + pure subroutine stdlib_dlaebz( ijob, nitmax, n, mmax, minp, nbmin, abstol,reltol, pivmin, d, & + !> DLAEBZ 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: @@ -1845,8 +1847,6 @@ module stdlib_linalg_lapack_d !> University, July 21, 1966 !> Note: the arguments are, in general, *not* checked for unreasonable !> values. - - pure subroutine stdlib_dlaebz( ijob, nitmax, n, mmax, minp, nbmin, abstol,reltol, pivmin, d, & e, e2, nval, ab, c, mout,nab, work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2085,6 +2085,8 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaebz + + pure subroutine stdlib_dlaed5( i, d, z, delta, rho, dlam ) !> 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) . @@ -2092,8 +2094,6 @@ module stdlib_linalg_lapack_d !> D(i) < D(j) for i < j . !> We also assume RHO > 0 and that the Euclidean norm of the vector !> Z is one. - - pure subroutine stdlib_dlaed5( i, d, z, delta, rho, dlam ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2156,11 +2156,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed5 - !> DLAEDA: computes the Z vector corresponding to the merge step in the - !> CURLVLth step of the merge process with TLVLS steps for the CURPBMth - !> problem. pure subroutine stdlib_dlaeda( n, tlvls, curlvl, curpbm, prmptr, perm, givptr,givcol, givnum,& + !> DLAEDA computes the Z vector corresponding to the merge step in the + !> CURLVLth step of the merge process with TLVLS steps for the CURPBMth + !> problem. q, qptr, z, ztemp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2261,7 +2261,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaeda - !> DLAEV2: computes the eigendecomposition of a 2-by-2 symmetric matrix + + pure subroutine stdlib_dlaev2( a, b, c, rt1, rt2, cs1, sn1 ) + !> DLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix !> [ A B ] !> [ B C ]. !> On return, RT1 is the eigenvalue of larger absolute value, RT2 is the @@ -2269,8 +2271,6 @@ module stdlib_linalg_lapack_d !> eigenvector for RT1, giving the decomposition !> [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ] !> [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ]. - - pure subroutine stdlib_dlaev2( a, b, c, rt1, rt2, cs1, sn1 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2360,14 +2360,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaev2 - !> DLAG2: computes the eigenvalues of a 2 x 2 generalized eigenvalue + + pure subroutine stdlib_dlag2( a, lda, b, ldb, safmin, scale1, scale2, wr1,wr2, wi ) + !> DLAG2 computes the eigenvalues of a 2 x 2 generalized eigenvalue !> problem A - w B, with scaling as necessary to avoid over-/underflow. !> The scaling factor "s" results in a modified eigenvalue equation !> s A - w B !> where s is a non-negative scaling factor chosen so that w, w B, !> and s A do not overflow and, if possible, do not underflow, either. - - pure subroutine stdlib_dlag2( a, lda, b, ldb, safmin, scale1, scale2, wr1,wr2, wi ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2544,14 +2544,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlag2 - !> DLAG2S: converts a DOUBLE PRECISION matrix, SA, to a SINGLE + + pure subroutine stdlib_dlag2s( m, n, a, lda, sa, ldsa, info ) + !> DLAG2S converts a DOUBLE PRECISION matrix, SA, to a SINGLE !> PRECISION matrix, A. !> RMAX is the overflow for the SINGLE PRECISION arithmetic !> DLAG2S checks that all the entries of A are between -RMAX and !> RMAX. If not the conversion is aborted and a flag is raised. !> This is an auxiliary routine so there is no argument checking. - - pure subroutine stdlib_dlag2s( m, n, a, lda, sa, ldsa, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2581,13 +2581,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlag2s - !> DLAGTM: performs a matrix-vector product of the form + + pure subroutine stdlib_dlagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) + !> DLAGTM 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. - - pure subroutine stdlib_dlagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2683,9 +2683,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlagtm + + pure logical(lk) function stdlib_dlaisnan( din1, din2 ) !> This routine is not for general use. It exists solely to avoid !> over-optimization in DISNAN. - !> DLAISNAN: checks for NaNs by comparing its two arguments for + !> DLAISNAN 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. @@ -2694,8 +2696,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure logical(lk) function stdlib_dlaisnan( din1, din2 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2707,9 +2707,9 @@ module stdlib_linalg_lapack_d return end function stdlib_dlaisnan - !> DLAMCH: determines double precision machine parameters. pure real(dp) function stdlib_dlamch( cmach ) + !> DLAMCH determines double precision machine parameters. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2775,11 +2775,11 @@ module stdlib_linalg_lapack_d return end function stdlib_dlamc3 - !> DLAMRG: 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. pure subroutine stdlib_dlamrg( n1, n2, a, dtrd1, dtrd2, index ) + !> DLAMRG 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2839,7 +2839,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlamrg - !> DLAORHR_COL_GETRFNP2: computes the modified LU factorization without + + pure recursive subroutine stdlib_dlaorhr_col_getrfnp2( m, n, a, lda, d, info ) + !> DLAORHR_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, @@ -2887,8 +2889,6 @@ module stdlib_linalg_lapack_d !> [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. - - pure recursive subroutine stdlib_dlaorhr_col_getrfnp2( m, n, a, lda, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2969,14 +2969,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaorhr_col_getrfnp2 - !> DLAPMR: rearranges the rows of the M by N matrix X as specified + + pure subroutine stdlib_dlapmr( forwrd, m, n, x, ldx, k ) + !> DLAPMR 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. - - pure subroutine stdlib_dlapmr( forwrd, m, n, x, ldx, k ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3037,14 +3037,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlapmr - !> DLAPMT: rearranges the columns of the M by N matrix X as specified + + pure subroutine stdlib_dlapmt( forwrd, m, n, x, ldx, k ) + !> DLAPMT 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. - - pure subroutine stdlib_dlapmt( forwrd, m, n, x, ldx, k ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3105,10 +3105,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlapmt - !> DLAPY3: returns sqrt(x**2+y**2+z**2), taking care not to cause - !> unnecessary overflow and unnecessary underflow. pure real(dp) function stdlib_dlapy3( x, y, z ) + !> DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause + !> unnecessary overflow and unnecessary underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3137,11 +3137,11 @@ module stdlib_linalg_lapack_d return end function stdlib_dlapy3 - !> DLAQGB: 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. pure subroutine stdlib_dlaqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) + !> DLAQGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -3207,10 +3207,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaqgb - !> DLAQGE: equilibrates a general M by N matrix A using the row and - !> column scaling factors in the vectors R and C. pure subroutine stdlib_dlaqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed ) + !> DLAQGE equilibrates a general M by N matrix A using the row and + !> column scaling factors in the vectors R and C. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3273,6 +3273,8 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaqge + + pure subroutine stdlib_dlaqr1( n, h, ldh, sr1, si1, sr2, si2, v ) !> Given a 2-by-2 or 3-by-3 matrix H, DLAQR1: sets v to a !> scalar multiple of the first column of the product !> (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I) @@ -3283,8 +3285,6 @@ module stdlib_linalg_lapack_d !> 2) si1 = si2 = 0. !> This is useful for starting double implicit shift bulges !> in the QR algorithm. - - pure subroutine stdlib_dlaqr1( n, h, ldh, sr1, si1, sr2, si2, v ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3333,10 +3333,10 @@ module stdlib_linalg_lapack_d end if end subroutine stdlib_dlaqr1 - !> DLAQSB: equilibrates a symmetric band matrix A using the scaling - !> factors in the vector S. pure subroutine stdlib_dlaqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) + !> DLAQSB equilibrates a symmetric band matrix A using the scaling + !> factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3393,10 +3393,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaqsb - !> DLAQSP: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_dlaqsp( uplo, n, ap, s, scond, amax, equed ) + !> DLAQSP equilibrates a symmetric matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3455,10 +3455,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaqsp - !> DLAQSY: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_dlaqsy( uplo, n, a, lda, s, scond, amax, equed ) + !> DLAQSY equilibrates a symmetric matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3513,13 +3513,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaqsy - !> DLAR2V: applies a vector of real plane rotations from both sides to + + pure subroutine stdlib_dlar2v( n, x, y, z, incx, c, s, incc ) + !> DLAR2V applies a vector of real plane rotations from both sides to !> a sequence of 2-by-2 real symmetric matrices, defined by the elements !> of the vectors x, y and z. For i = 1,2,...,n !> ( x(i) z(i) ) := ( c(i) s(i) ) ( x(i) z(i) ) ( c(i) -s(i) ) !> ( z(i) y(i) ) ( -s(i) c(i) ) ( z(i) y(i) ) ( s(i) c(i) ) - - pure subroutine stdlib_dlar2v( n, x, y, z, incx, c, s, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3556,13 +3556,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlar2v - !> DLARF: applies a real elementary reflector H to a real m by n matrix + + pure subroutine stdlib_dlarf( side, m, n, v, incv, tau, c, ldc, work ) + !> DLARF applies a real elementary reflector H to a real m by n matrix !> C, from either the left or the right. H is represented in the form !> H = I - tau * v * v**T !> where tau is a real scalar and v is a real vector. !> If tau = 0, then H is taken to be the unit matrix. - - pure subroutine stdlib_dlarf( side, m, n, v, incv, tau, c, ldc, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3633,10 +3633,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarf - !> DLARFB: applies a real block reflector H or its transpose H**T to a - !> real m by n matrix C, from either the left or the right. pure subroutine stdlib_dlarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, ldc, & + !> DLARFB applies a real block reflector H or its transpose H**T to a + !> real m by n matrix C, from either the left or the right. work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -3955,15 +3955,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarfb - !> DLARFB_GETT: applies a real Householder block reflector H from the + + pure subroutine stdlib_dlarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) + !> DLARFB_GETT applies a real Householder block reflector H from the !> left to a real (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. - - pure subroutine stdlib_dlarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4092,7 +4092,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarfb_gett - !> DLARFT: forms the triangular factor T of a real block reflector H + + pure subroutine stdlib_dlarft( direct, storev, n, k, v, ldv, tau, t, ldt ) + !> DLARFT forms the triangular factor T of a real 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. @@ -4102,8 +4104,6 @@ module stdlib_linalg_lapack_d !> 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**T * T * V - - pure subroutine stdlib_dlarft( direct, storev, n, k, v, ldv, tau, t, ldt ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4219,15 +4219,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarft - !> DLARFX: applies a real elementary reflector H to a real m by n + + pure subroutine stdlib_dlarfx( side, m, n, v, tau, c, ldc, work ) + !> DLARFX applies a real elementary reflector H to a real m by n !> matrix C, from either the left or the right. H is represented in the !> form !> H = I - tau * v * v**T !> where tau is a real scalar and v is a real vector. !> If tau = 0, then H is taken to be the unit matrix !> This version uses inline code if H has order < 11. - - pure subroutine stdlib_dlarfx( side, m, n, v, tau, c, ldc, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4722,14 +4722,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarfx - !> DLARFY: applies an elementary reflector, or Householder matrix, H, + + pure subroutine stdlib_dlarfy( uplo, n, v, incv, tau, c, ldc, work ) + !> DLARFY applies an elementary reflector, or Householder matrix, H, !> to an n x n symmetric 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. - - pure subroutine stdlib_dlarfy( uplo, n, v, incv, tau, c, ldc, work ) ! -- lapack test routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4756,12 +4756,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarfy - !> DLARGV: generates a vector of real plane rotations, determined by + + pure subroutine stdlib_dlargv( n, x, incx, y, incy, c, incc ) + !> DLARGV generates a vector of real plane rotations, determined by !> elements of the real vectors x and y. For i = 1,2,...,n !> ( c(i) s(i) ) ( x(i) ) = ( a(i) ) !> ( -s(i) c(i) ) ( y(i) ) = ( 0 ) - - pure subroutine stdlib_dlargv( n, x, incx, y, incy, c, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4810,10 +4810,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlargv - !> Compute the splitting points with threshold SPLTOL. - !> DLARRA: sets any "small" off-diagonal elements to zero. pure subroutine stdlib_dlarra( n, d, e, e2, spltol, tnrm,nsplit, isplit, info ) + !> Compute the splitting points with threshold SPLTOL. + !> DLARRA sets any "small" off-diagonal elements to zero. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4868,11 +4868,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarra + + pure subroutine stdlib_dlarrc( jobt, n, vl, vu, d, e, pivmin,eigcnt, lcnt, rcnt, info ) !> 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'. - - pure subroutine stdlib_dlarrc( jobt, n, vl, vu, d, e, pivmin,eigcnt, lcnt, rcnt, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4961,7 +4961,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarrc - !> DLARRD: computes the eigenvalues of a symmetric tridiagonal + + pure subroutine stdlib_dlarrd( range, order, n, vl, vu, il, iu, gers,reltol, d, e, e2, & + !> DLARRD 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 @@ -4973,8 +4975,6 @@ module stdlib_linalg_lapack_d !> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal !> Matrix", Report CS41, Computer Science Dept., Stanford !> University, July 21, 1966. - - pure subroutine stdlib_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 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5432,6 +5432,8 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarrd + + pure subroutine stdlib_dlarrj( n, d, e2, ifirst, ilast,rtol, offset, w, werr, work, iwork,& !> Given the initial eigenvalue approximations of T, DLARRJ: !> does bisection to refine the eigenvalues of T, !> W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial @@ -5439,8 +5441,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dlarrj( n, d, e2, ifirst, ilast,rtol, offset, w, werr, work, iwork,& pivmin, spdiam, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5610,7 +5610,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarrj - !> DLARRK: computes one eigenvalue of a symmetric tridiagonal + + pure subroutine stdlib_dlarrk( n, iw, gl, gu,d, e2, pivmin, reltol, w, werr, info) + !> DLARRK 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 @@ -5619,8 +5621,6 @@ module stdlib_linalg_lapack_d !> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal !> Matrix", Report CS41, Computer Science Dept., Stanford !> University, July 21, 1966. - - pure subroutine stdlib_dlarrk( n, iw, gl, gu,d, e2, pivmin, reltol, w, werr, info) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5690,11 +5690,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarrk + + pure subroutine stdlib_dlarrr( n, d, e, info ) !> Perform tests to decide whether the symmetric tridiagonal matrix T !> warrants expensive computations which guarantee high relative accuracy !> in the eigenvalues. - - pure subroutine stdlib_dlarrr( n, d, e, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5772,9 +5772,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarrr + + pure subroutine stdlib_dlartg( f, g, c, s, r ) !> ! !> - !> DLARTG: generates a plane rotation so that + !> DLARTG generates a plane rotation so that !> [ C S ] . [ F ] = [ R ] !> [ -S C ] [ G ] [ 0 ] !> where C**2 + S**2 = 1. @@ -5796,8 +5798,6 @@ module stdlib_linalg_lapack_d !> there are zeros on the diagonal). !> If F exceeds G in magnitude, C will be positive. !> Below, wp=>dp stands for double precision from LA_CONSTANTS module. - - pure subroutine stdlib_dlartg( f, g, c, s, r ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5841,7 +5841,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlartg - !> DLARTGP: generates a plane rotation so that + + pure subroutine stdlib_dlartgp( f, g, cs, sn, r ) + !> DLARTGP 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, @@ -5850,8 +5852,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dlartgp( f, g, cs, sn, r ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5935,7 +5935,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlartgp - !> DLARTGS: generates a plane rotation designed to introduce a bulge in + + pure subroutine stdlib_dlartgs( x, y, sigma, cs, sn ) + !> DLARTGS 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 @@ -5943,8 +5945,6 @@ module stdlib_linalg_lapack_d !> [ -SN CS ] [ X * Y ] [ 0 ] !> with R nonnegative. If X^2 - SIGMA and X * Y are 0, then the !> rotation is by PI/2. - - pure subroutine stdlib_dlartgs( x, y, sigma, cs, sn ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5991,12 +5991,12 @@ module stdlib_linalg_lapack_d ! end stdlib_dlartgs end subroutine stdlib_dlartgs - !> DLARTV: applies a vector of real plane rotations to elements of the + + pure subroutine stdlib_dlartv( n, x, incx, y, incy, c, s, incc ) + !> DLARTV applies a vector of real plane rotations to elements of the !> real vectors x and y. For i = 1,2,...,n !> ( x(i) ) := ( c(i) s(i) ) ( x(i) ) !> ( y(i) ) ( -s(i) c(i) ) ( y(i) ) - - pure subroutine stdlib_dlartv( n, x, incx, y, incy, c, s, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6025,11 +6025,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlartv - !> DLARUV: 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. pure subroutine stdlib_dlaruv( iseed, n, x ) + !> DLARUV 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6227,15 +6227,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaruv - !> DLARZ: applies a real elementary reflector H to a real M-by-N + + pure subroutine stdlib_dlarz( side, m, n, l, v, incv, tau, c, ldc, work ) + !> DLARZ applies a real elementary reflector H to a real M-by-N !> matrix C, from either the left or the right. H is represented in the !> form !> H = I - tau * v * v**T !> where tau is a real scalar and v is a real vector. !> If tau = 0, then H is taken to be the unit matrix. !> H is a product of k elementary reflectors as returned by DTZRZF. - - pure subroutine stdlib_dlarz( side, m, n, l, v, incv, tau, c, ldc, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6282,11 +6282,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarz - !> DLARZB: applies a real block reflector H or its transpose H**T to - !> a real distributed M-by-N C from the left or the right. - !> Currently, only STOREV = 'R' and DIRECT = 'B' are supported. pure subroutine stdlib_dlarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & + !> DLARZB applies a real block reflector H or its transpose H**T to + !> a real distributed M-by-N C from the left or the right. + !> Currently, only STOREV = 'R' and DIRECT = 'B' are supported. ldc, work, ldwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -6371,7 +6371,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarzb - !> DLARZT: forms the triangular factor T of a real block reflector + + pure subroutine stdlib_dlarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) + !> DLARZT forms the triangular factor T of a real 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; @@ -6383,8 +6385,6 @@ module stdlib_linalg_lapack_d !> H(i) is stored in the i-th row of the array V, and !> H = I - V**T * T * V !> Currently, only STOREV = 'R' and DIRECT = 'B' are supported. - - pure subroutine stdlib_dlarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6433,13 +6433,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarzt - !> DLAS2: computes the singular values of the 2-by-2 matrix + + pure subroutine stdlib_dlas2( f, g, h, ssmin, ssmax ) + !> DLAS2 computes the singular values of the 2-by-2 matrix !> [ F G ] !> [ 0 H ]. !> On return, SSMIN is the smaller singular value and SSMAX is the !> larger singular value. - - pure subroutine stdlib_dlas2( f, g, h, ssmin, ssmax ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6497,6 +6497,8 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlas2 + + pure subroutine stdlib_dlasd5( i, d, z, delta, rho, dsigma, work ) !> 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 @@ -6505,8 +6507,6 @@ module stdlib_linalg_lapack_d !> 0 <= D(i) < D(j) for i < j . !> We also assume RHO > 0 and that the Euclidean norm of the vector !> Z is one. - - pure subroutine stdlib_dlasd5( i, d, z, delta, rho, dsigma, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6592,10 +6592,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd5 - !> DLASDT: creates a tree of subproblems for bidiagonal divide and - !> conquer. pure subroutine stdlib_dlasdt( n, lvl, nd, inode, ndiml, ndimr, msub ) + !> DLASDT creates a tree of subproblems for bidiagonal divide and + !> conquer. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6643,10 +6643,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasdt - !> DLASET: initializes an m-by-n matrix A to BETA on the diagonal and - !> ALPHA on the offdiagonals. pure subroutine stdlib_dlaset( uplo, m, n, alpha, beta, a, lda ) + !> DLASET initializes an m-by-n matrix A to BETA on the diagonal and + !> ALPHA on the offdiagonals. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6693,10 +6693,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaset - !> DLASQ4: computes an approximation TAU to the smallest eigenvalue - !> using values of d from the previous transform. pure subroutine stdlib_dlasq4( i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn,dn1, dn2, tau, & + !> DLASQ4 computes an approximation TAU to the smallest eigenvalue + !> using values of d from the previous transform. ttype, g ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -6901,10 +6901,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasq4 - !> DLASQ5: computes one dqds transform in ping-pong form, one - !> version for IEEE machines another for non IEEE machines. pure subroutine stdlib_dlasq5( i0, n0, z, pp, tau, sigma, dmin, dmin1, dmin2,dn, dnm1, dnm2, & + !> DLASQ5 computes one dqds transform in ping-pong form, one + !> version for IEEE machines another for non IEEE machines. ieee, eps ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7129,10 +7129,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasq5 - !> DLASQ6: computes one dqd (shift equal to zero) transform in - !> ping-pong form, with protection against underflow and overflow. pure subroutine stdlib_dlasq6( i0, n0, z, pp, dmin, dmin1, dmin2, dn,dnm1, dnm2 ) + !> DLASQ6 computes one dqd (shift equal to zero) transform in + !> ping-pong form, with protection against underflow and overflow. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7239,7 +7239,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasq6 - !> DLASR: applies a sequence of plane rotations to a real matrix A, + + pure subroutine stdlib_dlasr( side, pivot, direct, m, n, c, s, a, lda ) + !> DLASR applies a sequence of plane rotations to a real matrix A, !> from either the left or the right. !> When SIDE = 'L', the transformation takes the form !> A := P*A @@ -7290,8 +7292,6 @@ module stdlib_linalg_lapack_d !> ( -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. - - pure subroutine stdlib_dlasr( side, pivot, direct, m, n, c, s, a, lda ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7498,12 +7498,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasr + + pure subroutine stdlib_dlasrt( id, n, d, info ) !> 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. - - pure subroutine stdlib_dlasrt( id, n, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7672,9 +7672,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasrt + + pure subroutine stdlib_dlassq( n, x, incx, scl, sumsq ) !> ! !> - !> DLASSQ: returns the values scl and smsq such that + !> DLASSQ 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. @@ -7692,8 +7694,6 @@ module stdlib_linalg_lapack_d !> and !> TINY*EPS -- tiniest representable number; !> HUGE -- biggest representable number. - - pure subroutine stdlib_dlassq( n, x, incx, scl, sumsq ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7789,7 +7789,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlassq - !> DLASV2: computes the singular value decomposition of a 2-by-2 + + pure subroutine stdlib_dlasv2( f, g, h, ssmin, ssmax, snr, csr, snl, csl ) + !> DLASV2 computes the singular value decomposition of a 2-by-2 !> triangular matrix !> [ F G ] !> [ 0 H ]. @@ -7798,8 +7800,6 @@ module stdlib_linalg_lapack_d !> right singular vectors for abs(SSMAX), giving the decomposition !> [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ] !> [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ]. - - pure subroutine stdlib_dlasv2( f, g, h, ssmin, ssmax, snr, csr, snl, csl ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7934,10 +7934,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasv2 - !> DLASWP: performs a series of row interchanges on the matrix A. - !> One row interchange is initiated for each of rows K1 through K2 of A. pure subroutine stdlib_dlaswp( n, a, lda, k1, k2, ipiv, incx ) + !> DLASWP performs a series of row interchanges on the matrix A. + !> One row interchange is initiated for each of rows K1 through K2 of A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8001,12 +8001,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaswp - !> DLASY2: solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in + + pure subroutine stdlib_dlasy2( ltranl, ltranr, isgn, n1, n2, tl, ldtl, tr,ldtr, b, ldb, & + !> DLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in !> op(TL)*X + ISGN*X*op(TR) = SCALE*B, !> where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or !> -1. op(T) = T or T**T, where T**T denotes the transpose of T. - - pure subroutine stdlib_dlasy2( ltranl, ltranr, isgn, n1, n2, tl, ldtl, tr,ldtr, b, ldb, & scale, x, ldx, xnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8261,7 +8261,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasy2 - !> DLASYF: computes a partial factorization of a real symmetric matrix A + + pure subroutine stdlib_dlasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) + !> DLASYF computes a partial factorization of a real 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: @@ -8273,8 +8275,6 @@ module stdlib_linalg_lapack_d !> DLASYF is an auxiliary routine called by DSYTRF. It uses blocked code !> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or !> A22 (if UPLO = 'L'). - - pure subroutine stdlib_dlasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8698,7 +8698,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasyf - !> DLASYF_RK: computes a partial factorization of a real symmetric + + pure subroutine stdlib_dlasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) + !> DLASYF_RK computes a partial factorization of a real 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: @@ -8710,8 +8712,6 @@ module stdlib_linalg_lapack_d !> DLASYF_RK is an auxiliary routine called by DSYTRF_RK. It uses !> blocked code (calling Level 3 BLAS) to update the submatrix !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). - - pure subroutine stdlib_dlasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9139,7 +9139,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasyf_rk - !> DLASYF_ROOK: computes a partial factorization of a real symmetric + + pure subroutine stdlib_dlasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) + !> DLASYF_ROOK computes a partial factorization of a real 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: @@ -9151,8 +9153,6 @@ module stdlib_linalg_lapack_d !> DLASYF_ROOK is an auxiliary routine called by DSYTRF_ROOK. It uses !> blocked code (calling Level 3 BLAS) to update the submatrix !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). - - pure subroutine stdlib_dlasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9600,14 +9600,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasyf_rook - !> DLAT2S: converts a DOUBLE PRECISION triangular matrix, SA, to a SINGLE + + pure subroutine stdlib_dlat2s( uplo, n, a, lda, sa, ldsa, info ) + !> DLAT2S converts a DOUBLE PRECISION triangular matrix, SA, to a SINGLE !> PRECISION triangular matrix, A. !> RMAX is the overflow for the SINGLE PRECISION arithmetic !> DLAS2S checks that all the entries of A are between -RMAX and !> RMAX. If not the conversion is aborted and a flag is raised. !> This is an auxiliary routine so there is no argument checking. - - pure subroutine stdlib_dlat2s( uplo, n, a, lda, sa, ldsa, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9651,7 +9651,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlat2s - !> DLATBS: solves one of the triangular systems + + pure subroutine stdlib_dlatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & + !> DLATBS solves one of the triangular systems !> A *x = s*b or A**T*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 @@ -9661,8 +9663,6 @@ module stdlib_linalg_lapack_d !> overflow, the Level 2 BLAS routine DTBSV 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. - - pure subroutine stdlib_dlatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10071,7 +10071,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlatbs - !> DLATPS: solves one of the triangular systems + + pure subroutine stdlib_dlatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) + !> DLATPS solves one of the triangular systems !> A *x = s*b or A**T*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 @@ -10081,8 +10083,6 @@ module stdlib_linalg_lapack_d !> unscaled problem will not cause overflow, the Level 2 BLAS routine !> DTPSV 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. - - pure subroutine stdlib_dlatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10489,7 +10489,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlatps - !> DLATRS: solves one of the triangular systems + + pure subroutine stdlib_dlatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) + !> DLATRS solves one of the triangular systems !> A *x = s*b or A**T *x = s*b !> with scaling to prevent overflow. Here A is an upper or lower !> triangular matrix, A**T denotes the transpose of A, x and b are @@ -10499,8 +10501,6 @@ module stdlib_linalg_lapack_d !> overflow, the Level 2 BLAS routine DTRSV 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. - - pure subroutine stdlib_dlatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10890,7 +10890,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlatrs - !> DLAUU2: computes the product U * U**T or L**T * L, where the triangular + + pure subroutine stdlib_dlauu2( uplo, n, a, lda, info ) + !> DLAUU2 computes the product U * U**T or L**T * L, where the triangular !> factor U or L is stored in the upper or lower triangular part of !> the array A. !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, @@ -10898,8 +10900,6 @@ module stdlib_linalg_lapack_d !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, !> overwriting the factor L in A. !> This is the unblocked form of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_dlauu2( uplo, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10962,7 +10962,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlauu2 - !> DLAUUM: computes the product U * U**T or L**T * L, where the triangular + + pure subroutine stdlib_dlauum( uplo, n, a, lda, info ) + !> DLAUUM computes the product U * U**T or L**T * L, where the triangular !> factor U or L is stored in the upper or lower triangular part of !> the array A. !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, @@ -10970,8 +10972,6 @@ module stdlib_linalg_lapack_d !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, !> overwriting the factor L in A. !> This is the blocked form of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_dlauum( uplo, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11045,7 +11045,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlauum - !> DORBDB6: orthogonalizes the column vector + + pure subroutine stdlib_dorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & + !> DORBDB6 orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] !> with respect to the columns of @@ -11054,8 +11056,6 @@ module stdlib_linalg_lapack_d !> The columns of Q must be orthonormal. !> If the projection is zero according to Kahan's "twice is enough" !> criterion, then the zero vector is returned. - - pure subroutine stdlib_dorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -11173,13 +11173,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorbdb6 - !> DORG2L: generates an m by n real matrix Q with orthonormal columns, + + pure subroutine stdlib_dorg2l( m, n, k, a, lda, tau, work, info ) + !> DORG2L generates an m by n real matrix Q with orthonormal columns, !> which is defined as the last n columns of a product of k elementary !> reflectors of order m !> Q = H(k) . . . H(2) H(1) !> as returned by DGEQLF. - - pure subroutine stdlib_dorg2l( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11237,13 +11237,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorg2l - !> DORG2R: generates an m by n real matrix Q with orthonormal columns, + + pure subroutine stdlib_dorg2r( m, n, k, a, lda, tau, work, info ) + !> DORG2R generates an m by n real matrix Q with orthonormal columns, !> which is defined as the first n columns of a product of k elementary !> reflectors of order m !> Q = H(1) H(2) . . . H(k) !> as returned by DGEQRF. - - pure subroutine stdlib_dorg2r( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11302,13 +11302,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorg2r - !> DORGL2: generates an m by n real matrix Q with orthonormal rows, + + pure subroutine stdlib_dorgl2( m, n, k, a, lda, tau, work, info ) + !> DORGL2 generates an m by n real matrix Q with orthonormal rows, !> which is defined as the first m rows of a product of k elementary !> reflectors of order n !> Q = H(k) . . . H(2) H(1) !> as returned by DGELQF. - - pure subroutine stdlib_dorgl2( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11371,13 +11371,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgl2 - !> DORGLQ: generates an M-by-N real matrix Q with orthonormal rows, + + pure subroutine stdlib_dorglq( m, n, k, a, lda, tau, work, lwork, info ) + !> DORGLQ generates an M-by-N real matrix Q with orthonormal rows, !> which is defined as the first M rows of a product of K elementary !> reflectors of order N !> Q = H(k) . . . H(2) H(1) !> as returned by DGELQF. - - pure subroutine stdlib_dorglq( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11487,13 +11487,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorglq - !> DORGQL: generates an M-by-N real matrix Q with orthonormal columns, + + pure subroutine stdlib_dorgql( m, n, k, a, lda, tau, work, lwork, info ) + !> DORGQL generates an M-by-N real matrix Q with orthonormal columns, !> which is defined as the last N columns of a product of K elementary !> reflectors of order M !> Q = H(k) . . . H(2) H(1) !> as returned by DGEQLF. - - pure subroutine stdlib_dorgql( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11608,13 +11608,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgql - !> DORGQR: generates an M-by-N real matrix Q with orthonormal columns, + + pure subroutine stdlib_dorgqr( m, n, k, a, lda, tau, work, lwork, info ) + !> DORGQR generates an M-by-N real matrix Q with orthonormal columns, !> which is defined as the first N columns of a product of K elementary !> reflectors of order M !> Q = H(1) H(2) . . . H(k) !> as returned by DGEQRF. - - pure subroutine stdlib_dorgqr( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11724,13 +11724,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgqr - !> DORGR2: generates an m by n real matrix Q with orthonormal rows, + + pure subroutine stdlib_dorgr2( m, n, k, a, lda, tau, work, info ) + !> DORGR2 generates an m by n real matrix Q with orthonormal rows, !> which is defined as the last m rows of a product of k elementary !> reflectors of order n !> Q = H(1) H(2) . . . H(k) !> as returned by DGERQF. - - pure subroutine stdlib_dorgr2( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11790,13 +11790,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgr2 - !> DORGRQ: generates an M-by-N real matrix Q with orthonormal rows, + + pure subroutine stdlib_dorgrq( m, n, k, a, lda, tau, work, lwork, info ) + !> DORGRQ generates an M-by-N real matrix Q with orthonormal rows, !> which is defined as the last M rows of a product of K elementary !> reflectors of order N !> Q = H(1) H(2) . . . H(k) !> as returned by DGERQF. - - pure subroutine stdlib_dorgrq( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11911,7 +11911,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgrq - !> DORGTSQR_ROW: generates an M-by-N real matrix Q_out with + + pure subroutine stdlib_dorgtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) + !> DORGTSQR_ROW generates an M-by-N real matrix Q_out with !> orthonormal columns from the output of DLATSQR. These N orthonormal !> columns are the first N columns of a product of complex unitary !> matrices Q(k)_in of order M, which are returned by DLATSQR in @@ -11926,8 +11928,6 @@ module stdlib_linalg_lapack_d !> starting in the bottom row block and continues to the top row block !> (hence _ROW in the routine name). This sweep is in reverse order of !> the order in which DLATSQR generates the output blocks. - - pure subroutine stdlib_dorgtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12236,7 +12236,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorm22 - !> DORM2L: overwrites the general real m by n matrix C with + + pure subroutine stdlib_dorm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> DORM2L overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T * C if SIDE = 'L' and TRANS = 'T', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -12246,8 +12248,6 @@ module stdlib_linalg_lapack_d !> Q = H(k) . . . H(2) H(1) !> as returned by DGEQLF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_dorm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12330,7 +12330,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorm2l - !> DORM2R: overwrites the general real m by n matrix C with + + pure subroutine stdlib_dorm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> DORM2R overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T* C if SIDE = 'L' and TRANS = 'T', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -12340,8 +12342,6 @@ module stdlib_linalg_lapack_d !> Q = H(1) H(2) . . . H(k) !> as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_dorm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12429,7 +12429,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorm2r - !> DORML2: overwrites the general real m by n matrix C with + + pure subroutine stdlib_dorml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> DORML2 overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T* C if SIDE = 'L' and TRANS = 'T', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -12439,8 +12441,6 @@ module stdlib_linalg_lapack_d !> Q = H(k) . . . H(2) H(1) !> as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_dorml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12528,7 +12528,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorml2 - !> DORMLQ: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_dormlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> DORMLQ overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -12537,8 +12539,6 @@ module stdlib_linalg_lapack_d !> Q = H(k) . . . H(2) H(1) !> as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_dormlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12671,7 +12671,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormlq - !> DORMQL: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_dormql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> DORMQL overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -12680,8 +12682,6 @@ module stdlib_linalg_lapack_d !> Q = H(k) . . . H(2) H(1) !> as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_dormql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12808,7 +12808,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormql - !> DORMQR: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_dormqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> DORMQR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -12817,8 +12819,6 @@ module stdlib_linalg_lapack_d !> Q = H(1) H(2) . . . H(k) !> as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_dormqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12945,7 +12945,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormqr - !> DORMR2: overwrites the general real m by n matrix C with + + pure subroutine stdlib_dormr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> DORMR2 overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T* C if SIDE = 'L' and TRANS = 'T', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -12955,8 +12957,6 @@ module stdlib_linalg_lapack_d !> Q = H(1) H(2) . . . H(k) !> as returned by DGERQF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_dormr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13039,7 +13039,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormr2 - !> DORMR3: overwrites the general real m by n matrix C with + + pure subroutine stdlib_dormr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) + !> DORMR3 overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T* C if SIDE = 'L' and TRANS = 'C', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -13049,8 +13051,6 @@ module stdlib_linalg_lapack_d !> Q = H(1) H(2) . . . H(k) !> as returned by DTZRZF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_dormr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13138,7 +13138,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormr3 - !> DORMRQ: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_dormrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> DORMRQ overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -13147,8 +13149,6 @@ module stdlib_linalg_lapack_d !> Q = H(1) H(2) . . . H(k) !> as returned by DGERQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_dormrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13281,7 +13281,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormrq - !> DORMRZ: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_dormrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & + !> DORMRZ overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -13290,8 +13292,6 @@ module stdlib_linalg_lapack_d !> Q = H(1) H(2) . . . H(k) !> as returned by DTZRZF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_dormrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13434,7 +13434,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormrz - !> DPBEQU: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_dpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) + !> DPBEQU computes row and column scalings intended to equilibrate a !> symmetric positive definite band matrix A and reduce its condition !> number (with respect to the two-norm). S contains the scale factors, !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with @@ -13442,8 +13444,6 @@ module stdlib_linalg_lapack_d !> choice of S puts the condition number of B within a factor N of the !> smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_dpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13521,7 +13521,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpbequ - !> DPBSTF: computes a split Cholesky factorization of a real + + pure subroutine stdlib_dpbstf( uplo, n, kd, ab, ldab, info ) + !> DPBSTF computes a split Cholesky factorization of a real !> symmetric positive definite band matrix A. !> This routine is designed to be used in conjunction with DSBGST. !> The factorization has the form A = S**T*S where S is a band matrix @@ -13530,8 +13532,6 @@ module stdlib_linalg_lapack_d !> ( M L ) !> where U is upper triangular of order m = (n+kd)/2, and L is lower !> triangular of order n-m. - - pure subroutine stdlib_dpbstf( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13639,7 +13639,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpbstf - !> DPBTF2: computes the Cholesky factorization of a real symmetric + + pure subroutine stdlib_dpbtf2( uplo, n, kd, ab, ldab, info ) + !> DPBTF2 computes the Cholesky factorization of a real symmetric !> positive definite band matrix A. !> The factorization has the form !> A = U**T * U , if UPLO = 'U', or @@ -13647,8 +13649,6 @@ module stdlib_linalg_lapack_d !> where U is an upper triangular matrix, U**T is the transpose of U, and !> L is lower triangular. !> This is the unblocked version of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_dpbtf2( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13726,11 +13726,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpbtf2 - !> DPBTRS: solves a system of linear equations A*X = B with a symmetric - !> positive definite band matrix A using the Cholesky factorization - !> A = U**T*U or A = L*L**T computed by DPBTRF. pure subroutine stdlib_dpbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) + !> DPBTRS solves a system of linear equations A*X = B with a symmetric + !> positive definite band matrix A using the Cholesky factorization + !> A = U**T*U or A = L*L**T computed by DPBTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13794,7 +13794,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpbtrs - !> DPOEQU: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_dpoequ( n, a, lda, s, scond, amax, info ) + !> DPOEQU computes row and column scalings intended to equilibrate a !> symmetric positive definite matrix A and reduce its condition number !> (with respect to the two-norm). S contains the scale factors, !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with @@ -13802,8 +13804,6 @@ module stdlib_linalg_lapack_d !> choice of S puts the condition number of B within a factor N of the !> smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_dpoequ( n, a, lda, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13868,7 +13868,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpoequ - !> DPOEQUB: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_dpoequb( n, a, lda, s, scond, amax, info ) + !> DPOEQUB computes row and column scalings intended to equilibrate a !> symmetric positive definite matrix A and reduce its condition number !> (with respect to the two-norm). S contains the scale factors, !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with @@ -13881,8 +13883,6 @@ module stdlib_linalg_lapack_d !> these factors introduces no additional rounding errors. However, the !> scaled diagonal entries are no longer approximately 1 but lie !> between sqrt(radix) and 1/sqrt(radix). - - pure subroutine stdlib_dpoequb( n, a, lda, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13950,11 +13950,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpoequb - !> DPOTRS: solves a system of linear equations A*X = B with a symmetric - !> positive definite matrix A using the Cholesky factorization - !> A = U**T*U or A = L*L**T computed by DPOTRF. pure subroutine stdlib_dpotrs( uplo, n, nrhs, a, lda, b, ldb, info ) + !> DPOTRS solves a system of linear equations A*X = B with a symmetric + !> positive definite matrix A using the Cholesky factorization + !> A = U**T*U or A = L*L**T computed by DPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14012,7 +14012,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpotrs - !> DPPEQU: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_dppequ( uplo, n, ap, s, scond, amax, info ) + !> DPPEQU computes row and column scalings intended to equilibrate a !> symmetric positive definite matrix A in packed storage and reduce !> its condition number (with respect to the two-norm). S contains the !> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix @@ -14020,8 +14022,6 @@ module stdlib_linalg_lapack_d !> This choice of S puts the condition number of B within a factor N of !> the smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_dppequ( uplo, n, ap, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14105,14 +14105,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dppequ - !> DPPTRF: computes the Cholesky factorization of a real symmetric + + pure subroutine stdlib_dpptrf( uplo, n, ap, info ) + !> DPPTRF computes the Cholesky factorization of a real symmetric !> positive definite matrix A stored in packed format. !> The factorization has the form !> A = U**T * U, if UPLO = 'U', or !> A = L * L**T, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. - - pure subroutine stdlib_dpptrf( uplo, n, ap, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14190,11 +14190,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpptrf - !> DPPTRS: solves a system of linear equations A*X = B with a symmetric - !> positive definite matrix A in packed storage using the Cholesky - !> factorization A = U**T*U or A = L*L**T computed by DPPTRF. pure subroutine stdlib_dpptrs( uplo, n, nrhs, ap, b, ldb, info ) + !> DPPTRS solves a system of linear equations A*X = B with a symmetric + !> positive definite matrix A in packed storage using the Cholesky + !> factorization A = U**T*U or A = L*L**T computed by DPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14252,15 +14252,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpptrs - !> DPTCON: computes the reciprocal of the condition number (in the + + pure subroutine stdlib_dptcon( n, d, e, anorm, rcond, work, info ) + !> DPTCON computes the reciprocal of the condition number (in the !> 1-norm) of a real symmetric positive definite tridiagonal matrix !> using the factorization A = L*D*L**T or A = U**T*D*U computed by !> DPTTRF. !> Norm(inv(A)) is computed by a direct method, and the reciprocal of !> the condition number is computed as !> RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_dptcon( n, d, e, anorm, rcond, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14325,11 +14325,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dptcon - !> DPTTRF: computes the L*D*L**T factorization of a real symmetric - !> positive definite tridiagonal matrix A. The factorization may also - !> be regarded as having the form A = U**T*D*U. pure subroutine stdlib_dpttrf( n, d, e, info ) + !> DPTTRF computes the L*D*L**T factorization of a real symmetric + !> positive definite tridiagonal matrix A. The factorization may also + !> be regarded as having the form A = U**T*D*U. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14408,14 +14408,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpttrf - !> DPTTS2: solves a tridiagonal system of the form + + pure subroutine stdlib_dptts2( n, nrhs, d, e, b, ldb ) + !> DPTTS2 solves a tridiagonal system of the form !> A * X = B !> using the L*D*L**T factorization of A computed by DPTTRF. D is a !> diagonal matrix specified in the vector D, L is a unit bidiagonal !> matrix whose subdiagonal is specified in the vector E, and X and B !> are N by NRHS matrices. - - pure subroutine stdlib_dptts2( n, nrhs, d, e, b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14449,11 +14449,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dptts2 - !> DRSCL: multiplies an n-element real vector x by the real scalar 1/a. - !> This is done without overflow or underflow as long as - !> the final result x/a does not overflow or underflow. pure subroutine stdlib_drscl( n, sa, sx, incx ) + !> DRSCL multiplies an n-element real vector x by the real scalar 1/a. + !> This is done without overflow or underflow as long as + !> the final result x/a does not overflow or underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14503,15 +14503,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_drscl - !> DSBGST: reduces a real symmetric-definite banded generalized + + pure subroutine stdlib_dsbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, info ) + !> DSBGST reduces a real symmetric-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**T*S by DPBSTF, using a !> split Cholesky factorization. A is overwritten by C = X**T*A*X, where !> X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the !> bandwidth of A. - - pure subroutine stdlib_dsbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15416,11 +15416,11 @@ module stdlib_linalg_lapack_d go to 490 end subroutine stdlib_dsbgst - !> DSBTRD: reduces a real symmetric band matrix A to symmetric - !> tridiagonal form T by an orthogonal similarity transformation: - !> Q**T * A * Q = T. pure subroutine stdlib_dsbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) + !> DSBTRD reduces a real symmetric band matrix A to symmetric + !> tridiagonal form T by an orthogonal similarity transformation: + !> Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15747,16 +15747,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsbtrd + + pure subroutine stdlib_dsfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) !> Level 3 BLAS like routine for C in RFP Format. - !> DSFRK: performs one of the symmetric rank--k operations + !> DSFRK performs one of the symmetric rank--k operations !> C := alpha*A*A**T + beta*C, !> or !> C := alpha*A**T*A + beta*C, !> where alpha and beta are real scalars, C is an n--by--n symmetric !> matrix and A is an n--by--k matrix in the first case and a k--by--n !> matrix in the second case. - - pure subroutine stdlib_dsfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16003,15 +16003,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsfrk - !> DSPGST: reduces a real symmetric-definite generalized eigenproblem + + pure subroutine stdlib_dspgst( itype, uplo, n, ap, bp, info ) + !> DSPGST reduces a real symmetric-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**T)*A*inv(U) or inv(L)*A*inv(L**T) !> 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**T or L**T*A*L. !> B must have been previously factorized as U**T*U or L*L**T by DPPTRF. - - pure subroutine stdlib_dspgst( itype, uplo, n, ap, bp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16125,14 +16125,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspgst - !> DSPTRF: computes the factorization of a real symmetric matrix A stored + + pure subroutine stdlib_dsptrf( uplo, n, ap, ipiv, info ) + !> DSPTRF computes the factorization of a real symmetric matrix A stored !> in packed format using the Bunch-Kaufman diagonal pivoting method: !> 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 symmetric and block diagonal with !> 1-by-1 and 2-by-2 diagonal blocks. - - pure subroutine stdlib_dsptrf( uplo, n, ap, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16448,11 +16448,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsptrf - !> DSPTRI: computes the inverse of a real symmetric indefinite matrix - !> A in packed storage using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by DSPTRF. pure subroutine stdlib_dsptri( uplo, n, ap, ipiv, work, info ) + !> DSPTRI computes the inverse of a real symmetric indefinite matrix + !> A in packed storage using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by DSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16659,11 +16659,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsptri - !> DSPTRS: solves a system of linear equations A*X = B with a real - !> symmetric matrix A stored in packed format using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by DSPTRF. pure subroutine stdlib_dsptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) + !> DSPTRS solves a system of linear equations A*X = B with a real + !> symmetric matrix A stored in packed format using the factorization + !> A = U*D*U**T or A = L*D*L**T computed by DSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16879,7 +16879,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsptrs - !> DSTEBZ: computes the eigenvalues of a symmetric tridiagonal + + pure subroutine stdlib_dstebz( range, order, n, vl, vu, il, iu, abstol, d, e,m, nsplit, w, & + !> DSTEBZ computes the eigenvalues of a symmetric tridiagonal !> matrix T. The user may ask for all eigenvalues, all eigenvalues !> in the half-open interval (VL, VU], or the IL-th through IU-th !> eigenvalues. @@ -16889,8 +16891,6 @@ module stdlib_linalg_lapack_d !> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal !> Matrix", Report CS41, Computer Science Dept., Stanford !> University, July 21, 1966. - - pure subroutine stdlib_dstebz( range, order, n, vl, vu, il, iu, abstol, d, e,m, nsplit, w, & iblock, isplit, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17272,11 +17272,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dstebz - !> DSYCONV: convert A given by TRF into L and D and vice-versa. - !> Get Non-diag elements of D (returned in workspace) and - !> apply or reverse permutation done in TRF. pure subroutine stdlib_dsyconv( uplo, way, n, a, lda, ipiv, e, info ) + !> DSYCONV convert A given by TRF into L and D and vice-versa. + !> Get Non-diag elements of D (returned in workspace) and + !> apply or reverse permutation done in TRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17477,8 +17477,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyconv + + pure subroutine stdlib_dsyconvf( uplo, way, n, a, lda, e, ipiv, info ) !> If parameter WAY = 'C': - !> DSYCONVF: converts the factorization output format used in + !> DSYCONVF converts the factorization output format used in !> DSYTRF provided on entry in parameter A into the factorization !> output format used in DSYTRF_RK (or DSYTRF_BK) that is stored !> on exit in parameters A and E. It also converts in place details of @@ -17492,8 +17494,6 @@ module stdlib_linalg_lapack_d !> on exit in parameter A. It also converts in place details of !> the intechanges stored in IPIV from the format used in DSYTRF_RK !> (or DSYTRF_BK) into the format used in DSYTRF. - - pure subroutine stdlib_dsyconvf( uplo, way, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17732,8 +17732,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyconvf + + pure subroutine stdlib_dsyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) !> If parameter WAY = 'C': - !> DSYCONVF_ROOK: converts the factorization output format used in + !> DSYCONVF_ROOK converts the factorization output format used in !> DSYTRF_ROOK provided on entry in parameter A into the factorization !> output format used in DSYTRF_RK (or DSYTRF_BK) that is stored !> on exit in parameters A and E. IPIV format for DSYTRF_ROOK and @@ -17745,8 +17747,6 @@ module stdlib_linalg_lapack_d !> the factorization output format used in DSYTRF_ROOK that is stored !> on exit in parameter A. IPIV format for DSYTRF_ROOK and !> DSYTRF_RK (or DSYTRF_BK) is the same and is not converted. - - pure subroutine stdlib_dsyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17985,15 +17985,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyconvf_rook - !> DSYEQUB: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_dsyequb( uplo, n, a, lda, s, scond, amax, work, info ) + !> DSYEQUB computes row and column scalings intended to equilibrate a !> symmetric 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. - - pure subroutine stdlib_dsyequb( uplo, n, a, lda, s, scond, amax, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18161,15 +18161,15 @@ module stdlib_linalg_lapack_d scond = max( smin, smlnum ) / min( smax, bignum ) end subroutine stdlib_dsyequb - !> DSYGS2: reduces a real symmetric-definite generalized eigenproblem + + pure subroutine stdlib_dsygs2( itype, uplo, n, a, lda, b, ldb, info ) + !> DSYGS2 reduces a real symmetric-definite generalized eigenproblem !> to standard form. !> If ITYPE = 1, the problem is A*x = lambda*B*x, !> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) !> 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**T or L**T *A*L. !> B must have been previously factorized as U**T *U or L*L**T by DPOTRF. - - pure subroutine stdlib_dsygs2( itype, uplo, n, a, lda, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18284,15 +18284,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsygs2 - !> DSYGST: reduces a real symmetric-definite generalized eigenproblem + + pure subroutine stdlib_dsygst( itype, uplo, n, a, lda, b, ldb, info ) + !> DSYGST reduces a real symmetric-definite generalized eigenproblem !> to standard form. !> If ITYPE = 1, the problem is A*x = lambda*B*x, !> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) !> 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**T or L**T*A*L. !> B must have been previously factorized as U**T*U or L*L**T by DPOTRF. - - pure subroutine stdlib_dsygst( itype, uplo, n, a, lda, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18423,10 +18423,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsygst - !> DSYSWAPR: applies an elementary permutation on the rows and the columns of - !> a symmetric matrix. pure subroutine stdlib_dsyswapr( uplo, n, a, lda, i1, i2) + !> DSYSWAPR applies an elementary permutation on the rows and the columns of + !> a symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18491,7 +18491,9 @@ module stdlib_linalg_lapack_d endif end subroutine stdlib_dsyswapr - !> DSYTF2_RK: computes the factorization of a real symmetric matrix A + + pure subroutine stdlib_dsytf2_rk( uplo, n, a, lda, e, ipiv, info ) + !> DSYTF2_RK computes the factorization of a real symmetric matrix A !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), !> where U (or L) is unit upper (or lower) triangular matrix, @@ -18500,8 +18502,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dsytf2_rk( uplo, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18943,15 +18943,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytf2_rk - !> DSYTF2_ROOK: computes the factorization of a real symmetric matrix A + + pure subroutine stdlib_dsytf2_rook( uplo, n, a, lda, ipiv, info ) + !> DSYTF2_ROOK computes the factorization of a real symmetric matrix A !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: !> 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, U**T is the transpose of U, and D is symmetric 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. - - pure subroutine stdlib_dsytf2_rook( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19354,7 +19354,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytf2_rook - !> DSYTRF_RK: computes the factorization of a real symmetric matrix A + + pure subroutine stdlib_dsytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) + !> DSYTRF_RK computes the factorization of a real symmetric matrix A !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), !> where U (or L) is unit upper (or lower) triangular matrix, @@ -19363,8 +19365,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dsytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19520,7 +19520,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrf_rk - !> DSYTRF_ROOK: computes the factorization of a real symmetric matrix A + + pure subroutine stdlib_dsytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) + !> DSYTRF_ROOK computes the factorization of a real symmetric 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 @@ -19528,8 +19530,6 @@ module stdlib_linalg_lapack_d !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_dsytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19648,11 +19648,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrf_rook - !> DSYTRI: computes the inverse of a real symmetric indefinite matrix - !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by - !> DSYTRF. pure subroutine stdlib_dsytri( uplo, n, a, lda, ipiv, work, info ) + !> DSYTRI computes the inverse of a real symmetric indefinite matrix + !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by + !> DSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19836,11 +19836,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytri - !> DSYTRI_ROOK: computes the inverse of a real symmetric - !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T - !> computed by DSYTRF_ROOK. pure subroutine stdlib_dsytri_rook( uplo, n, a, lda, ipiv, work, info ) + !> DSYTRI_ROOK computes the inverse of a real symmetric + !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T + !> computed by DSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20064,11 +20064,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytri_rook - !> DSYTRS: solves a system of linear equations A*X = B with a real - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by DSYTRF. pure subroutine stdlib_dsytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) + !> DSYTRS solves a system of linear equations A*X = B with a real + !> symmetric matrix A using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by DSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20274,11 +20274,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrs - !> DSYTRS2: solves a system of linear equations A*X = B with a real - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by DSYTRF and converted by DSYCONV. pure subroutine stdlib_dsytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) + !> DSYTRS2 solves a system of linear equations A*X = B with a real + !> symmetric matrix A using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by DSYTRF and converted by DSYCONV. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20452,7 +20452,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrs2 - !> DSYTRS_3: solves a system of linear equations A * X = B with a real + + pure subroutine stdlib_dsytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) + !> DSYTRS_3 solves a system of linear equations A * X = B with a real !> symmetric matrix A using the factorization computed !> by DSYTRF_RK or DSYTRF_BK: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), @@ -20461,8 +20463,6 @@ module stdlib_linalg_lapack_d !> matrix, P**T is the transpose of P, and D is symmetric and block !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. !> This algorithm is using Level 3 BLAS. - - pure subroutine stdlib_dsytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20609,11 +20609,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrs_3 - !> DSYTRS_AA: solves a system of linear equations A*X = B with a real - !> symmetric matrix A using the factorization A = U**T*T*U or - !> A = L*T*L**T computed by DSYTRF_AA. pure subroutine stdlib_dsytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) + !> DSYTRS_AA solves a system of linear equations A*X = B with a real + !> symmetric matrix A using the factorization A = U**T*T*U or + !> A = L*T*L**T computed by DSYTRF_AA. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20728,11 +20728,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrs_aa - !> DSYTRS_ROOK: solves a system of linear equations A*X = B with - !> a real symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by DSYTRF_ROOK. pure subroutine stdlib_dsytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) + !> DSYTRS_ROOK solves a system of linear equations A*X = B with + !> a real symmetric matrix A using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by DSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20950,14 +20950,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrs_rook - !> DTBRFS: provides error bounds and backward error estimates for the + + pure subroutine stdlib_dtbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& + !> DTBRFS provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular band !> coefficient matrix. !> The solution matrix X must be computed by DTBTRS or some other !> means before entering this routine. DTBRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_dtbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21188,12 +21188,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtbrfs - !> DTBTRS: solves a triangular system of the form + + pure subroutine stdlib_dtbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) + !> DTBTRS solves a triangular system of the form !> A * X = B or A**T * X = B, !> where A is a triangular band matrix of order N, and B is an !> N-by NRHS matrix. A check is made to verify that A is nonsingular. - - pure subroutine stdlib_dtbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21261,16 +21261,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtbtrs + + pure subroutine stdlib_dtfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) !> Level 3 BLAS like routine for A in RFP Format. - !> DTFSM: solves the matrix equation + !> DTFSM solves the matrix equation !> op( A )*X = alpha*B or X*op( A ) = alpha*B !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T. !> A is in Rectangular Full Packed (RFP) Format. !> The matrix X is overwritten on B. - - pure subroutine stdlib_dtfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21763,10 +21763,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtfsm - !> DTFTTP: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard packed format (TP). pure subroutine stdlib_dtfttp( transr, uplo, n, arf, ap, info ) + !> DTFTTP copies a triangular matrix A from rectangular full packed + !> format (TF) to standard packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22019,10 +22019,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtfttp - !> DTFTTR: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard full format (TR). pure subroutine stdlib_dtfttr( transr, uplo, n, arf, a, lda, info ) + !> DTFTTR copies a triangular matrix A from rectangular full packed + !> format (TF) to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22248,11 +22248,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtfttr - !> DTPRFB: applies a real "triangular-pentagonal" block reflector H or its - !> transpose H**T to a real matrix C, which is composed of two - !> blocks A and B, either from the left or right. pure subroutine stdlib_dtprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & + !> DTPRFB applies a real "triangular-pentagonal" block reflector H or its + !> transpose H**T to a real matrix C, which is composed of two + !> blocks A and B, either from the left or right. lda, b, ldb, work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22666,14 +22666,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtprfb - !> DTPRFS: provides error bounds and backward error estimates for the + + pure subroutine stdlib_dtprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & + !> DTPRFS provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular packed !> coefficient matrix. !> The solution matrix X must be computed by DTPTRS or some other !> means before entering this routine. DTPRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_dtprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22911,10 +22911,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtprfs - !> DTPTRI: computes the inverse of a real upper or lower triangular - !> matrix A stored in packed format. pure subroutine stdlib_dtptri( uplo, diag, n, ap, info ) + !> DTPTRI computes the inverse of a real upper or lower triangular + !> matrix A stored in packed format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23001,13 +23001,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtptri - !> DTPTRS: solves a triangular system of the form + + pure subroutine stdlib_dtptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) + !> DTPTRS solves a triangular system of the form !> A * X = B or A**T * X = B, !> where A is a triangular matrix of order N stored in packed format, !> and B is an N-by-NRHS matrix. A check is made to verify that A is !> nonsingular. - - pure subroutine stdlib_dtptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23074,10 +23074,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtptrs - !> DTPTTF: copies a triangular matrix A from standard packed format (TP) - !> to rectangular full packed format (TF). pure subroutine stdlib_dtpttf( transr, uplo, n, ap, arf, info ) + !> DTPTTF copies a triangular matrix A from standard packed format (TP) + !> to rectangular full packed format (TF). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23316,10 +23316,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtpttf - !> DTPTTR: copies a triangular matrix A from standard packed format (TP) - !> to standard full format (TR). pure subroutine stdlib_dtpttr( uplo, n, ap, a, lda, info ) + !> DTPTTR copies a triangular matrix A from standard packed format (TP) + !> to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23370,14 +23370,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtpttr - !> DTRRFS: provides error bounds and backward error estimates for the + + pure subroutine stdlib_dtrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& + !> DTRRFS provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular !> coefficient matrix. !> The solution matrix X must be computed by DTRTRS or some other !> means before entering this routine. DTRRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_dtrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23605,11 +23605,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrrfs - !> DTRTI2: computes the inverse of a real upper or lower triangular - !> matrix. - !> This is the Level 2 BLAS version of the algorithm. pure subroutine stdlib_dtrti2( uplo, diag, n, a, lda, info ) + !> DTRTI2 computes the inverse of a real upper or lower triangular + !> matrix. + !> This is the Level 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23679,11 +23679,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrti2 - !> DTRTRI: computes the inverse of a real upper or lower triangular - !> matrix A. - !> This is the Level 3 BLAS version of the algorithm. pure subroutine stdlib_dtrtri( uplo, diag, n, a, lda, info ) + !> DTRTRI computes the inverse of a real upper or lower triangular + !> matrix A. + !> This is the Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23766,12 +23766,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrtri - !> DTRTRS: solves a triangular system of the form + + pure subroutine stdlib_dtrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) + !> DTRTRS solves a triangular system of the form !> A * X = B or A**T * X = B, !> where A is a triangular matrix of order N, and B is an N-by-NRHS !> matrix. A check is made to verify that A is nonsingular. - - pure subroutine stdlib_dtrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23826,10 +23826,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrtrs - !> DTRTTF: copies a triangular matrix A from standard full format (TR) - !> to rectangular full packed format (TF) . pure subroutine stdlib_dtrttf( transr, uplo, n, a, lda, arf, info ) + !> DTRTTF copies a triangular matrix A from standard full format (TR) + !> to rectangular full packed format (TF) . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24054,10 +24054,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrttf - !> DTRTTP: copies a triangular matrix A from full format (TR) to standard - !> packed format (TP). pure subroutine stdlib_dtrttp( uplo, n, a, lda, ap, info ) + !> DTRTTP copies a triangular matrix A from full format (TR) to standard + !> packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24108,12 +24108,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrttp - !> DZSUM1: takes the sum of the absolute values of a complex + + pure real(dp) function stdlib_dzsum1( n, cx, incx ) + !> DZSUM1 takes the sum of the absolute values of a complex !> vector and returns a double precision result. !> Based on DZASUM from the Level 1 BLAS. !> The change is to use the 'genuine' absolute value. - - pure real(dp) function stdlib_dzsum1( n, cx, incx ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24151,14 +24151,14 @@ module stdlib_linalg_lapack_d end function stdlib_dzsum1 #:if WITH_QP - !> DLAG2Q: converts a SINGLE PRECISION matrix, SA, to a DOUBLE + + pure subroutine stdlib_dlag2q( m, n, sa, ldsa, a, lda, info ) + !> DLAG2Q converts a SINGLE PRECISION matrix, SA, to a DOUBLE !> PRECISION matrix, A. !> Note that while it is possible to overflow while converting !> from double to single, it is not possible to overflow when !> converting from single to double. !> This is an auxiliary routine so there is no argument checking. - - pure subroutine stdlib_dlag2q( m, n, sa, ldsa, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24181,7 +24181,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlag2q #:endif - !> DBBCSD: computes the CS decomposition of an orthogonal matrix in + + pure subroutine stdlib_dbbcsd( jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q,theta, phi, u1, & + !> DBBCSD computes the CS decomposition of an orthogonal matrix in !> bidiagonal-block form, !> [ B11 | B12 0 0 ] !> [ 0 | 0 -I 0 ] @@ -24202,8 +24204,6 @@ module stdlib_linalg_lapack_d !> The orthogonal matrices U1, U2, V1T, and V2T are input/output. !> The input matrices are pre- or post-multiplied by the appropriate !> singular vector matrices. - - pure subroutine stdlib_dbbcsd( 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, work, & lwork, info ) ! -- lapack computational routine -- @@ -24789,7 +24789,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dbbcsd - !> DDISNA: computes the reciprocal condition numbers for the eigenvectors + + pure subroutine stdlib_ddisna( job, m, n, d, sep, info ) + !> DDISNA 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 @@ -24802,8 +24804,6 @@ module stdlib_linalg_lapack_d !> the error bound. !> DDISNA may also be used to compute error bounds for eigenvectors of !> the generalized symmetric definite eigenproblem. - - pure subroutine stdlib_ddisna( job, m, n, d, sep, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24894,12 +24894,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_ddisna - !> DGBBRD: reduces a real general m-by-n band matrix A to upper + + pure subroutine stdlib_dgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & + !> DGBBRD reduces a real general m-by-n band matrix A to upper !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. !> The routine computes B, and optionally forms Q or P**T, or computes !> Q**T*C for a given matrix C. - - pure subroutine stdlib_dgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25151,14 +25151,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbbrd - !> DGBCON: estimates the reciprocal of the condition number of a real + + pure subroutine stdlib_dgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, iwork, & + !> DGBCON estimates the reciprocal of the condition number of a real !> general band matrix A, in either the 1-norm or the infinity-norm, !> using the LU factorization computed by DGBTRF. !> 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)) ). - - pure subroutine stdlib_dgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, iwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25280,7 +25280,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbcon - !> DGBEQU: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_dgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) + !> DGBEQU 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 @@ -25289,8 +25291,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25410,7 +25410,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbequ - !> DGBEQUB: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_dgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) + !> DGBEQUB 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 @@ -25425,8 +25427,6 @@ module stdlib_linalg_lapack_d !> 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). - - pure subroutine stdlib_dgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25555,11 +25555,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbequb - !> DGBRFS: 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. pure subroutine stdlib_dgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, x, & + !> DGBRFS 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. ldx, ferr, berr, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25756,11 +25756,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbrfs - !> DGBTRF: computes an LU factorization of a real m-by-n band matrix A - !> using partial pivoting with row interchanges. - !> This is the blocked version of the algorithm, calling Level 3 BLAS. pure subroutine stdlib_dgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) + !> DGBTRF computes an LU factorization of a real m-by-n band matrix A + !> using partial pivoting with row interchanges. + !> This is the blocked version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26006,14 +26006,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbtrf - !> DGECON: estimates the reciprocal of the condition number of a general + + pure subroutine stdlib_dgecon( norm, n, a, lda, anorm, rcond, work, iwork,info ) + !> DGECON estimates the reciprocal of the condition number of a general !> real matrix A, in either the 1-norm or the infinity-norm, using !> the LU factorization computed by DGETRF. !> 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)) ). - - pure subroutine stdlib_dgecon( norm, n, a, lda, anorm, rcond, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26107,7 +26107,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgecon - !> DGEEQU: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_dgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) + !> DGEEQU 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 @@ -26116,8 +26118,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26230,7 +26230,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeequ - !> DGEEQUB: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_dgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) + !> DGEEQUB 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 @@ -26245,8 +26247,6 @@ module stdlib_linalg_lapack_d !> 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). - - pure subroutine stdlib_dgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26369,7 +26369,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeequb - !> DGEMLQT: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_dgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) + !> DGEMLQT overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q C C Q !> TRANS = 'T': Q**T C C Q**T @@ -26378,8 +26380,6 @@ module stdlib_linalg_lapack_d !> Q = H(1) H(2) . . . H(K) = I - V T V**T !> generated using the compact WY representation as returned by DGELQT. !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. - - pure subroutine stdlib_dgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26467,7 +26467,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgemlqt - !> DGEMQRT: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_dgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) + !> DGEMQRT overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q C C Q !> TRANS = 'T': Q**T C C Q**T @@ -26476,8 +26478,6 @@ module stdlib_linalg_lapack_d !> Q = H(1) H(2) . . . H(K) = I - V T V**T !> generated using the compact WY representation as returned by DGEQRT. !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. - - pure subroutine stdlib_dgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26565,12 +26565,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgemqrt - !> DGESC2: solves a system of linear equations + + pure subroutine stdlib_dgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) + !> DGESC2 solves a system of linear equations !> A * X = scale* RHS !> with a general N-by-N matrix A using the LU factorization with !> complete pivoting computed by DGETC2. - - pure subroutine stdlib_dgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26623,13 +26623,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgesc2 - !> DGETC2: computes an LU factorization with complete pivoting of the + + pure subroutine stdlib_dgetc2( n, a, lda, ipiv, jpiv, info ) + !> DGETC2 computes an LU factorization with complete pivoting of the !> n-by-n matrix A. The factorization has the form A = P * L * U * Q, !> where P and Q are permutation matrices, L is lower triangular with !> unit diagonal elements and U is upper triangular. !> This is the Level 2 BLAS algorithm. - - pure subroutine stdlib_dgetc2( n, a, lda, ipiv, jpiv, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26707,7 +26707,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetc2 - !> DGETF2: computes an LU factorization of a general m-by-n matrix A + + pure subroutine stdlib_dgetf2( m, n, a, lda, ipiv, info ) + !> DGETF2 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 @@ -26715,8 +26717,6 @@ module stdlib_linalg_lapack_d !> diagonal elements (lower trapezoidal if m > n), and U is upper !> triangular (upper trapezoidal if m < n). !> This is the right-looking Level 2 BLAS version of the algorithm. - - pure subroutine stdlib_dgetf2( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26780,7 +26780,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetf2 - !> DGETRF2: computes an LU factorization of a general M-by-N matrix A + + pure recursive subroutine stdlib_dgetrf2( m, n, a, lda, ipiv, info ) + !> DGETRF2 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 @@ -26799,8 +26801,6 @@ module stdlib_linalg_lapack_d !> do the swaps on [ --- ], solve A12, update A22, !> [ A22 ] !> then calls itself to factor A22 and do the swaps on A21. - - pure recursive subroutine stdlib_dgetrf2( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26895,12 +26895,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetrf2 - !> DGETRI: computes the inverse of a matrix using the LU factorization + + pure subroutine stdlib_dgetri( n, a, lda, ipiv, work, lwork, info ) + !> DGETRI computes the inverse of a matrix using the LU factorization !> computed by DGETRF. !> This method inverts U and then computes inv(A) by solving the system !> inv(A)*L = inv(U) for inv(A). - - pure subroutine stdlib_dgetri( n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26997,12 +26997,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetri - !> DGETRS: solves a system of linear equations + + pure subroutine stdlib_dgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) + !> DGETRS solves a system of linear equations !> A * X = B or A**T * X = B !> with a general N-by-N matrix A using the LU factorization computed !> by DGETRF. - - pure subroutine stdlib_dgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27066,7 +27066,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetrs - !> DGGBAL: balances a pair of general real matrices (A,B). This + + pure subroutine stdlib_dggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) + !> DGGBAL balances a pair of general real 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 @@ -27075,8 +27077,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27360,7 +27360,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggbal - !> DGGHRD: reduces a pair of real matrices (A,B) to generalized upper + + pure subroutine stdlib_dgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & + !> DGGHRD reduces a pair of real matrices (A,B) to generalized upper !> Hessenberg form using orthogonal transformations, where A is a !> general matrix and B is upper triangular. The form of the !> generalized eigenvalue problem is @@ -27383,8 +27385,6 @@ module stdlib_linalg_lapack_d !> If Q1 is the orthogonal matrix from the QR factorization of B in the !> original equation A*x = lambda*B*x, then DGGHRD reduces the original !> problem to generalized Hessenberg form. - - pure subroutine stdlib_dgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27490,12 +27490,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgghrd - !> DGTTRS: solves one of the systems of equations + + pure subroutine stdlib_dgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) + !> DGTTRS solves one of the systems of equations !> A*X = B or A**T*X = B, !> with a tridiagonal matrix A using the LU factorization computed !> by DGTTRF. - - pure subroutine stdlib_dgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27554,11 +27554,11 @@ module stdlib_linalg_lapack_d end if end subroutine stdlib_dgttrs - !> DISNAN: returns .TRUE. if its argument is NaN, and .FALSE. - !> otherwise. To be replaced by the Fortran 2003 intrinsic in the - !> future. pure logical(lk) function stdlib_disnan( din ) + !> DISNAN returns .TRUE. if its argument is NaN, and .FALSE. + !> otherwise. To be replaced by the Fortran 2003 intrinsic in the + !> future. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27570,7 +27570,9 @@ module stdlib_linalg_lapack_d return end function stdlib_disnan - !> DLA_GBAMV: performs one of the matrix-vector operations + + subroutine stdlib_dla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) + !> DLA_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 @@ -27583,8 +27585,6 @@ module stdlib_linalg_lapack_d !> "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. - - subroutine stdlib_dla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27756,7 +27756,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dla_gbamv - !> DLA_GBRCOND: Estimates the Skeel condition number of op(A) * op2(C) + + real(dp) function stdlib_dla_gbrcond( trans, n, kl, ku, ab, ldab,afb, ldafb, ipiv, cmode, c,& + !> DLA_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 @@ -27765,8 +27767,6 @@ module stdlib_linalg_lapack_d !> 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. - - real(dp) function stdlib_dla_gbrcond( trans, n, kl, ku, ab, ldab,afb, ldafb, ipiv, cmode, c,& info, work, iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27914,7 +27914,9 @@ module stdlib_linalg_lapack_d return end function stdlib_dla_gbrcond - !> DLA_GEAMV: performs one of the matrix-vector operations + + subroutine stdlib_dla_geamv ( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) + !> DLA_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 @@ -27927,8 +27929,6 @@ module stdlib_linalg_lapack_d !> "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. - - subroutine stdlib_dla_geamv ( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28093,7 +28093,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dla_geamv - !> DLA_GERCOND: estimates the Skeel condition number of op(A) * op2(C) + + real(dp) function stdlib_dla_gercond( trans, n, a, lda, af,ldaf, ipiv, cmode, c,info, work, & + !> DLA_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 @@ -28102,8 +28104,6 @@ module stdlib_linalg_lapack_d !> 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. - - real(dp) function stdlib_dla_gercond( trans, n, a, lda, af,ldaf, ipiv, cmode, c,info, work, & iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28243,13 +28243,13 @@ module stdlib_linalg_lapack_d return end function stdlib_dla_gercond - !> DLA_LIN_BERR: computes component-wise relative backward error from + + pure subroutine stdlib_dla_lin_berr ( n, nz, nrhs, res, ayb, berr ) + !> DLA_LIN_BERR computes component-wise 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 component-wise absolute value of the matrix !> or vector Z. - - pure subroutine stdlib_dla_lin_berr ( n, nz, nrhs, res, ayb, berr ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28284,7 +28284,9 @@ module stdlib_linalg_lapack_d end do end subroutine stdlib_dla_lin_berr - !> DLA_PORCOND: Estimates the Skeel condition number of op(A) * op2(C) + + real(dp) function stdlib_dla_porcond( uplo, n, a, lda, af, ldaf,cmode, c, info, work,iwork ) + !> DLA_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 @@ -28293,8 +28295,6 @@ module stdlib_linalg_lapack_d !> 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. - - real(dp) function stdlib_dla_porcond( uplo, n, a, lda, af, ldaf,cmode, c, info, work,iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28443,7 +28443,9 @@ module stdlib_linalg_lapack_d return end function stdlib_dla_porcond - !> DLA_SYAMV: performs the matrix-vector operation + + subroutine stdlib_dla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) + !> DLA_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. @@ -28455,8 +28457,6 @@ module stdlib_linalg_lapack_d !> "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. - - subroutine stdlib_dla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28632,7 +28632,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dla_syamv - !> DLA_SYRCOND: estimates the Skeel condition number of op(A) * op2(C) + + real(dp) function stdlib_dla_syrcond( uplo, n, a, lda, af, ldaf,ipiv, cmode, c, info, work,& + !> DLA_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 @@ -28641,8 +28643,6 @@ module stdlib_linalg_lapack_d !> 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. - - real(dp) function stdlib_dla_syrcond( uplo, n, a, lda, af, ldaf,ipiv, cmode, c, info, work,& iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28799,14 +28799,14 @@ module stdlib_linalg_lapack_d return end function stdlib_dla_syrcond - !> DLA_SYRPVGRW: computes the reciprocal pivot growth factor + + real(dp) function stdlib_dla_syrpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) + !> DLA_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. - - real(dp) function stdlib_dla_syrpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29005,7 +29005,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dladiv1 - !> DLAED6: computes the positive or negative root (closest to the origin) + + pure subroutine stdlib_dlaed6( kniter, orgati, rho, d, z, finit, tau, info ) + !> DLAED6 computes the positive or negative root (closest to the origin) !> of !> z(1) z(2) z(3) !> f(x) = rho + --------- + ---------- + --------- @@ -29016,8 +29018,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dlaed6( kniter, orgati, rho, d, z, finit, tau, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29231,7 +29231,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed6 - !> DLAGS2: computes 2-by-2 orthogonal matrices U, V and Q, such + + pure subroutine stdlib_dlags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) + !> DLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such !> that if ( UPPER ) then !> U**T *A*Q = U**T *( A1 A2 )*Q = ( x 0 ) !> ( 0 A3 ) ( x x ) @@ -29248,8 +29250,6 @@ module stdlib_linalg_lapack_d !> U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ ) !> ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ ) !> Z**T denotes the transpose of Z. - - pure subroutine stdlib_dlags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29391,7 +29391,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlags2 - !> DLAGTF: factorizes the matrix (T - lambda*I), where T is an n by n + + pure subroutine stdlib_dlagtf( n, a, lambda, b, c, tol, d, in, info ) + !> DLAGTF 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 @@ -29403,8 +29405,6 @@ module stdlib_linalg_lapack_d !> The parameter LAMBDA is included in the routine so that DLAGTF may !> be used, in conjunction with DLAGTS, to obtain eigenvectors of T by !> inverse iteration. - - pure subroutine stdlib_dlagtf( n, a, lambda, b, c, tol, d, in, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29482,7 +29482,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlagtf - !> DLAGTS: may be used to solve one of the systems of equations + + pure subroutine stdlib_dlagts( job, n, a, b, c, d, in, y, tol, info ) + !> DLAGTS 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 @@ -29491,8 +29493,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dlagts( job, n, a, b, c, d, in, y, tol, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29679,7 +29679,9 @@ module stdlib_linalg_lapack_d end if end subroutine stdlib_dlagts - !> DLAIC1: applies one step of incremental condition estimation in + + pure subroutine stdlib_dlaic1( job, j, x, sest, w, gamma, sestpr, s, c ) + !> DLAIC1 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 @@ -29699,8 +29701,6 @@ module stdlib_linalg_lapack_d !> diag(sest*sest, 0) + [alpha gamma] * [ alpha ] !> [ gamma ] !> where alpha = x**T*w. - - pure subroutine stdlib_dlaic1( job, j, x, sest, w, gamma, sestpr, s, c ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29891,7 +29891,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaic1 - !> DLANEG: computes the Sturm count, the number of negative pivots + + pure integer(ilp) function stdlib_dlaneg( n, d, lld, sigma, pivmin, r ) + !> DLANEG 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 @@ -29906,8 +29908,6 @@ module stdlib_linalg_lapack_d !> 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.) - - pure integer(ilp) function stdlib_dlaneg( n, d, lld, sigma, pivmin, r ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29996,11 +29996,11 @@ module stdlib_linalg_lapack_d stdlib_dlaneg = negcnt end function stdlib_dlaneg - !> DLANGB: 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. real(dp) function stdlib_dlangb( norm, n, kl, ku, ab, ldab,work ) + !> DLANGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30071,11 +30071,11 @@ module stdlib_linalg_lapack_d return end function stdlib_dlangb - !> DLANGE: 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 matrix A. real(dp) function stdlib_dlange( norm, m, n, a, lda, work ) + !> DLANGE 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 matrix A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30143,11 +30143,11 @@ module stdlib_linalg_lapack_d return end function stdlib_dlange - !> DLANGT: 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 tridiagonal matrix A. pure real(dp) function stdlib_dlangt( norm, n, dl, d, du ) + !> DLANGT 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 tridiagonal matrix A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30219,11 +30219,11 @@ module stdlib_linalg_lapack_d return end function stdlib_dlangt - !> DLANHS: 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. real(dp) function stdlib_dlanhs( norm, n, a, lda, work ) + !> DLANHS 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30291,11 +30291,11 @@ module stdlib_linalg_lapack_d return end function stdlib_dlanhs - !> DLANSB: 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. real(dp) function stdlib_dlansb( norm, uplo, n, k, ab, ldab,work ) + !> DLANSB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30396,11 +30396,11 @@ module stdlib_linalg_lapack_d return end function stdlib_dlansb - !> DLANSF: 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. real(dp) function stdlib_dlansf( norm, transr, uplo, n, a, work ) + !> DLANSF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31100,11 +31100,11 @@ module stdlib_linalg_lapack_d return end function stdlib_dlansf - !> DLANSP: 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, supplied in packed form. real(dp) function stdlib_dlansp( norm, uplo, n, ap, work ) + !> DLANSP 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, supplied in packed form. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31224,11 +31224,11 @@ module stdlib_linalg_lapack_d return end function stdlib_dlansp - !> DLANST: 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. pure real(dp) function stdlib_dlanst( norm, n, d, e ) + !> DLANST 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31286,11 +31286,11 @@ module stdlib_linalg_lapack_d return end function stdlib_dlanst - !> DLANSY: 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. real(dp) function stdlib_dlansy( norm, uplo, n, a, lda, work ) + !> DLANSY 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31382,11 +31382,11 @@ module stdlib_linalg_lapack_d return end function stdlib_dlansy - !> DLANTB: 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. real(dp) function stdlib_dlantb( norm, uplo, diag, n, k, ab,ldab, work ) + !> DLANTB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31575,11 +31575,11 @@ module stdlib_linalg_lapack_d return end function stdlib_dlantb - !> DLANTP: 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. real(dp) function stdlib_dlantp( norm, uplo, diag, n, ap, work ) + !> DLANTP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31781,11 +31781,11 @@ module stdlib_linalg_lapack_d return end function stdlib_dlantp - !> DLANTR: 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. real(dp) function stdlib_dlantr( norm, uplo, diag, m, n, a, lda,work ) + !> DLANTR 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31967,7 +31967,9 @@ module stdlib_linalg_lapack_d return end function stdlib_dlantr - !> DLAORHR_COL_GETRFNP: computes the modified LU factorization without + + pure subroutine stdlib_dlaorhr_col_getrfnp( m, n, a, lda, d, info ) + !> DLAORHR_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, @@ -32000,8 +32002,6 @@ module stdlib_linalg_lapack_d !> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, !> E. Solomonik, J. Parallel Distrib. Comput., !> vol. 85, pp. 3-31, 2015. - - pure subroutine stdlib_dlaorhr_col_getrfnp( m, n, a, lda, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32061,10 +32061,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaorhr_col_getrfnp - !> DLAPY2: returns sqrt(x**2+y**2), taking care not to cause unnecessary - !> overflow and unnecessary underflow. pure real(dp) function stdlib_dlapy2( x, y ) + !> DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary + !> overflow and unnecessary underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32098,6 +32098,8 @@ module stdlib_linalg_lapack_d return end function stdlib_dlapy2 + + pure subroutine stdlib_dlaqz1( a, lda, b, ldb, sr1, sr2, si, beta1, beta2,v ) !> Given a 3-by-3 matrix pencil (A,B), DLAQZ1: sets v to a !> scalar multiple of the first column of the product !> (*) K = (A - (beta2*sr2 - i*si)*B)*B^(-1)*(beta1*A - (sr2 + i*si2)*B)*B^(-1). @@ -32107,8 +32109,6 @@ module stdlib_linalg_lapack_d !> 2) si = 0. !> This is useful for starting double implicit shift bulges !> in the QZ algorithm. - - pure subroutine stdlib_dlaqz1( a, lda, b, ldb, sr1, sr2, si, beta1, beta2,v ) ! arguments integer(ilp), intent( in ) :: lda, ldb real(dp), intent( in ) :: a( lda, * ), b( ldb, * ), sr1,sr2, si, beta1, beta2 @@ -32153,9 +32153,9 @@ module stdlib_linalg_lapack_d end if end subroutine stdlib_dlaqz1 - !> DLAQZ2: chases a 2x2 shift bulge in a matrix pencil down a single position pure subroutine stdlib_dlaqz2( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, qstart, & + !> DLAQZ2 chases a 2x2 shift bulge in a matrix pencil down a single position q, ldq, nz, zstart, z, ldz ) ! arguments logical(lk), intent( in ) :: ilq, ilz @@ -32264,9 +32264,9 @@ module stdlib_linalg_lapack_d end if end subroutine stdlib_dlaqz2 - !> DLAQZ4: Executes a single multishift QZ sweep pure subroutine stdlib_dlaqz4( ilschur, ilq, ilz, n, ilo, ihi, nshifts,nblock_desired, sr, & + !> DLAQZ4 Executes a single multishift QZ sweep si, ss, a, lda, b, ldb, q,ldq, z, ldz, qc, ldqc, zc, ldzc, work, lwork,info ) ! function arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -32521,7 +32521,9 @@ module stdlib_linalg_lapack_d end if end subroutine stdlib_dlaqz4 - !> DLAR1V: computes the (scaled) r-th column of the inverse of + + pure subroutine stdlib_dlar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & + !> DLAR1V 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 @@ -32536,8 +32538,6 @@ module stdlib_linalg_lapack_d !> (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. - - pure subroutine stdlib_dlar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32743,7 +32743,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlar1v - !> DLARFG: generates a real elementary reflector H of order n, such + + pure subroutine stdlib_dlarfg( n, alpha, x, incx, tau ) + !> DLARFG generates a real elementary reflector H of order n, such !> that !> H * ( alpha ) = ( beta ), H**T * H = I. !> ( x ) ( 0 ) @@ -32756,8 +32758,6 @@ module stdlib_linalg_lapack_d !> If the elements of x are all zero, then tau = 0 and H is taken to be !> the unit matrix. !> Otherwise 1 <= tau <= 2. - - pure subroutine stdlib_dlarfg( n, alpha, x, incx, tau ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32812,7 +32812,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarfg - !> DLARFGP: generates a real elementary reflector H of order n, such + + subroutine stdlib_dlarfgp( n, alpha, x, incx, tau ) + !> DLARFGP generates a real elementary reflector H of order n, such !> that !> H * ( alpha ) = ( beta ), H**T * H = I. !> ( x ) ( 0 ) @@ -32824,8 +32826,6 @@ module stdlib_linalg_lapack_d !> vector. !> If the elements of x are all zero, then tau = 0 and H is taken to be !> the unit matrix. - - subroutine stdlib_dlarfgp( n, alpha, x, incx, tau ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32920,10 +32920,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarfgp - !> DLARNV: returns a vector of n random real numbers from a uniform or - !> normal distribution. pure subroutine stdlib_dlarnv( idist, iseed, n, x ) + !> DLARNV returns a vector of n random real numbers from a uniform or + !> normal distribution. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32976,6 +32976,8 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarnv + + pure subroutine stdlib_dlarrb( n, d, lld, ifirst, ilast, rtol1,rtol2, offset, w, wgap, werr, & !> Given the relatively robust representation(RRR) L D L^T, DLARRB: !> does "limited" bisection to refine the eigenvalues of L D L^T, !> W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial @@ -32984,8 +32986,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dlarrb( n, d, lld, ifirst, ilast, rtol1,rtol2, offset, w, wgap, werr, & work, iwork,pivmin, spdiam, twist, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33149,13 +33149,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarrb + + pure subroutine stdlib_dlarrf( n, d, l, ld, clstrt, clend,w, wgap, werr,spdiam, clgapl, & !> 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 ), DLARRF: 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. - - pure subroutine stdlib_dlarrf( n, d, l, ld, clstrt, clend,w, wgap, werr,spdiam, clgapl, & clgapr, pivmin, sigma,dplus, lplus, work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33408,11 +33408,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarrf - !> DLARRV: 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 DLARRE. pure subroutine stdlib_dlarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, & + !> DLARRV 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 DLARRE. rtol2, w, werr, wgap,iblock, indexw, gers, z, ldz, isuppz,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34039,13 +34039,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarrv - !> DLASCL: multiplies the M by N real matrix A by the real scalar + + pure subroutine stdlib_dlascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) + !> DLASCL multiplies the M by N real 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. - - pure subroutine stdlib_dlascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34209,6 +34209,8 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlascl + + pure subroutine stdlib_dlasd4( n, i, d, z, delta, rho, sigma, work, info ) !> 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 @@ -34220,8 +34222,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dlasd4( n, i, d, z, delta, rho, sigma, work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34937,15 +34937,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd4 - !> DLASD7: merges the two sets of singular values together into a single + + pure subroutine stdlib_dlasd7( icompq, nl, nr, sqre, k, d, z, zw, vf, vfw, vl,vlw, alpha, & + !> DLASD7 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. !> DLASD7 is called from DLASD6. - - pure subroutine stdlib_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 ) ! -- lapack auxiliary routine -- @@ -35176,15 +35176,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd7 - !> DLASD8: finds the square roots of the roots of the secular equation, + + pure subroutine stdlib_dlasd8( icompq, k, d, z, vf, vl, difl, difr, lddifr,dsigma, work, & + !> DLASD8 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. !> DLASD8 is called from DLASD6. - - pure subroutine stdlib_dlasd8( icompq, k, d, z, vf, vl, difl, difr, lddifr,dsigma, work, & info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35312,11 +35312,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd8 - !> DLASQ3: checks for deflation, computes a shift (TAU) and calls dqds. - !> In case of failure it changes shifts, and tries again until output - !> is positive. pure subroutine stdlib_dlasq3( i0, n0, z, pp, dmin, sigma, desig, qmax, nfail,iter, ndiv, & + !> DLASQ3 checks for deflation, computes a shift (TAU) and calls dqds. + !> In case of failure it changes shifts, and tries again until output + !> is positive. ieee, ttype, dmin1, dmin2, dn, dn1,dn2, g, tau ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35482,7 +35482,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasq3 - !> DLATDF: uses the LU factorization of the n-by-n matrix Z computed by + + pure subroutine stdlib_dlatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) + !> DLATDF uses the LU factorization of the n-by-n matrix Z computed by !> DGETC2 and computes a contribution to the reciprocal Dif-estimate !> by solving Z * x = b for x, and choosing the r.h.s. b such that !> the norm of x is as large as possible. On entry RHS = b holds the @@ -35490,8 +35492,6 @@ module stdlib_linalg_lapack_d !> The factorization of Z returned by DGETC2 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. - - pure subroutine stdlib_dlatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35592,7 +35592,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlatdf - !> DLATRD: reduces NB rows and columns of a real symmetric matrix A to + + pure subroutine stdlib_dlatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) + !> DLATRD reduces NB rows and columns of a real symmetric matrix A to !> symmetric tridiagonal form by an orthogonal similarity !> transformation Q**T * A * Q, and returns the matrices V and W which are !> needed to apply the transformation to the unreduced part of A. @@ -35601,8 +35603,6 @@ module stdlib_linalg_lapack_d !> if UPLO = 'L', DLATRD reduces the first NB rows and columns of a !> matrix, of which the lower triangle is supplied. !> This is an auxiliary routine called by DSYTRD. - - pure subroutine stdlib_dlatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35694,12 +35694,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlatrd - !> DLATRZ: factors the M-by-(M+L) real upper trapezoidal matrix + + pure subroutine stdlib_dlatrz( m, n, l, a, lda, tau, work ) + !> DLATRZ factors the M-by-(M+L) real upper trapezoidal matrix !> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z, by means !> of orthogonal transformations. Z is an (M+L)-by-(M+L) orthogonal !> matrix and, R and A1 are M-by-M upper triangular matrices. - - pure subroutine stdlib_dlatrz( m, n, l, a, lda, tau, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35734,7 +35734,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlatrz - !> DORBDB: simultaneously bidiagonalizes the blocks of an M-by-M + + subroutine stdlib_dorbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & + !> DORBDB simultaneously bidiagonalizes the blocks of an M-by-M !> partitioned orthogonal matrix X: !> [ B11 | B12 0 0 ] !> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**T @@ -35750,8 +35752,6 @@ module stdlib_linalg_lapack_d !> represented implicitly by Householder vectors. !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_dorbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36062,7 +36062,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorbdb - !> DORBDB5: orthogonalizes the column vector + + pure subroutine stdlib_dorbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & + !> DORBDB5 orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] !> with respect to the columns of @@ -36073,8 +36075,6 @@ module stdlib_linalg_lapack_d !> criterion, then some other vector from the orthogonal complement !> is returned. This vector is chosen in an arbitrary but deterministic !> way. - - pure subroutine stdlib_dorbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36161,7 +36161,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorbdb5 - !> DORCSD: computes the CS decomposition of an M-by-M partitioned + + recursive subroutine stdlib_dorcsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & + !> DORCSD computes the CS decomposition of an M-by-M partitioned !> orthogonal matrix X: !> [ I 0 0 | 0 0 0 ] !> [ 0 C 0 | 0 -S 0 ] @@ -36174,8 +36176,6 @@ module stdlib_linalg_lapack_d !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in !> which R = MIN(P,M-P,Q,M-Q). - - recursive subroutine stdlib_dorcsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, ldv1t, v2t,ldv2t, & work, lwork, iwork, info ) ! -- lapack computational routine -- @@ -36436,12 +36436,12 @@ module stdlib_linalg_lapack_d ! end stdlib_dorcsd end subroutine stdlib_dorcsd - !> DORGHR: generates a real orthogonal matrix Q which is defined as the + + pure subroutine stdlib_dorghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) + !> DORGHR generates a real orthogonal matrix Q which is defined as the !> product of IHI-ILO elementary reflectors of order N, as returned by !> DGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - - pure subroutine stdlib_dorghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36526,7 +36526,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorghr - !> DORHR_COL: takes an M-by-N real matrix Q_in with orthonormal columns + + pure subroutine stdlib_dorhr_col( m, n, nb, a, lda, t, ldt, d, info ) + !> DORHR_COL takes an M-by-N real matrix Q_in with orthonormal columns !> as input, stored in A, and performs Householder Reconstruction (HR), !> i.e. reconstructs Householder vectors V(i) implicitly representing !> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, @@ -36535,8 +36537,6 @@ module stdlib_linalg_lapack_d !> stored in A on output, and the diagonal entries of S are stored in D. !> Block reflectors are also returned in T !> (same output format as DGEQRT). - - pure subroutine stdlib_dorhr_col( m, n, nb, a, lda, t, ldt, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36663,7 +36663,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorhr_col - !> DORMHR: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_dormhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & + !> DORMHR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -36671,8 +36673,6 @@ module stdlib_linalg_lapack_d !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of !> IHI-ILO elementary reflectors, as returned by DGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - - pure subroutine stdlib_dormhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36762,13 +36762,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormhr - !> DPBCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_dpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,iwork, info ) + !> DPBCON estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric positive definite band matrix using the !> Cholesky factorization A = U**T*U or A = L*L**T computed by DPBTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_dpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36860,12 +36860,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpbcon - !> DPBRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_dpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & + !> DPBRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric positive definite !> and banded, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_dpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37054,11 +37054,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpbrfs - !> DPFTRS: solves a system of linear equations A*X = B with a symmetric - !> positive definite matrix A using the Cholesky factorization - !> A = U**T*U or A = L*L**T computed by DPFTRF. pure subroutine stdlib_dpftrs( transr, uplo, n, nrhs, a, b, ldb, info ) + !> DPFTRS solves a system of linear equations A*X = B with a symmetric + !> positive definite matrix A using the Cholesky factorization + !> A = U**T*U or A = L*L**T computed by DPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37108,13 +37108,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpftrs - !> DPOCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_dpocon( uplo, n, a, lda, anorm, rcond, work, iwork,info ) + !> DPOCON estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric positive definite matrix using the !> Cholesky factorization A = U**T*U or A = L*L**T computed by DPOTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_dpocon( uplo, n, a, lda, anorm, rcond, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37203,12 +37203,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpocon - !> DPORFS: improves the computed solution to a system of linear + + pure subroutine stdlib_dporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & + !> DPORFS improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric positive definite, !> and provides error bounds and backward error estimates for the !> solution. - - pure subroutine stdlib_dporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37392,15 +37392,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dporfs - !> DPOTF2: computes the Cholesky factorization of a real symmetric + + pure subroutine stdlib_dpotf2( uplo, n, a, lda, info ) + !> DPOTF2 computes the Cholesky factorization of a real symmetric !> positive definite matrix A. !> The factorization has the form !> A = U**T * U , if UPLO = 'U', or !> A = L * L**T, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the unblocked version of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_dpotf2( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37479,7 +37479,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpotf2 - !> DPOTRF2: computes the Cholesky factorization of a real symmetric + + pure recursive subroutine stdlib_dpotrf2( uplo, n, a, lda, info ) + !> DPOTRF2 computes the Cholesky factorization of a real symmetric !> positive definite matrix A using the recursive algorithm. !> The factorization has the form !> A = U**T * U, if UPLO = 'U', or @@ -37492,8 +37494,6 @@ module stdlib_linalg_lapack_d !> [ A21 | A22 ] n2 = n-n1 !> The subroutine calls itself to factor A11. Update and scale A21 !> or A12, update A22 then calls itself to factor A22. - - pure recursive subroutine stdlib_dpotrf2( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37577,11 +37577,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpotrf2 - !> DPOTRI: computes the inverse of a real symmetric positive definite - !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T - !> computed by DPOTRF. pure subroutine stdlib_dpotri( uplo, n, a, lda, info ) + !> DPOTRI computes the inverse of a real symmetric positive definite + !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T + !> computed by DPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37618,14 +37618,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpotri - !> DPPCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_dppcon( uplo, n, ap, anorm, rcond, work, iwork, info ) + !> DPPCON estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric positive definite packed matrix using !> the Cholesky factorization A = U**T*U or A = L*L**T computed by !> DPPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_dppcon( uplo, n, ap, anorm, rcond, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37712,12 +37712,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dppcon - !> DPPRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_dpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & + !> DPPRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric positive definite !> and packed, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_dpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37904,7 +37904,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpprfs - !> DPPSV: computes the solution to a real system of linear equations + + pure subroutine stdlib_dppsv( uplo, n, nrhs, ap, b, ldb, info ) + !> DPPSV computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite matrix stored in !> packed format and X and B are N-by-NRHS matrices. @@ -37914,8 +37916,6 @@ module stdlib_linalg_lapack_d !> where U is an upper triangular matrix and L is a lower triangular !> matrix. The factored form of A is then used to solve the system of !> equations A * X = B. - - pure subroutine stdlib_dppsv( uplo, n, nrhs, ap, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37953,15 +37953,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dppsv - !> DPPSVX: uses the Cholesky factorization A = U**T*U or A = L*L**T to + + subroutine stdlib_dppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& + !> DPPSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to !> compute the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite matrix stored in !> packed format and X and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_dppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38092,11 +38092,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dppsvx - !> DPPTRI: computes the inverse of a real symmetric positive definite - !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T - !> computed by DPPTRF. pure subroutine stdlib_dpptri( uplo, n, ap, info ) + !> DPPTRI computes the inverse of a real symmetric positive definite + !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T + !> computed by DPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38154,7 +38154,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpptri - !> DPSTF2: computes the Cholesky factorization with complete + + pure subroutine stdlib_dpstf2( uplo, n, a, lda, piv, rank, tol, work, info ) + !> DPSTF2 computes the Cholesky factorization with complete !> pivoting of a real symmetric positive semidefinite matrix A. !> The factorization has the form !> P**T * A * P = U**T * U , if UPLO = 'U', @@ -38163,8 +38165,6 @@ module stdlib_linalg_lapack_d !> P is stored as vector PIV. !> This algorithm does not attempt to check that A is positive !> semidefinite. This version of the algorithm calls level 2 BLAS. - - pure subroutine stdlib_dpstf2( uplo, n, a, lda, piv, rank, tol, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38333,7 +38333,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpstf2 - !> DPSTRF: computes the Cholesky factorization with complete + + pure subroutine stdlib_dpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) + !> DPSTRF computes the Cholesky factorization with complete !> pivoting of a real symmetric positive semidefinite matrix A. !> The factorization has the form !> P**T * A * P = U**T * U , if UPLO = 'U', @@ -38342,8 +38344,6 @@ module stdlib_linalg_lapack_d !> P is stored as vector PIV. !> This algorithm does not attempt to check that A is positive !> semidefinite. This version of the algorithm calls level 3 BLAS. - - pure subroutine stdlib_dpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38544,14 +38544,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpstrf - !> DPTTRS: solves a tridiagonal system of the form + + pure subroutine stdlib_dpttrs( n, nrhs, d, e, b, ldb, info ) + !> DPTTRS solves a tridiagonal system of the form !> A * X = B !> using the L*D*L**T factorization of A computed by DPTTRF. D is a !> diagonal matrix specified in the vector D, L is a unit bidiagonal !> matrix whose subdiagonal is specified in the vector E, and X and B !> are N by NRHS matrices. - - pure subroutine stdlib_dpttrs( n, nrhs, d, e, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38599,10 +38599,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpttrs - !> DSB2ST_KERNELS: is an internal routine used by the DSYTRD_SB2ST - !> subroutine. pure subroutine stdlib_dsb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, lda, & + !> DSB2ST_KERNELS is an internal routine used by the DSYTRD_SB2ST + !> subroutine. v, tau, ldvt, work) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38744,13 +38744,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsb2st_kernels - !> DSPCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_dspcon( uplo, n, ap, ipiv, anorm, rcond, work, iwork,info ) + !> DSPCON estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric packed matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by DSPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_dspcon( uplo, n, ap, ipiv, anorm, rcond, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38826,12 +38826,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspcon - !> DSPRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_dsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& + !> DSPRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric indefinite !> and packed, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_dsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39019,7 +39019,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsprfs - !> DSPSV: computes the solution to a real system of linear equations + + pure subroutine stdlib_dspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) + !> DSPSV computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix stored in packed format and X !> and B are N-by-NRHS matrices. @@ -39030,8 +39032,6 @@ module stdlib_linalg_lapack_d !> triangular matrices, D is symmetric 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. - - pure subroutine stdlib_dspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39070,14 +39070,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspsv - !> DSPSVX: uses the diagonal pivoting factorization A = U*D*U**T or + + subroutine stdlib_dspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & + !> DSPSVX uses the diagonal pivoting factorization A = U*D*U**T or !> A = L*D*L**T to compute the solution to a real system of linear !> equations A * X = B, where A is an N-by-N symmetric matrix stored !> in packed format and X and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_dspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39148,11 +39148,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspsvx - !> DSPTRD: reduces a real symmetric matrix A stored in packed form to - !> symmetric tridiagonal form T by an orthogonal similarity - !> transformation: Q**T * A * Q = T. pure subroutine stdlib_dsptrd( uplo, n, ap, d, e, tau, info ) + !> DSPTRD reduces a real symmetric matrix A stored in packed form to + !> symmetric tridiagonal form T by an orthogonal similarity + !> transformation: Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39245,13 +39245,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsptrd - !> DSTEIN: computes the eigenvectors of a real symmetric tridiagonal + + pure subroutine stdlib_dstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & + !> DSTEIN computes the eigenvectors of a real symmetric tridiagonal !> matrix T corresponding to specified eigenvalues, using inverse !> iteration. !> The maximum number of iterations allowed for each eigenvector is !> specified by an internal parameter MAXITS (currently set to 5). - - pure subroutine stdlib_dstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39443,13 +39443,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dstein - !> DSTEQR: computes all eigenvalues and, optionally, eigenvectors of a + + pure subroutine stdlib_dsteqr( compz, n, d, e, z, ldz, work, info ) + !> DSTEQR computes all eigenvalues and, optionally, eigenvectors of a !> symmetric tridiagonal matrix using the implicit QL or QR method. !> The eigenvectors of a full or band symmetric matrix can also be found !> if DSYTRD or DSPTRD or DSBTRD has been used to reduce this matrix to !> tridiagonal form. - - pure subroutine stdlib_dsteqr( compz, n, d, e, z, ldz, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39760,10 +39760,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsteqr - !> DSTERF: computes all eigenvalues of a symmetric tridiagonal matrix - !> using the Pal-Walker-Kahan variant of the QL or QR algorithm. pure subroutine stdlib_dsterf( n, d, e, info ) + !> DSTERF computes all eigenvalues of a symmetric tridiagonal matrix + !> using the Pal-Walker-Kahan variant of the QL or QR algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39995,10 +39995,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsterf - !> DSTEV: computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric tridiagonal matrix A. pure subroutine stdlib_dstev( jobz, n, d, e, z, ldz, work, info ) + !> DSTEV computes all eigenvalues and, optionally, eigenvectors of a + !> real symmetric tridiagonal matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -40078,12 +40078,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dstev - !> DSTEVX: computes selected eigenvalues and, optionally, eigenvectors + + pure subroutine stdlib_dstevx( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & + !> DSTEVX computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix A. Eigenvalues and !> eigenvectors can be selected by specifying either a range of values !> or a range of indices for the desired eigenvalues. - - pure subroutine stdlib_dstevx( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & work, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40272,13 +40272,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dstevx - !> DSYCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_dsycon( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) + !> DSYCON estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by DSYTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_dsycon( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40355,13 +40355,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsycon - !> DSYCON_ROOK: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_dsycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) + !> DSYCON_ROOK estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by DSYTRF_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))). - - pure subroutine stdlib_dsycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40438,11 +40438,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsycon_rook - !> DSYRFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite, and - !> provides error bounds and backward error estimates for the solution. pure subroutine stdlib_dsyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & + !> DSYRFS improves the computed solution to a system of linear + !> equations when the coefficient matrix is symmetric indefinite, and + !> provides error bounds and backward error estimates for the solution. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40627,7 +40627,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyrfs - !> DSYSV_RK: computes the solution to a real system of linear + + pure subroutine stdlib_dsysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,work, lwork, info ) + !> DSYSV_RK computes the solution to a real system of linear !> equations A * X = B, where A is an N-by-N symmetric matrix !> and X and B are N-by-NRHS matrices. !> The bounded Bunch-Kaufman (rook) diagonal pivoting method is used @@ -40641,8 +40643,6 @@ module stdlib_linalg_lapack_d !> DSYTRF_RK is called to compute the factorization of a real !> symmetric matrix. The factored form of A is then used to solve !> the system of equations A * X = B by calling BLAS3 routine DSYTRS_3. - - pure subroutine stdlib_dsysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40704,7 +40704,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsysv_rk - !> DSYSV_ROOK: computes the solution to a real system of linear + + pure subroutine stdlib_dsysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) + !> DSYSV_ROOK computes the solution to a real system of linear !> equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS @@ -40720,8 +40722,6 @@ module stdlib_linalg_lapack_d !> pivoting method. !> The factored form of A is then used to solve the system !> of equations A * X = B by calling DSYTRS_ROOK. - - pure subroutine stdlib_dsysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40783,10 +40783,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsysv_rook - !> DSYTD2: reduces a real symmetric matrix A to symmetric tridiagonal - !> form T by an orthogonal similarity transformation: Q**T * A * Q = T. pure subroutine stdlib_dsytd2( uplo, n, a, lda, d, e, tau, info ) + !> DSYTD2 reduces a real symmetric matrix A to symmetric tridiagonal + !> form T by an orthogonal similarity transformation: Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -40877,15 +40877,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytd2 - !> DSYTF2: computes the factorization of a real symmetric matrix A using + + pure subroutine stdlib_dsytf2( uplo, n, a, lda, ipiv, info ) + !> DSYTF2 computes the factorization of a real symmetric matrix A using !> the Bunch-Kaufman diagonal pivoting method: !> 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, U**T is the transpose of U, and D is symmetric 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. - - pure subroutine stdlib_dsytf2( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41162,11 +41162,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytf2 - !> DSYTRD: reduces a real symmetric matrix A to real symmetric - !> tridiagonal form T by an orthogonal similarity transformation: - !> Q**T * A * Q = T. pure subroutine stdlib_dsytrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) + !> DSYTRD reduces a real symmetric matrix A to real symmetric + !> tridiagonal form T by an orthogonal similarity transformation: + !> Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41288,11 +41288,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrd - !> DSYTRD_SB2ST: reduces a real symmetric band matrix A to real symmetric - !> tridiagonal form T by a orthogonal similarity transformation: - !> Q**T * A * Q = T. pure subroutine stdlib_dsytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & + !> DSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric + !> tridiagonal form T by a orthogonal similarity transformation: + !> Q**T * A * Q = T. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41534,7 +41534,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrd_sb2st - !> DSYTRF: computes the factorization of a real symmetric matrix A using + + pure subroutine stdlib_dsytrf( uplo, n, a, lda, ipiv, work, lwork, info ) + !> DSYTRF computes the factorization of a real symmetric matrix A using !> the Bunch-Kaufman diagonal pivoting method. The form of the !> factorization is !> A = U**T*D*U or A = L*D*L**T @@ -41542,8 +41544,6 @@ module stdlib_linalg_lapack_d !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_dsytrf( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41660,14 +41660,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrf - !> DTBCON: estimates the reciprocal of the condition number of a + + subroutine stdlib_dtbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,iwork, info ) + !> DTBCON estimates the reciprocal of the condition number of a !> triangular band matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_dtbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41764,11 +41764,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtbcon - !> DTFTRI: computes the inverse of a triangular matrix A stored in RFP - !> format. - !> This is a Level 3 BLAS version of the algorithm. pure subroutine stdlib_dtftri( transr, uplo, diag, n, a, info ) + !> DTFTRI computes the inverse of a triangular matrix A stored in RFP + !> format. + !> This is a Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41947,7 +41947,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtftri - !> DTGSY2: solves the generalized Sylvester equation: + + pure subroutine stdlib_dtgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & + !> DTGSY2 solves the generalized Sylvester equation: !> A * R - L * B = scale * C (1) !> D * R - L * E = scale * F, !> using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices, @@ -41975,8 +41977,6 @@ module stdlib_linalg_lapack_d !> of an upper bound on the separation between to matrix pairs. Then !> the input (A, D), (B, E) are sub-pencils of the matrix pair in !> DTGSYL. See DTGSYL for details. - - pure subroutine stdlib_dtgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & ldf, scale, rdsum, rdscal,iwork, pq, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42587,7 +42587,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgsy2 - !> DTGSYL: solves the generalized Sylvester equation: + + pure subroutine stdlib_dtgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & + !> DTGSYL solves the generalized Sylvester equation: !> A * R - L * B = scale * C (1) !> D * R - L * E = scale * F !> where R and L are unknown m-by-n matrices, (A, D), (B, E) and @@ -42615,8 +42617,6 @@ module stdlib_linalg_lapack_d !> reciprocal of the smallest singular value of Z. See [1-2] for more !> information. !> This is a level 3 BLAS algorithm. - - pure subroutine stdlib_dtgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42916,14 +42916,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgsyl - !> DTPCON: estimates the reciprocal of the condition number of a packed + + subroutine stdlib_dtpcon( norm, uplo, diag, n, ap, rcond, work, iwork,info ) + !> DTPCON estimates the reciprocal of the condition number of a packed !> triangular matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_dtpcon( norm, uplo, diag, n, ap, rcond, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43015,11 +43015,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtpcon - !> DTPLQT2: computes a LQ a factorization of a real "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. pure subroutine stdlib_dtplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) + !> DTPLQT2 computes a LQ a factorization of a real "triangular-pentagonal" + !> matrix C, which is composed of a triangular block A and pentagonal block B, + !> using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43112,11 +43112,11 @@ module stdlib_linalg_lapack_d end do end subroutine stdlib_dtplqt2 + + pure subroutine stdlib_dtpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, ldb, & !> DTPMQRT applies a real orthogonal matrix Q obtained from a !> "triangular-pentagonal" real block reflector H to a general !> real matrix C, which consists of two blocks A and B. - - pure subroutine stdlib_dtpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, ldb, & work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43230,11 +43230,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtpmlqt - !> DTPMQRT: applies a real orthogonal matrix Q obtained from a - !> "triangular-pentagonal" real block reflector H to a general - !> real matrix C, which consists of two blocks A and B. pure subroutine stdlib_dtpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, ldb, & + !> DTPMQRT applies a real orthogonal matrix Q obtained from a + !> "triangular-pentagonal" real block reflector H to a general + !> real matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43350,11 +43350,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtpmqrt - !> DTPQRT2: computes a QR factorization of a real "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. pure subroutine stdlib_dtpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) + !> DTPQRT2 computes a QR factorization of a real "triangular-pentagonal" + !> matrix C, which is composed of a triangular block A and pentagonal block B, + !> using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43441,14 +43441,14 @@ module stdlib_linalg_lapack_d end do end subroutine stdlib_dtpqrt2 - !> DTRCON: estimates the reciprocal of the condition number of a + + subroutine stdlib_dtrcon( norm, uplo, diag, n, a, lda, rcond, work,iwork, info ) + !> DTRCON estimates the reciprocal of the condition number of a !> triangular matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_dtrcon( norm, uplo, diag, n, a, lda, rcond, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43542,14 +43542,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrcon - !> DTZRZF: reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A + + pure subroutine stdlib_dtzrzf( m, n, a, lda, tau, work, lwork, info ) + !> DTZRZF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A !> to upper triangular form by means of orthogonal transformations. !> The upper trapezoidal matrix A is factored as !> A = ( R 0 ) * Z, !> where Z is an N-by-N orthogonal matrix and R is an M-by-M upper !> triangular matrix. - - pure subroutine stdlib_dtzrzf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43658,7 +43658,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtzrzf - !> DGBSV: computes the solution to a real system of linear equations + + pure subroutine stdlib_dgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) + !> DGBSV computes the solution to a real 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 @@ -43666,8 +43668,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43710,14 +43710,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbsv - !> DGBSVX: uses the LU factorization to compute the solution to a real + + subroutine stdlib_dgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & + !> DGBSVX uses the LU factorization to compute the solution to a real !> system of linear equations A * X = B, A**T * X = B, or A**H * 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. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_dgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & c, b, ldb, x, ldx,rcond, ferr, berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43933,7 +43933,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbsvx - !> DGEBAL: balances a general real matrix A. This involves, first, + + pure subroutine stdlib_dgebal( job, n, a, lda, ilo, ihi, scale, info ) + !> DGEBAL balances a general real 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 @@ -43941,8 +43943,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dgebal( job, n, a, lda, ilo, ihi, scale, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44101,11 +44101,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgebal - !> DGEBD2: reduces a real general m by n matrix A to upper or lower - !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. - !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. pure subroutine stdlib_dgebd2( m, n, a, lda, d, e, tauq, taup, work, info ) + !> DGEBD2 reduces a real general m by n matrix A to upper or lower + !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. + !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44193,10 +44193,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgebd2 - !> DGEHD2: reduces a real general matrix A to upper Hessenberg form H by - !> an orthogonal similarity transformation: Q**T * A * Q = H . pure subroutine stdlib_dgehd2( n, ilo, ihi, a, lda, tau, work, info ) + !> DGEHD2 reduces a real general matrix A to upper Hessenberg form H by + !> an orthogonal similarity transformation: Q**T * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44245,14 +44245,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgehd2 - !> DGELQ2: computes an LQ factorization of a real m-by-n matrix A: + + pure subroutine stdlib_dgelq2( m, n, a, lda, tau, work, info ) + !> DGELQ2 computes an LQ factorization of a real 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. - - pure subroutine stdlib_dgelq2( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44299,14 +44299,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgelq2 - !> DGELQF: computes an LQ factorization of a real M-by-N matrix A: + + pure subroutine stdlib_dgelqf( m, n, a, lda, tau, work, lwork, info ) + !> DGELQF computes an LQ factorization of a real 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. - - pure subroutine stdlib_dgelqf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44396,12 +44396,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgelqf - !> DGELQT3: recursively computes a LQ factorization of a real M-by-N + + pure recursive subroutine stdlib_dgelqt3( m, n, a, lda, t, ldt, info ) + !> DGELQT3 recursively computes a LQ factorization of a real 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. - - pure recursive subroutine stdlib_dgelqt3( m, n, a, lda, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44483,10 +44483,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgelqt3 - !> DGEQL2: computes a QL factorization of a real m by n matrix A: - !> A = Q * L. pure subroutine stdlib_dgeql2( m, n, a, lda, tau, work, info ) + !> DGEQL2 computes a QL factorization of a real m by n matrix A: + !> A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44532,10 +44532,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeql2 - !> DGEQLF: computes a QL factorization of a real M-by-N matrix A: - !> A = Q * L. pure subroutine stdlib_dgeqlf( m, n, a, lda, tau, work, lwork, info ) + !> DGEQLF computes a QL factorization of a real M-by-N matrix A: + !> A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44638,15 +44638,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeqlf - !> DGEQR2: computes a QR factorization of a real m-by-n matrix A: + + pure subroutine stdlib_dgeqr2( m, n, a, lda, tau, work, info ) + !> DGEQR2 computes a QR factorization of a real 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. - - pure subroutine stdlib_dgeqr2( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44693,7 +44693,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeqr2 - !> DGEQR2P: computes a QR factorization of a real m-by-n matrix A: + + subroutine stdlib_dgeqr2p( m, n, a, lda, tau, work, info ) + !> DGEQR2P computes a QR factorization of a real m-by-n matrix A: !> A = Q * ( R ), !> ( 0 ) !> where: @@ -44701,8 +44703,6 @@ module stdlib_linalg_lapack_d !> 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. - - subroutine stdlib_dgeqr2p( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44749,15 +44749,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeqr2p - !> DGEQRF: computes a QR factorization of a real M-by-N matrix A: + + pure subroutine stdlib_dgeqrf( m, n, a, lda, tau, work, lwork, info ) + !> DGEQRF computes a QR factorization of a real 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. - - pure subroutine stdlib_dgeqrf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44851,6 +44851,8 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeqrf + + subroutine stdlib_dgeqrfp( m, n, a, lda, tau, work, lwork, info ) !> DGEQR2P computes a QR factorization of a real M-by-N matrix A: !> A = Q * ( R ), !> ( 0 ) @@ -44859,8 +44861,6 @@ module stdlib_linalg_lapack_d !> 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. - - subroutine stdlib_dgeqrfp( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44950,10 +44950,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeqrfp - !> DGEQRT2: computes a QR factorization of a real M-by-N matrix A, - !> using the compact WY representation of Q. pure subroutine stdlib_dgeqrt2( m, n, a, lda, t, ldt, info ) + !> DGEQRT2 computes a QR factorization of a real M-by-N matrix A, + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45018,12 +45018,12 @@ module stdlib_linalg_lapack_d end do end subroutine stdlib_dgeqrt2 - !> DGEQRT3: recursively computes a QR factorization of a real M-by-N + + pure recursive subroutine stdlib_dgeqrt3( m, n, a, lda, t, ldt, info ) + !> DGEQRT3 recursively computes a QR factorization of a real 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. - - pure recursive subroutine stdlib_dgeqrt3( m, n, a, lda, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45103,11 +45103,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeqrt3 - !> DGERFS: improves the computed solution to a system of linear - !> equations and provides error bounds and backward error estimates for - !> the solution. pure subroutine stdlib_dgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & + !> DGERFS improves the computed solution to a system of linear + !> equations and provides error bounds and backward error estimates for + !> the solution. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45296,10 +45296,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgerfs - !> DGERQ2: computes an RQ factorization of a real m by n matrix A: - !> A = R * Q. pure subroutine stdlib_dgerq2( m, n, a, lda, tau, work, info ) + !> DGERQ2 computes an RQ factorization of a real m by n matrix A: + !> A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45345,10 +45345,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgerq2 - !> DGERQF: computes an RQ factorization of a real M-by-N matrix A: - !> A = R * Q. pure subroutine stdlib_dgerqf( m, n, a, lda, tau, work, lwork, info ) + !> DGERQF computes an RQ factorization of a real M-by-N matrix A: + !> A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45451,7 +45451,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgerqf - !> DGETRF: computes an LU factorization of a general M-by-N matrix A + + pure subroutine stdlib_dgetrf( m, n, a, lda, ipiv, info ) + !> DGETRF 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 @@ -45459,8 +45461,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dgetrf( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45529,7 +45529,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetrf - !> DGGHD3: reduces a pair of real matrices (A,B) to generalized upper + + pure subroutine stdlib_dgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & + !> DGGHD3 reduces a pair of real matrices (A,B) to generalized upper !> Hessenberg form using orthogonal transformations, where A is a !> general matrix and B is upper triangular. The form of the !> generalized eigenvalue problem is @@ -45554,8 +45556,6 @@ module stdlib_linalg_lapack_d !> problem to generalized Hessenberg form. !> This is a blocked variant of DGGHRD, using matrix-matrix !> multiplications for parts of the computation to enhance performance. - - pure subroutine stdlib_dgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46056,7 +46056,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgghd3 - !> DGGQRF: computes a generalized QR factorization of an N-by-M matrix A + + pure subroutine stdlib_dggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) + !> DGGQRF 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 orthogonal matrix, Z is a P-by-P orthogonal @@ -46074,8 +46076,6 @@ module stdlib_linalg_lapack_d !> inv(B)*A = Z**T*(inv(T)*R) !> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the !> transpose of the matrix Z. - - pure subroutine stdlib_dggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46134,7 +46134,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggqrf - !> DGGRQF: computes a generalized RQ factorization of an M-by-N matrix A + + pure subroutine stdlib_dggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) + !> DGGRQF 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 orthogonal matrix, Z is a P-by-P orthogonal @@ -46152,8 +46154,6 @@ module stdlib_linalg_lapack_d !> A*inv(B) = (R*inv(T))*Z**T !> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the !> transpose of the matrix Z. - - pure subroutine stdlib_dggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46212,12 +46212,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggrqf - !> DGSVJ0: is called from DGESVJ as a pre-processor and that is its main + + pure subroutine stdlib_dgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & + !> DGSVJ0 is called from DGESVJ as a pre-processor and that is its main !> purpose. It applies Jacobi rotations in the same way as DGESVJ does, but !> it does not check convergence (stopping criterion). Few tuning !> parameters (marked by [TP]) are available for the implementer. - - pure subroutine stdlib_dgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46860,7 +46860,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgsvj0 - !> DGSVJ1: is called from DGESVJ as a pre-processor and that is its main + + pure subroutine stdlib_dgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & + !> DGSVJ1 is called from DGESVJ as a pre-processor and that is its main !> purpose. It applies Jacobi rotations in the same way as DGESVJ does, but !> it targets only particular pivots and it does not check convergence !> (stopping criterion). Few tuning parameters (marked by [TP]) are @@ -46884,8 +46886,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47291,13 +47291,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgsvj1 - !> DGTCON: estimates the reciprocal of the condition number of a real + + pure subroutine stdlib_dgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, iwork, info & + !> DGTCON estimates the reciprocal of the condition number of a real !> tridiagonal matrix A using the LU factorization as computed by !> DGTTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_dgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, iwork, info & ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47374,11 +47374,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgtcon - !> DGTRFS: 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. pure subroutine stdlib_dgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, x, & + !> DGTRFS 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. ldx, ferr, berr, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47576,14 +47576,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgtrfs - !> DGTSVX: uses the LU factorization to compute the solution to a real + + pure subroutine stdlib_dgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & + !> DGTSVX uses the LU factorization to compute the solution to a real !> system of linear equations A * X = B or A**T * X = B, !> where A is a tridiagonal matrix of order N and X and B are N-by-NRHS !> matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - pure subroutine stdlib_dgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & ldb, x, ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47665,7 +47665,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgtsvx - !> DHGEQZ: computes the eigenvalues of a real matrix pair (H,T), + + subroutine stdlib_dhgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alphar, alphai, & + !> DHGEQZ computes the eigenvalues of a real 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 @@ -47708,8 +47710,6 @@ module stdlib_linalg_lapack_d !> Ref: C.B. Moler !> Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973), !> pp. 241--256. - - subroutine stdlib_dhgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alphar, alphai, & beta, q, ldq, z, ldz, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48540,15 +48540,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dhgeqz - !> DLABRD: reduces the first NB rows and columns of a real general + + pure subroutine stdlib_dlabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) + !> DLABRD reduces the first NB rows and columns of a real general !> m by n matrix A to upper or lower bidiagonal form by an orthogonal !> transformation Q**T * 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 DGEBRD - - pure subroutine stdlib_dlabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48670,15 +48670,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlabrd - !> DLADIV: performs complex division in real arithmetic + + pure subroutine stdlib_dladiv( a, b, c, d, p, q ) + !> DLADIV 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" - - pure subroutine stdlib_dladiv( a, b, c, d, p, q ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48738,6 +48738,8 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dladiv + + pure subroutine stdlib_dlaed4( n, i, d, z, delta, rho, dlam, info ) !> 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 @@ -48748,8 +48750,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dlaed4( n, i, d, z, delta, rho, dlam, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49343,14 +49343,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed4 - !> DLAED8: merges the two sets of eigenvalues together into a single + + pure subroutine stdlib_dlaed8( icompq, k, n, qsiz, d, q, ldq, indxq, rho,cutpnt, z, dlamda, & + !> DLAED8 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. - - pure subroutine stdlib_dlaed8( icompq, k, n, qsiz, d, q, ldq, indxq, rho,cutpnt, z, dlamda, & q2, ldq2, w, perm, givptr,givcol, givnum, indxp, indx, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49566,12 +49566,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed8 - !> DLAED9: finds the roots of the secular equation, as defined by the + + pure subroutine stdlib_dlaed9( k, kstart, kstop, n, d, q, ldq, rho, dlamda, w,s, lds, info ) + !> DLAED9 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. - - pure subroutine stdlib_dlaed9( k, kstart, kstop, n, d, q, ldq, rho, dlamda, w,s, lds, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49672,11 +49672,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed9 - !> DLAEIN: uses inverse iteration to find a right or left eigenvector - !> corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg - !> matrix H. pure subroutine stdlib_dlaein( rightv, noinit, n, h, ldh, wr, wi, vr, vi, b,ldb, work, eps3, & + !> DLAEIN uses inverse iteration to find a right or left eigenvector + !> corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg + !> matrix H. smlnum, bignum, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50018,7 +50018,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaein - !> DLAGV2: computes the Generalized Schur factorization of a real 2-by-2 + + pure subroutine stdlib_dlagv2( a, lda, b, ldb, alphar, alphai, beta, csl, snl,csr, snr ) + !> DLAGV2 computes the Generalized Schur factorization of a real 2-by-2 !> matrix pencil (A,B) where B is upper triangular. This routine !> computes orthogonal (rotation) matrices given by CSL, SNL and CSR, !> SNR such that @@ -50035,8 +50037,6 @@ module stdlib_linalg_lapack_d !> [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] !> [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ] !> where b11 >= b22 > 0. - - pure subroutine stdlib_dlagv2( a, lda, b, ldb, alphar, alphai, beta, csl, snl,csr, snr ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50182,14 +50182,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlagv2 - !> DLAHR2: reduces the first NB columns of A real general n-BY-(n-k+1) + + pure subroutine stdlib_dlahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) + !> DLAHR2 reduces the first NB columns of A real general n-BY-(n-k+1) !> matrix A so that elements below the k-th subdiagonal are zero. The !> reduction is performed by an orthogonal similarity transformation !> Q**T * A * Q. The routine returns the matrices V and T which determine !> Q as a block reflector I - V*T*V**T, and also the matrix Y = A * V * T. !> This is an auxiliary routine called by DGEHRD. - - pure subroutine stdlib_dlahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50270,7 +50270,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlahr2 - !> DLALN2: solves a system of the form (ca A - w D ) X = s B + + pure subroutine stdlib_dlaln2( ltrans, na, nw, smin, ca, a, lda, d1, d2, b,ldb, wr, wi, x, & + !> DLALN2 solves a system of the form (ca A - w D ) X = s B !> or (ca A**T - w D) X = s B with possible scaling ("s") and !> perturbation of A. (A**T means A-transpose.) !> A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA @@ -50295,8 +50297,6 @@ module stdlib_linalg_lapack_d !> correct to a factor of 2 or so. !> Note: all input quantities are assumed to be smaller than overflow !> by a reasonable factor. (See BIGNUM.) - - pure subroutine stdlib_dlaln2( ltrans, na, nw, smin, ca, a, lda, d1, d2, b,ldb, wr, wi, x, & ldx, scale, xnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50595,7 +50595,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaln2 - !> DLALS0: applies back the multiplying factors of either the left or the + + pure subroutine stdlib_dlals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, & + !> DLALS0 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. @@ -50615,8 +50617,6 @@ module stdlib_linalg_lapack_d !> null space. !> (3R) The inverse transformation of (2L). !> (4R) The inverse transformation of (1L). - - pure subroutine stdlib_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 ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50792,15 +50792,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlals0 - !> DLAMSWLQ: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_dlamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & + !> DLAMSWLQ overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T !> where Q is a real orthogonal matrix defined as the product of blocked !> elementary reflectors computed by short wide LQ !> factorization (DLASWLQ) - - pure subroutine stdlib_dlamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50950,15 +50950,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlamswlq - !> DLAMTSQR: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_dlamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & + !> DLAMTSQR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T !> where Q is a real orthogonal matrix defined as the product !> of blocked elementary reflectors computed by tall skinny !> QR factorization (DLATSQR) - - pure subroutine stdlib_dlamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51112,7 +51112,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlamtsqr - !> DLANV2: computes the Schur factorization of a real 2-by-2 nonsymmetric + + pure subroutine stdlib_dlanv2( a, b, c, d, rt1r, rt1i, rt2r, rt2i, cs, sn ) + !> DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric !> matrix in standard form: !> [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ] !> [ C D ] [ SN CS ] [ CC DD ] [-SN CS ] @@ -51120,8 +51122,6 @@ module stdlib_linalg_lapack_d !> 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or !> 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex !> conjugate eigenvalues. - - pure subroutine stdlib_dlanv2( a, b, c, d, rt1r, rt1i, rt2r, rt2i, cs, sn ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51258,14 +51258,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlanv2 + + pure subroutine stdlib_dlapll( n, x, incx, y, incy, ssmin ) !> 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. - - pure subroutine stdlib_dlapll( n, x, incx, y, incy, ssmin ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51298,11 +51298,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlapll - !> DLAQP2: computes a QR factorization with column pivoting of - !> the block A(OFFSET+1:M,1:N). - !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. pure subroutine stdlib_dlaqp2( m, n, offset, a, lda, jpvt, tau, vn1, vn2,work ) + !> DLAQP2 computes a QR factorization with column pivoting of + !> the block A(OFFSET+1:M,1:N). + !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51375,7 +51375,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaqp2 - !> DLAQPS: computes a step of QR factorization with column pivoting + + pure subroutine stdlib_dlaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & + !> DLAQPS computes a step of QR factorization with column pivoting !> of a real 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. @@ -51383,8 +51385,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dlaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51509,10 +51509,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaqps - !> DLAQR5:, called by DLAQR0, performs a - !> single small-bulge multi-shift QR sweep. pure subroutine stdlib_dlaqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts,sr, si, h, ldh, & + !> DLAQR5 , called by DLAQR0, performs a + !> single small-bulge multi-shift QR sweep. iloz, ihiz, z, ldz, v, ldv, u,ldu, nv, wv, ldwv, nh, wh, ldwh ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51916,7 +51916,9 @@ module stdlib_linalg_lapack_d end do loop_180 end subroutine stdlib_dlaqr5 - !> DLAQTR: solves the real quasi-triangular system + + subroutine stdlib_dlaqtr( ltran, lreal, n, t, ldt, b, w, scale, x, work,info ) + !> DLAQTR 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. @@ -51934,8 +51936,6 @@ module stdlib_linalg_lapack_d !> [ d ] [ q ] !> This subroutine is designed for the condition number estimation !> in routine DTRSNA. - - subroutine stdlib_dlaqtr( ltran, lreal, n, t, ldt, b, w, scale, x, work,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52362,7 +52362,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaqtr - !> DLASD3: finds all the square roots of the roots of the secular + + pure subroutine stdlib_dlasd3( nl, nr, sqre, k, d, q, ldq, dsigma, u, ldu, u2,ldu2, vt, ldvt,& + !> DLASD3 finds all the square roots of the roots of the secular !> equation, as defined by the values in D and Z. It makes the !> appropriate calls to DLASD4 and then updates the singular !> vectors by matrix multiplication. @@ -52373,8 +52375,6 @@ module stdlib_linalg_lapack_d !> It could conceivably fail on hexadecimal or decimal machines !> without guard digits, but we know of none. !> DLASD3 is called from DLASD1. - - pure subroutine stdlib_dlasd3( nl, nr, sqre, k, d, q, ldq, dsigma, u, ldu, u2,ldu2, vt, ldvt,& vt2, ldvt2, idxc, ctot, z,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52564,7 +52564,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd3 - !> DLASD6: computes the SVD of an updated upper bidiagonal matrix B + + pure subroutine stdlib_dlasd6( icompq, nl, nr, sqre, d, vf, vl, alpha, beta,idxq, perm, & + !> DLASD6 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. @@ -52599,8 +52601,6 @@ module stdlib_linalg_lapack_d !> between the updated singular values and the old singular !> values. !> DLASD6 is called from DLASDA. - - pure subroutine stdlib_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 ) ! -- lapack auxiliary routine -- @@ -52692,13 +52692,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd6 - !> DOPGTR: generates a real orthogonal matrix Q which is defined as the + + pure subroutine stdlib_dopgtr( uplo, n, ap, tau, q, ldq, work, info ) + !> DOPGTR generates a real orthogonal matrix Q which is defined as the !> product of n-1 elementary reflectors H(i) of order n, as returned by !> DSPTRD using packed storage: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - - pure subroutine stdlib_dopgtr( uplo, n, ap, tau, q, ldq, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52779,7 +52779,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dopgtr - !> DOPMTR: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_dopmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) + !> DOPMTR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -52789,8 +52791,6 @@ module stdlib_linalg_lapack_d !> storage: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - - pure subroutine stdlib_dopmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52926,7 +52926,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dopmtr - !> DORBDB1: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_dorbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> DORBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -52941,8 +52943,6 @@ module stdlib_linalg_lapack_d !> Householder vectors. !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by !> angles THETA, PHI. - - subroutine stdlib_dorbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53029,7 +53029,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorbdb1 - !> DORBDB2: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_dorbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> DORBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -53044,8 +53046,6 @@ module stdlib_linalg_lapack_d !> Householder vectors. !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by !> angles THETA, PHI. - - subroutine stdlib_dorbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53142,7 +53142,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorbdb2 - !> DORBDB3: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_dorbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> DORBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -53157,8 +53159,6 @@ module stdlib_linalg_lapack_d !> Householder vectors. !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_dorbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53254,7 +53254,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorbdb3 - !> DORBDB4: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_dorbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> DORBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -53269,8 +53271,6 @@ module stdlib_linalg_lapack_d !> Householder vectors. !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_dorbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53396,7 +53396,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorbdb4 - !> DORCSD2BY1: computes the CS decomposition of an M-by-Q matrix X with + + subroutine stdlib_dorcsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & + !> DORCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with !> orthonormal columns that has been partitioned into a 2-by-1 block !> structure: !> [ I1 0 0 ] @@ -53411,8 +53413,6 @@ module stdlib_linalg_lapack_d !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). - - subroutine stdlib_dorcsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, iwork, info ) ! -- lapack computational routine (3.5.0_dp) -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53811,13 +53811,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorcsd2by1 - !> DORGTR: generates a real orthogonal matrix Q which is defined as the + + pure subroutine stdlib_dorgtr( uplo, n, a, lda, tau, work, lwork, info ) + !> DORGTR generates a real orthogonal matrix Q which is defined as the !> product of n-1 elementary reflectors of order N, as returned by !> DSYTRD: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - - pure subroutine stdlib_dorgtr( uplo, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53912,13 +53912,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgtr - !> DORGTSQR: generates an M-by-N real matrix Q_out with orthonormal columns, + + pure subroutine stdlib_dorgtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) + !> DORGTSQR generates an M-by-N real matrix Q_out with orthonormal columns, !> which are the first N columns of a product of real orthogonal !> matrices of order M which are returned by DLATSQR !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). !> See the documentation for DLATSQR. - - pure subroutine stdlib_dorgtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54010,7 +54010,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgtsqr - !> DORMTR: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_dormtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & + !> DORMTR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -54019,8 +54021,6 @@ module stdlib_linalg_lapack_d !> nq-1 elementary reflectors, as returned by DSYTRD: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - - pure subroutine stdlib_dormtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54126,14 +54126,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormtr - !> DPBTRF: computes the Cholesky factorization of a real symmetric + + pure subroutine stdlib_dpbtrf( uplo, n, kd, ab, ldab, info ) + !> DPBTRF computes the Cholesky factorization of a real symmetric !> positive definite band matrix A. !> The factorization has the form !> A = U**T * U, if UPLO = 'U', or !> A = L * L**T, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. - - pure subroutine stdlib_dpbtrf( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54325,11 +54325,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpbtrf - !> DPFTRI: computes the inverse of a (real) symmetric positive definite - !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T - !> computed by DPFTRF. pure subroutine stdlib_dpftri( transr, uplo, n, a, info ) + !> DPFTRI computes the inverse of a (real) symmetric positive definite + !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T + !> computed by DPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54483,15 +54483,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpftri - !> DPOTRF: computes the Cholesky factorization of a real symmetric + + pure subroutine stdlib_dpotrf( uplo, n, a, lda, info ) + !> DPOTRF computes the Cholesky factorization of a real symmetric !> positive definite matrix A. !> The factorization has the form !> A = U**T * U, if UPLO = 'U', or !> A = L * L**T, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the block version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_dpotrf( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54577,12 +54577,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpotrf - !> DPTRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_dptrfs( n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr,berr, work, info ) + !> DPTRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric positive definite !> and tridiagonal, and provides error bounds and backward error !> estimates for the solution. - - pure subroutine stdlib_dptrfs( n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr,berr, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54749,13 +54749,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dptrfs - !> DPTSV: computes the solution to a real system of linear equations + + pure subroutine stdlib_dptsv( n, nrhs, d, e, b, ldb, info ) + !> DPTSV computes the solution to a real system of linear equations !> A*X = B, where A is an N-by-N symmetric positive definite tridiagonal !> matrix, and X and B are N-by-NRHS matrices. !> A is factored as A = L*D*L**T, and the factored form of A is then !> used to solve the system of equations. - - pure subroutine stdlib_dptsv( n, nrhs, d, e, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54790,14 +54790,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dptsv - !> DPTSVX: uses the factorization A = L*D*L**T to compute the solution + + pure subroutine stdlib_dptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& + !> DPTSVX uses the factorization A = L*D*L**T to compute the solution !> to a real system of linear equations A*X = B, where A is an N-by-N !> symmetric positive definite tridiagonal matrix and X and B are !> N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - pure subroutine stdlib_dptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& work, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54864,10 +54864,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dptsvx - !> DSBEV: computes all the eigenvalues and, optionally, eigenvectors of - !> a real symmetric band matrix A. subroutine stdlib_dsbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,info ) + !> DSBEV computes all the eigenvalues and, optionally, eigenvectors of + !> a real symmetric band matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54966,12 +54966,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsbev - !> DSBEVX: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_dsbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & + !> DSBEVX computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric band matrix A. Eigenvalues and eigenvectors can !> be selected by specifying either a range of values or a range of !> indices for the desired eigenvalues. - - subroutine stdlib_dsbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & m, w, z, ldz, work, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55192,12 +55192,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsbevx - !> DSBGV: computes all the eigenvalues, and optionally, the eigenvectors + + pure subroutine stdlib_dsbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & + !> DSBGV computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-definite banded eigenproblem, of !> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric !> and banded, and B is also positive definite. - - pure subroutine stdlib_dsbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55270,14 +55270,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsbgv - !> DSBGVX: computes selected eigenvalues, and optionally, eigenvectors + + pure subroutine stdlib_dsbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & + !> DSBGVX computes selected eigenvalues, and optionally, eigenvectors !> of a real generalized symmetric-definite banded eigenproblem, of !> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric !> and banded, and B is also positive definite. Eigenvalues and !> eigenvectors can be selected by specifying either all eigenvalues, !> a range of values or a range of indices for the desired eigenvalues. - - pure subroutine stdlib_dsbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & vu, il, iu, abstol, m, w, z,ldz, work, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55455,7 +55455,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsbgvx - !> DSGESV: computes the solution to a real system of linear equations + + subroutine stdlib_dsgesv( n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work,swork, iter, info ) + !> DSGESV computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N matrix and X and B are N-by-NRHS matrices. !> DSGESV first attempts to factorize the matrix in SINGLE PRECISION @@ -55482,8 +55484,6 @@ module stdlib_linalg_lapack_d !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 !> respectively. - - subroutine stdlib_dsgesv( n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work,swork, iter, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55635,10 +55635,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsgesv - !> DSPEV: computes all the eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A in packed storage. subroutine stdlib_dspev( jobz, uplo, n, ap, w, z, ldz, work, info ) + !> DSPEV computes all the eigenvalues and, optionally, eigenvectors of a + !> real symmetric matrix A in packed storage. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55728,12 +55728,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspev - !> DSPEVX: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_dspevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> DSPEVX computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric matrix A in packed storage. Eigenvalues/vectors !> can be selected by specifying either a range of values or a range of !> indices for the desired eigenvalues. - - subroutine stdlib_dspevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & work, iwork, ifail,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55941,13 +55941,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspevx - !> DSPGV: computes all the eigenvalues and, optionally, the eigenvectors + + subroutine stdlib_dspgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,info ) + !> DSPGV computes all the eigenvalues and, optionally, the eigenvectors !> of a real generalized symmetric-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 symmetric, stored in packed format, !> and B is also positive definite. - - subroutine stdlib_dspgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56025,15 +56025,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspgv - !> DSPGVX: computes selected eigenvalues, and optionally, eigenvectors + + subroutine stdlib_dspgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & + !> DSPGVX computes selected eigenvalues, and optionally, eigenvectors !> of a real generalized symmetric-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 symmetric, stored in packed storage, and B !> is also positive definite. Eigenvalues and eigenvectors can be !> selected by specifying either a range of values or a range of indices !> for the desired eigenvalues. - - subroutine stdlib_dspgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & z, ldz, work, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56137,7 +56137,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspgvx - !> DSPOSV: computes the solution to a real system of linear equations + + subroutine stdlib_dsposv( uplo, n, nrhs, a, lda, b, ldb, x, ldx, work,swork, iter, info ) + !> DSPOSV computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite matrix and X and B !> are N-by-NRHS matrices. @@ -56165,8 +56167,6 @@ module stdlib_linalg_lapack_d !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 !> respectively. - - subroutine stdlib_dsposv( uplo, n, nrhs, a, lda, b, ldb, x, ldx, work,swork, iter, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56316,10 +56316,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsposv - !> DSYEV: computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A. subroutine stdlib_dsyev( jobz, uplo, n, a, lda, w, work, lwork, info ) + !> DSYEV computes all eigenvalues and, optionally, eigenvectors of a + !> real symmetric matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56423,12 +56423,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyev - !> DSYEVX: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_dsyevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> DSYEVX computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric matrix A. Eigenvalues and eigenvectors can be !> selected by specifying either a range of values or a range of indices !> for the desired eigenvalues. - - subroutine stdlib_dsyevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & work, lwork, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56670,13 +56670,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyevx - !> DSYGV: computes all the eigenvalues, and optionally, the eigenvectors + + subroutine stdlib_dsygv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, info ) + !> DSYGV computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-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 symmetric and B is also !> positive definite. - - subroutine stdlib_dsygv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56770,14 +56770,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsygv - !> DSYGVX: computes selected eigenvalues, and optionally, eigenvectors + + subroutine stdlib_dsygvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& + !> DSYGVX computes selected eigenvalues, and optionally, eigenvectors !> of a real generalized symmetric-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 symmetric and B is also positive definite. !> Eigenvalues and eigenvectors can be selected by specifying either a !> range of values or a range of indices for the desired eigenvalues. - - subroutine stdlib_dsygvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& m, w, z, ldz, work,lwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56898,7 +56898,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsygvx - !> DSYSV: computes the solution to a real system of linear equations + + pure subroutine stdlib_dsysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) + !> DSYSV computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS !> matrices. @@ -56909,8 +56911,6 @@ module stdlib_linalg_lapack_d !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_dsysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56976,14 +56976,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsysv - !> DSYSVX: uses the diagonal pivoting factorization to compute the + + subroutine stdlib_dsysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & + !> DSYSVX uses the diagonal pivoting factorization to compute the !> solution to a real system of linear equations A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS !> matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_dsysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & ferr, berr, work, lwork,iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57073,11 +57073,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsysvx - !> DSYTRD_SY2SB: reduces a real symmetric matrix A to real symmetric - !> band-diagonal form AB by a orthogonal similarity transformation: - !> Q**T * A * Q = AB. pure subroutine stdlib_dsytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) + !> DSYTRD_SY2SB reduces a real symmetric matrix A to real symmetric + !> band-diagonal form AB by a orthogonal similarity transformation: + !> Q**T * A * Q = AB. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57249,7 +57249,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrd_sy2sb - !> DTGEVC: computes some or all of the right and/or left eigenvectors of + + pure subroutine stdlib_dtgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & + !> DTGEVC computes some or all of the right and/or left eigenvectors of !> a pair of real matrices (S,P), where S is a quasi-triangular matrix !> and P is upper triangular. Matrix pairs of this type are produced by !> the generalized Schur factorization of a matrix pair (A,B): @@ -57267,8 +57269,6 @@ module stdlib_linalg_lapack_d !> If Q and Z are the orthogonal factors from the generalized Schur !> factorization of a matrix pair (A,B), then Z*X and Q*Y !> are the matrices of right and left eigenvectors of (A,B). - - pure subroutine stdlib_dtgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & mm, m, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57979,7 +57979,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgevc - !> DTGEX2: swaps adjacent diagonal blocks (A11, B11) and (A22, B22) + + pure subroutine stdlib_dtgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, n1, n2, & + !> DTGEX2 swaps adjacent diagonal blocks (A11, B11) and (A22, B22) !> of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair !> (A, B) by an orthogonal equivalence transformation. !> (A, B) must be in generalized real Schur canonical form (as returned @@ -57989,8 +57991,6 @@ module stdlib_linalg_lapack_d !> updated. !> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T !> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T - - pure subroutine stdlib_dtgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, n1, n2, & work, lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58344,7 +58344,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgex2 - !> DTGEXC: reorders the generalized real Schur decomposition of a real + + pure subroutine stdlib_dtgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & + !> DTGEXC reorders the generalized real Schur decomposition of a real !> matrix pair (A,B) using an orthogonal equivalence transformation !> (A, B) = Q * (A, B) * Z**T, !> so that the diagonal block of (A, B) with row index IFST is moved @@ -58356,8 +58358,6 @@ module stdlib_linalg_lapack_d !> updated. !> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T !> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T - - pure subroutine stdlib_dtgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58593,7 +58593,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgexc - !> DTGSEN: reorders the generalized real Schur decomposition of a real + + pure subroutine stdlib_dtgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alphar, alphai, & + !> DTGSEN reorders the generalized real Schur decomposition of a real !> matrix pair (A, B) (in terms of an orthonormal equivalence trans- !> formation Q**T * (A, B) * Z), so that a selected cluster of eigenvalues !> appears in the leading diagonal blocks of the upper quasi-triangular @@ -58613,8 +58615,6 @@ module stdlib_linalg_lapack_d !> the selected cluster and the eigenvalues outside the cluster, resp., !> and norms of "projections" onto left and right eigenspaces w.r.t. !> the selected cluster in the (1,1)-block. - - pure subroutine stdlib_dtgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alphar, alphai, & beta, q, ldq, z, ldz, m, pl,pr, dif, work, lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58919,7 +58919,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgsen - !> DTGSJA: computes the generalized singular value decomposition (GSVD) + + pure subroutine stdlib_dtgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & + !> DTGSJA computes the generalized singular value decomposition (GSVD) !> of two real upper triangular (or trapezoidal) matrices A and B. !> On entry, it is assumed that matrices A and B have the following !> forms, which may be obtained by the preprocessing subroutine DGGSVP @@ -58980,8 +58982,6 @@ module stdlib_linalg_lapack_d !> The computation of the orthogonal transformation matrices U, V or Q !> is optional. These matrices may either be formed explicitly, or they !> may be postmultiplied into input matrices U1, V1, or Q1. - - pure subroutine stdlib_dtgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & alpha, beta, u, ldu, v, ldv,q, ldq, work, ncycle, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59160,7 +59160,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgsja - !> DTGSNA: estimates reciprocal condition numbers for specified + + pure subroutine stdlib_dtgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & + !> DTGSNA estimates reciprocal condition numbers for specified !> eigenvalues and/or eigenvectors of a matrix pair (A, B) in !> generalized real Schur canonical form (or of any matrix pair !> (Q*A*Z**T, Q*B*Z**T) with orthogonal matrices Q and Z, where @@ -59168,8 +59170,6 @@ module stdlib_linalg_lapack_d !> (A, B) must be in generalized real Schur form (as returned by DGGES), !> i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal !> blocks. B is upper triangular. - - pure subroutine stdlib_dtgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & dif, mm, m, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59408,12 +59408,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgsna - !> DTPLQT: computes a blocked LQ factorization of a real + + pure subroutine stdlib_dtplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) + !> DTPLQT computes a blocked LQ factorization of a real !> "triangular-pentagonal" matrix C, which is composed of a !> triangular block A and pentagonal block B, using the compact !> WY representation for Q. - - pure subroutine stdlib_dtplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59470,12 +59470,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtplqt - !> DTPQRT: computes a blocked QR factorization of a real + + pure subroutine stdlib_dtpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) + !> DTPQRT computes a blocked QR factorization of a real !> "triangular-pentagonal" matrix C, which is composed of a !> triangular block A and pentagonal block B, using the compact !> WY representation for Q. - - pure subroutine stdlib_dtpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59532,7 +59532,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtpqrt - !> DTREVC: computes some or all of the right and/or left eigenvectors of + + pure subroutine stdlib_dtrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & + !> DTREVC computes some or all of the right and/or left eigenvectors of !> a real upper quasi-triangular matrix T. !> Matrices of this type are produced by the Schur factorization of !> a real general matrix: A = Q*T*Q**T, as computed by DHSEQR. @@ -59547,8 +59549,6 @@ module stdlib_linalg_lapack_d !> input matrix. If Q is the orthogonal factor that reduces a matrix !> A to Schur form T, then Q*X and Q*Y are the matrices of right and !> left eigenvectors of A. - - pure subroutine stdlib_dtrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60145,7 +60145,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrevc - !> DTREVC3: computes some or all of the right and/or left eigenvectors of + + pure subroutine stdlib_dtrevc3( side, howmny, select, n, t, ldt, vl, ldvl,vr, ldvr, mm, m, & + !> DTREVC3 computes some or all of the right and/or left eigenvectors of !> a real upper quasi-triangular matrix T. !> Matrices of this type are produced by the Schur factorization of !> a real general matrix: A = Q*T*Q**T, as computed by DHSEQR. @@ -60161,8 +60163,6 @@ module stdlib_linalg_lapack_d !> A to Schur form T, then Q*X and Q*Y are the matrices of right and !> left eigenvectors of A. !> This uses a Level 3 BLAS version of the back transformation. - - pure subroutine stdlib_dtrevc3( side, howmny, select, n, t, ldt, vl, ldvl,vr, ldvr, mm, m, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60967,7 +60967,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrevc3 - !> DTRSYL: solves the real Sylvester matrix equation: + + subroutine stdlib_dtrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) + !> DTRSYL solves the real Sylvester matrix equation: !> op(A)*X + X*op(B) = scale*C or !> op(A)*X - X*op(B) = scale*C, !> where op(A) = A or A**T, and A and B are both upper quasi- @@ -60978,8 +60980,6 @@ module stdlib_linalg_lapack_d !> 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. - - subroutine stdlib_dtrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61628,11 +61628,11 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrsyl - !> DGEBRD: reduces a general real M-by-N matrix A to upper or lower - !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. - !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. pure subroutine stdlib_dgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) + !> DGEBRD reduces a general real M-by-N matrix A to upper or lower + !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. + !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61733,10 +61733,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgebrd - !> DGEHRD: reduces a real general matrix A to upper Hessenberg form H by - !> an orthogonal similarity transformation: Q**T * A * Q = H . pure subroutine stdlib_dgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info ) + !> DGEHRD reduces a real general matrix A to upper Hessenberg form H by + !> an orthogonal similarity transformation: Q**T * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61862,10 +61862,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgehrd - !> DGELQT: computes a blocked LQ factorization of a real M-by-N matrix A - !> using the compact WY representation of Q. pure subroutine stdlib_dgelqt( m, n, mb, a, lda, t, ldt, work, info ) + !> DGELQT computes a blocked LQ factorization of a real M-by-N matrix A + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61913,7 +61913,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgelqt - !> DGELS: solves overdetermined or underdetermined real linear systems + + subroutine stdlib_dgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) + !> DGELS solves overdetermined or underdetermined real linear systems !> involving an M-by-N matrix A, or its transpose, using a QR or LQ !> factorization of A. It is assumed that A has full rank. !> The following options are provided: @@ -61931,8 +61933,6 @@ module stdlib_linalg_lapack_d !> 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. - - subroutine stdlib_dgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62130,15 +62130,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgels - !> DGEMLQ: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_dgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & + !> DGEMLQ overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T !> where Q is a real orthogonal matrix defined as the product !> of blocked elementary reflectors computed by short wide LQ !> factorization (DGELQ) - - pure subroutine stdlib_dgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62227,15 +62227,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgemlq - !> DGEMQR: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_dgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & + !> DGEMQR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T !> where Q is a real orthogonal matrix defined as the product !> of blocked elementary reflectors computed by tall skinny !> QR factorization (DGEQR) - - pure subroutine stdlib_dgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62324,10 +62324,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgemqr - !> DGEQP3: computes a QR factorization with column pivoting of a - !> matrix A: A*P = Q*R using Level 3 BLAS. pure subroutine stdlib_dgeqp3( m, n, a, lda, jpvt, tau, work, lwork, info ) + !> DGEQP3 computes a QR factorization with column pivoting of a + !> matrix A: A*P = Q*R using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62474,10 +62474,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeqp3 - !> DGEQRT: computes a blocked QR factorization of a real M-by-N matrix A - !> using the compact WY representation of Q. pure subroutine stdlib_dgeqrt( m, n, nb, a, lda, t, ldt, work, info ) + !> DGEQRT computes a blocked QR factorization of a real M-by-N matrix A + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62531,7 +62531,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeqrt - !> DGESV: computes the solution to a real system of linear equations + + pure subroutine stdlib_dgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) + !> DGESV computes the solution to a real 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 @@ -62540,8 +62542,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62579,7 +62579,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgesv - !> DGESVJ: computes the singular value decomposition (SVD) of a real + + pure subroutine stdlib_dgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, work, lwork, & + !> DGESVJ computes the singular value decomposition (SVD) of a real !> M-by-N matrix A, where M >= N. The SVD of A is written as !> [++] [xx] [x0] [xx] !> A = U * SIGMA * V^t, [++] = [xx] * [ox] * [xx] @@ -62590,8 +62592,6 @@ module stdlib_linalg_lapack_d !> left and the right singular vectors of A, respectively. !> DGESVJ can sometimes compute tiny singular values and their singular vectors much !> more accurately than other SVD routines, see below under Further Details. - - pure subroutine stdlib_dgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63558,14 +63558,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgesvj - !> DGESVX: uses the LU factorization to compute the solution to a real + + subroutine stdlib_dgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & + !> DGESVX uses the LU factorization to compute the solution to a real !> system of linear equations !> A * X = B, !> where A is an N-by-N matrix and X and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_dgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & x, ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63762,7 +63762,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgesvx - !> DGGES: computes for a pair of N-by-N real nonsymmetric matrices (A,B), + + subroutine stdlib_dgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alphar, & + !> DGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B), !> the generalized eigenvalues, the generalized real Schur form (S,T), !> optionally, the left and/or right matrices of Schur vectors (VSL and !> VSR). This gives the generalized Schur factorization @@ -63788,8 +63790,6 @@ module stdlib_linalg_lapack_d !> [ 0 b ] !> and the pair of corresponding 2-by-2 blocks in S and T will have a !> complex conjugate pair of generalized eigenvalues. - - subroutine stdlib_dgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alphar, & alphai, beta, vsl, ldvsl, vsr,ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64081,7 +64081,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgges - !> DGGESX: computes for a pair of N-by-N real nonsymmetric matrices + + subroutine stdlib_dggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, & + !> DGGESX computes for a pair of N-by-N real nonsymmetric matrices !> (A,B), the generalized eigenvalues, the real Schur form (S,T), and, !> optionally, the left and/or right matrices of Schur vectors (VSL and !> VSR). This gives the generalized Schur factorization @@ -64109,8 +64111,6 @@ module stdlib_linalg_lapack_d !> [ 0 b ] !> and the pair of corresponding 2-by-2 blocks in S and T will have a !> complex conjugate pair of generalized eigenvalues. - - subroutine stdlib_dggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, & alphar, alphai, beta, vsl, ldvsl,vsr, ldvsr, rconde, rcondv, work, lwork, iwork,liwork, & bwork, info ) ! -- lapack driver routine -- @@ -64451,7 +64451,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggesx - !> DGGEV: computes for a pair of N-by-N real nonsymmetric matrices (A,B) + + subroutine stdlib_dggev( jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai,beta, vl, ldvl, vr, & + !> DGGEV computes for a pair of N-by-N real 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 @@ -64466,8 +64468,6 @@ module stdlib_linalg_lapack_d !> 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). - - subroutine stdlib_dggev( jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai,beta, vl, ldvl, vr, & ldvr, work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64749,7 +64749,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggev - !> DGGEVX: computes for a pair of N-by-N real nonsymmetric matrices (A,B) + + subroutine stdlib_dggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alphar, alphai, & + !> DGGEVX computes for a pair of N-by-N real nonsymmetric matrices (A,B) !> the generalized eigenvalues, and optionally, the left and/or right !> generalized eigenvectors. !> Optionally also, it computes a balancing transformation to improve @@ -64769,8 +64771,6 @@ module stdlib_linalg_lapack_d !> 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). - - subroutine stdlib_dggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alphar, alphai, & beta, vl, ldvl, vr, ldvr, ilo,ihi, lscale, rscale, abnrm, bbnrm, rconde,rcondv, work, lwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -65144,7 +65144,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggevx - !> DGGGLM: solves a general Gauss-Markov linear model (GLM) problem: + + pure subroutine stdlib_dggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) + !> DGGGLM 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 @@ -65162,8 +65164,6 @@ module stdlib_linalg_lapack_d !> minimize || inv(B)*(d-A*x) ||_2 !> x !> where inv(B) denotes the inverse of B. - - pure subroutine stdlib_dggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65280,7 +65280,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggglm - !> DGGLSE: solves the linear equality-constrained least squares (LSE) + + pure subroutine stdlib_dgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) + !> DGGLSE 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 @@ -65292,8 +65294,6 @@ module stdlib_linalg_lapack_d !> which is obtained using a generalized RQ factorization of the !> matrices (B, A) given by !> B = (0 R)*Q, A = Z*T*Q. - - pure subroutine stdlib_dgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65412,14 +65412,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgglse - !> DHSEIN: uses inverse iteration to find specified right and/or left + + subroutine stdlib_dhsein( side, eigsrc, initv, select, n, h, ldh, wr, wi,vl, ldvl, vr, ldvr, & + !> DHSEIN uses inverse iteration to find specified right and/or left !> eigenvectors of a real 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. - - subroutine stdlib_dhsein( side, eigsrc, initv, select, n, h, ldh, wr, wi,vl, ldvl, vr, ldvr, & mm, m, work, ifaill,ifailr, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65627,14 +65627,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dhsein - !> DLA_PORPVGRW: computes the reciprocal pivot growth factor + + real(dp) function stdlib_dla_porpvgrw( uplo, ncols, a, lda, af,ldaf, work ) + !> DLA_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. - - real(dp) function stdlib_dla_porpvgrw( uplo, ncols, a, lda, af,ldaf, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65715,7 +65715,9 @@ module stdlib_linalg_lapack_d stdlib_dla_porpvgrw = rpvgrw end function stdlib_dla_porpvgrw - !> DLAED3: finds the roots of the secular equation, as defined by the + + pure subroutine stdlib_dlaed3( k, n, n1, d, q, ldq, rho, dlamda, q2, indx,ctot, w, s, info ) + !> DLAED3 finds the roots of the secular equation, as defined by the !> values in D, W, and RHO, between 1 and K. It makes the !> appropriate calls to DLAED4 and then updates the eigenvectors by !> multiplying the matrix of eigenvectors of the pair of eigensystems @@ -65727,8 +65729,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dlaed3( k, n, n1, d, q, ldq, rho, dlamda, q2, indx,ctot, w, s, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65850,7 +65850,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed3 - !> DLAED7: computes the updated eigensystem of a diagonal + + pure subroutine stdlib_dlaed7( icompq, n, qsiz, tlvls, curlvl, curpbm, d, q,ldq, indxq, rho, & + !> DLAED7 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 symmetric matrix @@ -65876,8 +65878,6 @@ module stdlib_linalg_lapack_d !> directly using the updated eigenvalues. The eigenvectors for !> the current problem are multiplied with the eigenvectors from !> the overall problem. - - pure subroutine stdlib_dlaed7( icompq, n, qsiz, tlvls, curlvl, curpbm, d, q,ldq, indxq, rho, & cutpnt, qstore, qptr, prmptr,perm, givptr, givcol, givnum, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65984,15 +65984,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed7 - !> DLAEXC: swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in + + subroutine stdlib_dlaexc( wantq, n, t, ldt, q, ldq, j1, n1, n2, work,info ) + !> DLAEXC 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. - - subroutine stdlib_dlaexc( wantq, n, t, ldt, q, ldq, j1, n1, n2, work,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -66182,12 +66182,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaexc - !> DLAHQR: is an auxiliary routine called by DHSEQR to update the + + pure subroutine stdlib_dlahqr( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, & + !> DLAHQR is an auxiliary routine called by DHSEQR to update the !> eigenvalues and Schur decomposition already computed by DHSEQR, by !> dealing with the Hessenberg submatrix in rows and columns ILO to !> IHI. - - pure subroutine stdlib_dlahqr( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, & info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66491,15 +66491,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlahqr - !> DLASD2: merges the two sets of singular values together into a single + + pure subroutine stdlib_dlasd2( nl, nr, sqre, k, d, z, alpha, beta, u, ldu, vt,ldvt, dsigma, & + !> DLASD2 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. !> DLASD2 is called from DLASD1. - - pure subroutine stdlib_dlasd2( nl, nr, sqre, k, d, z, alpha, beta, u, ldu, vt,ldvt, dsigma, & u2, ldu2, vt2, ldvt2, idxp, idx,idxc, idxq, coltyp, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66776,7 +66776,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd2 - !> DLASWLQ: computes a blocked Tall-Skinny LQ factorization of + + pure subroutine stdlib_dlaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) + !> DLASWLQ computes a blocked Tall-Skinny LQ factorization of !> a real M-by-N matrix A for M <= N: !> A = ( L 0 ) * Q, !> where: @@ -66786,8 +66788,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dlaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -66860,7 +66860,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaswlq - !> DLATSQR: computes a blocked Tall-Skinny QR factorization of + + pure subroutine stdlib_dlatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) + !> DLATSQR computes a blocked Tall-Skinny QR factorization of !> a real M-by-N matrix A for M >= N: !> A = Q * ( R ), !> ( 0 ) @@ -66871,8 +66873,6 @@ module stdlib_linalg_lapack_d !> R is an upper-triangular N-by-N matrix, stored on exit in !> the elements on and above the diagonal of the array A. !> 0 is a (M-N)-by-N zero matrix, and is not stored. - - pure subroutine stdlib_dlatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -66945,7 +66945,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlatsqr - !> DORGBR: generates one of the real orthogonal matrices Q or P**T + + pure subroutine stdlib_dorgbr( vect, m, n, k, a, lda, tau, work, lwork, info ) + !> DORGBR generates one of the real orthogonal matrices Q or P**T !> determined by DGEBRD when reducing a real matrix A to bidiagonal !> form: A = Q * B * P**T. Q and P**T are defined as products of !> elementary reflectors H(i) or G(i) respectively. @@ -66961,8 +66963,6 @@ module stdlib_linalg_lapack_d !> rows of P**T, where n >= m >= k; !> if k >= n, P**T = G(n-1) . . . G(2) G(1) and DORGBR returns P**T as !> an N-by-N matrix. - - pure subroutine stdlib_dorgbr( vect, m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67094,6 +67094,8 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgbr + + pure subroutine stdlib_dormbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & !> If VECT = 'Q', DORMBR: overwrites the general real M-by-N matrix C !> with !> SIDE = 'L' SIDE = 'R' @@ -67116,8 +67118,6 @@ module stdlib_linalg_lapack_d !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: !> if k < nq, P = G(1) G(2) . . . G(k); !> if k >= nq, P = G(1) G(2) . . . G(nq-1). - - pure subroutine stdlib_dormbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67252,7 +67252,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormbr - !> DPBSV: computes the solution to a real system of linear equations + + pure subroutine stdlib_dpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) + !> DPBSV computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite band matrix and X !> and B are N-by-NRHS matrices. @@ -67263,8 +67265,6 @@ module stdlib_linalg_lapack_d !> triangular band matrix, with the same number of superdiagonals or !> subdiagonals as A. The factored form of A is then used to solve the !> system of equations A * X = B. - - pure subroutine stdlib_dpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67306,15 +67306,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpbsv - !> DPBSVX: uses the Cholesky factorization A = U**T*U or A = L*L**T to + + subroutine stdlib_dpbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & + !> DPBSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to !> compute the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite band matrix and X !> and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_dpbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67462,15 +67462,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpbsvx - !> DPFTRF: computes the Cholesky factorization of a real symmetric + + pure subroutine stdlib_dpftrf( transr, uplo, n, a, info ) + !> DPFTRF computes the Cholesky factorization of a real symmetric !> positive definite matrix A. !> The factorization has the form !> A = U**T * U, if UPLO = 'U', or !> A = L * L**T, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the block version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_dpftrf( transr, uplo, n, a, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67637,7 +67637,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpftrf - !> DPOSV: computes the solution to a real system of linear equations + + pure subroutine stdlib_dposv( uplo, n, nrhs, a, lda, b, ldb, info ) + !> DPOSV computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite matrix and X and B !> are N-by-NRHS matrices. @@ -67647,8 +67649,6 @@ module stdlib_linalg_lapack_d !> where U is an upper triangular matrix and L is a lower triangular !> matrix. The factored form of A is then used to solve the system of !> equations A * X = B. - - pure subroutine stdlib_dposv( uplo, n, nrhs, a, lda, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67688,15 +67688,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dposv - !> DPOSVX: uses the Cholesky factorization A = U**T*U or A = L*L**T to + + subroutine stdlib_dposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & + !> DPOSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to !> compute the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite matrix and X and B !> are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_dposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & rcond, ferr, berr, work,iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67831,7 +67831,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dposvx - !> DTREXC: reorders the real Schur factorization of a real matrix + + subroutine stdlib_dtrexc( compq, n, t, ldt, q, ldq, ifst, ilst, work,info ) + !> DTREXC reorders the real Schur factorization of a real matrix !> A = Q*T*Q**T, so that the diagonal block of T with row index IFST is !> moved to row ILST. !> The real Schur form T is reordered by an orthogonal similarity @@ -67841,8 +67843,6 @@ module stdlib_linalg_lapack_d !> 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. - - subroutine stdlib_dtrexc( compq, n, t, ldt, q, ldq, ifst, ilst, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -68035,7 +68035,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrexc - !> DTRSEN: reorders the real Schur factorization of a real matrix + + subroutine stdlib_dtrsen( job, compq, select, n, t, ldt, q, ldq, wr, wi,m, s, sep, work, & + !> DTRSEN reorders the real Schur factorization of a real matrix !> A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in !> the leading diagonal blocks of the upper quasi-triangular matrix T, !> and the leading columns of Q form an orthonormal basis of the @@ -68046,8 +68048,6 @@ module stdlib_linalg_lapack_d !> 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. - - subroutine stdlib_dtrsen( job, compq, select, n, t, ldt, q, ldq, wr, wi,m, s, sep, work, & lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68230,7 +68230,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrsen - !> DTRSNA: estimates reciprocal condition numbers for specified + + subroutine stdlib_dtrsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm, m, & + !> DTRSNA estimates reciprocal condition numbers for specified !> eigenvalues and/or right eigenvectors of a real upper !> quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q !> orthogonal). @@ -68238,8 +68240,6 @@ module stdlib_linalg_lapack_d !> 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. - - subroutine stdlib_dtrsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm, m, & work, ldwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68475,7 +68475,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrsna - !> DGEJSV: computes the singular value decomposition (SVD) of a real M-by-N + + pure subroutine stdlib_dgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & + !> DGEJSV computes the singular value decomposition (SVD) of a real M-by-N !> matrix [A], where M >= N. The SVD of [A] is written as !> [A] = [U] * [SIGMA] * [V]^t, !> where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N @@ -68487,8 +68489,6 @@ module stdlib_linalg_lapack_d !> of [SIGMA] is computed and stored in the array SVA. !> DGEJSV can sometimes compute tiny singular values and their singular vectors much !> more accurately than other SVD routines, see below under Further Details. - - pure subroutine stdlib_dgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & v, ldv,work, lwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69565,14 +69565,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgejsv - !> DGELQ: computes an LQ factorization of a real M-by-N matrix A: + + pure subroutine stdlib_dgelq( m, n, a, lda, t, tsize, work, lwork,info ) + !> DGELQ computes an LQ factorization of a real 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. - - pure subroutine stdlib_dgelq( m, n, a, lda, t, tsize, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -69690,7 +69690,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgelq - !> DGELSY: computes the minimum-norm solution to a real linear least + + subroutine stdlib_dgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, info ) + !> DGELSY computes the minimum-norm solution to a real linear least !> squares problem: !> minimize || A * X - B || !> using a complete orthogonal factorization of A. A is an M-by-N @@ -69722,8 +69724,6 @@ module stdlib_linalg_lapack_d !> o Matrix B (the right hand side) is updated with Blas-3. !> o The permutation of matrix B (the right hand side) is faster and !> more simple. - - subroutine stdlib_dgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69923,15 +69923,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgelsy - !> DGEQR: computes a QR factorization of a real M-by-N matrix A: + + pure subroutine stdlib_dgeqr( m, n, a, lda, t, tsize, work, lwork,info ) + !> DGEQR computes a QR factorization of a real 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. - - pure subroutine stdlib_dgeqr( m, n, a, lda, t, tsize, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -70038,7 +70038,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeqr - !> DGETSLS: solves overdetermined or underdetermined real linear systems + + subroutine stdlib_dgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) + !> DGETSLS solves overdetermined or underdetermined real 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: @@ -70056,8 +70058,6 @@ module stdlib_linalg_lapack_d !> 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. - - subroutine stdlib_dgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -70274,7 +70274,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetsls - !> DGETSQRHRT: computes a NB2-sized column blocked QR-factorization + + pure subroutine stdlib_dgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) + !> DGETSQRHRT computes a NB2-sized column blocked QR-factorization !> of a real M-by-N matrix A with M >= N, !> A = Q * R. !> The routine uses internally a NB1-sized column blocked and MB1-sized @@ -70286,8 +70288,6 @@ module stdlib_linalg_lapack_d !> The output Q and R factors are stored in the same format as in DGEQRT !> (Q is in blocked compact WY-representation). See the documentation !> of DGEQRT for more details on the format. - - pure subroutine stdlib_dgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70407,14 +70407,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetsqrhrt - !> DLAED2: merges the two sets of eigenvalues together into a single + + pure subroutine stdlib_dlaed2( k, n, n1, d, q, ldq, indxq, rho, z, dlamda, w,q2, indx, indxc,& + !> DLAED2 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 entry in the !> Z vector. For each such occurrence the order of the related secular !> equation problem is reduced by one. - - pure subroutine stdlib_dlaed2( k, n, n1, d, q, ldq, indxq, rho, z, dlamda, w,q2, indx, indxc,& indxp, coltyp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70664,7 +70664,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed2 - !> DLAQR2: is identical to DLAQR3 except that it avoids + + subroutine stdlib_dlaqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& + !> DLAQR2 is identical to DLAQR3 except that it avoids !> recursion by calling DLAHQR instead of DLAQR4. !> Aggressive early deflation: !> This subroutine accepts as input an upper Hessenberg matrix @@ -70675,8 +70677,6 @@ module stdlib_linalg_lapack_d !> an orthogonal similarity transformation of H. It is to be !> hoped that the final version of H has many zero subdiagonal !> entries. - - subroutine stdlib_dlaqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& sr, si, v, ldv, nh, t,ldt, nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70967,7 +70967,9 @@ module stdlib_linalg_lapack_d work( 1 ) = real( lwkopt,KIND=dp) end subroutine stdlib_dlaqr2 - !> DLASD1: computes the SVD of an upper bidiagonal N-by-M matrix B, + + pure subroutine stdlib_dlasd1( nl, nr, sqre, d, alpha, beta, u, ldu, vt, ldvt,idxq, iwork, & + !> DLASD1 computes the SVD of an upper bidiagonal N-by-M matrix B, !> where N = NL + NR + 1 and M = N + SQRE. DLASD1 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. @@ -70996,8 +70998,6 @@ module stdlib_linalg_lapack_d !> directly using the updated singular values. The singular vectors !> for the current problem are multiplied with the singular vectors !> from the overall problem. - - pure subroutine stdlib_dlasd1( nl, nr, sqre, d, alpha, beta, u, ldu, vt, ldvt,idxq, iwork, & work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71082,7 +71082,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd1 - !> DLAED1: computes the updated eigensystem of a diagonal + + pure subroutine stdlib_dlaed1( n, d, q, ldq, indxq, rho, cutpnt, work, iwork,info ) + !> DLAED1 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 @@ -71108,8 +71110,6 @@ module stdlib_linalg_lapack_d !> directly using the updated eigenvalues. The eigenvectors for !> the current problem are multiplied with the eigenvectors from !> the overall problem. - - pure subroutine stdlib_dlaed1( n, d, q, ldq, indxq, rho, cutpnt, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -71185,10 +71185,10 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed1 - !> DLAED0: computes all eigenvalues and corresponding eigenvectors of a - !> symmetric tridiagonal matrix using the divide and conquer method. pure subroutine stdlib_dlaed0( icompq, qsiz, n, d, e, q, ldq, qstore, ldqs,work, iwork, info & + !> DLAED0 computes all eigenvalues and corresponding eigenvectors of a + !> symmetric tridiagonal matrix using the divide and conquer method. ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71389,7 +71389,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed0 - !> DSTEDC: computes all eigenvalues and, optionally, eigenvectors of a + + pure subroutine stdlib_dstedc( compz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) + !> DSTEDC computes all eigenvalues and, optionally, eigenvectors of a !> symmetric tridiagonal matrix using the divide and conquer method. !> The eigenvectors of a full or band real symmetric matrix can also be !> found if DSYTRD or DSPTRD or DSBTRD has been used to reduce this @@ -71400,8 +71402,6 @@ module stdlib_linalg_lapack_d !> 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 DLAED3 for details. - - pure subroutine stdlib_dstedc( compz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71615,7 +71615,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dstedc - !> DSTEVD: computes all eigenvalues and, optionally, eigenvectors of a + + pure subroutine stdlib_dstevd( jobz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) + !> DSTEVD computes all eigenvalues and, optionally, eigenvectors of a !> real symmetric tridiagonal matrix. If eigenvectors are desired, it !> uses a divide and conquer algorithm. !> The divide and conquer algorithm makes very mild assumptions about @@ -71624,8 +71626,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dstevd( jobz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71720,7 +71720,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dstevd - !> DSYEVD: computes all eigenvalues and, optionally, eigenvectors of a + + subroutine stdlib_dsyevd( jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info ) + !> DSYEVD computes all eigenvalues and, optionally, eigenvectors of a !> real symmetric matrix A. If eigenvectors are desired, it uses a !> divide and conquer algorithm. !> The divide and conquer algorithm makes very mild assumptions about @@ -71731,8 +71733,6 @@ module stdlib_linalg_lapack_d !> without guard digits, but we know of none. !> Because of large use of BLAS of level 3, DSYEVD needs N**2 more !> workspace than DSYEVX. - - subroutine stdlib_dsyevd( jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -71854,7 +71854,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyevd - !> DSYGVD: computes all the eigenvalues, and optionally, the eigenvectors + + subroutine stdlib_dsygvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, iwork, liwork,& + !> DSYGVD computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-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 symmetric and B is also positive definite. @@ -71865,8 +71867,6 @@ module stdlib_linalg_lapack_d !> 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. - - subroutine stdlib_dsygvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, iwork, liwork,& info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71975,7 +71975,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsygvd - !> DSBEVD: computes all the eigenvalues and, optionally, eigenvectors of + + subroutine stdlib_dsbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, iwork, liwork, & + !> DSBEVD computes all the eigenvalues and, optionally, eigenvectors of !> a real symmetric band matrix A. If eigenvectors are desired, it uses !> a divide and conquer algorithm. !> The divide and conquer algorithm makes very mild assumptions about @@ -71984,8 +71986,6 @@ module stdlib_linalg_lapack_d !> 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. - - subroutine stdlib_dsbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, iwork, liwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72107,7 +72107,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsbevd - !> DSBGVD: computes all the eigenvalues, and optionally, the eigenvectors + + pure subroutine stdlib_dsbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & + !> DSBGVD computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-definite banded eigenproblem, of the !> form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric and !> banded, and B is also positive definite. If eigenvectors are @@ -72118,8 +72120,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dsbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & lwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72224,7 +72224,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsbgvd - !> DSPEVD: computes all the eigenvalues and, optionally, eigenvectors + + subroutine stdlib_dspevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,iwork, liwork, info ) + !> DSPEVD computes all the eigenvalues and, optionally, eigenvectors !> of a real symmetric 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 @@ -72233,8 +72235,6 @@ module stdlib_linalg_lapack_d !> 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. - - subroutine stdlib_dspevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72349,7 +72349,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspevd - !> DSPGVD: computes all the eigenvalues, and optionally, the eigenvectors + + subroutine stdlib_dspgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, iwork, liwork,& + !> DSPGVD computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-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 symmetric, stored in packed format, and B is also @@ -72361,8 +72363,6 @@ module stdlib_linalg_lapack_d !> 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. - - subroutine stdlib_dspgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, iwork, liwork,& info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72473,7 +72473,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspgvd - !> DBDSDC: computes the singular value decomposition (SVD) of a real + + pure subroutine stdlib_dbdsdc( uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq,work, iwork, & + !> DBDSDC 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 @@ -72489,8 +72491,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dbdsdc( uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq,work, iwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72731,7 +72731,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dbdsdc - !> DBDSQR: computes the singular values and, optionally, the right and/or + + pure subroutine stdlib_dbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, work, & + !> DBDSQR 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 @@ -72755,8 +72757,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, work, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73197,7 +73197,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dbdsqr - !> DGEES: computes for an N-by-N real nonsymmetric matrix A, the + + subroutine stdlib_dgees( jobvs, sort, select, n, a, lda, sdim, wr, wi,vs, ldvs, work, lwork, & + !> DGEES computes for an N-by-N real nonsymmetric matrix A, the !> eigenvalues, the real Schur form T, and, optionally, the matrix of !> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). !> Optionally, it also orders the eigenvalues on the diagonal of the @@ -73210,8 +73212,6 @@ module stdlib_linalg_lapack_d !> [ a b ] !> [ c a ] !> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). - - subroutine stdlib_dgees( jobvs, sort, select, n, a, lda, sdim, wr, wi,vs, ldvs, work, lwork, & bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73443,7 +73443,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgees - !> DGEESX: computes for an N-by-N real nonsymmetric matrix A, the + + subroutine stdlib_dgeesx( jobvs, sort, select, sense, n, a, lda, sdim,wr, wi, vs, ldvs, & + !> DGEESX computes for an N-by-N real nonsymmetric matrix A, the !> eigenvalues, the real Schur form T, and, optionally, the matrix of !> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). !> Optionally, it also orders the eigenvalues on the diagonal of the @@ -73462,8 +73464,6 @@ module stdlib_linalg_lapack_d !> [ a b ] !> [ c a ] !> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). - - subroutine stdlib_dgeesx( jobvs, sort, select, sense, n, a, lda, sdim,wr, wi, vs, ldvs, & rconde, rcondv, work, lwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73737,7 +73737,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeesx - !> DGEEV: computes for an N-by-N real nonsymmetric matrix A, the + + subroutine stdlib_dgeev( jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr,ldvr, work, lwork, & + !> DGEEV computes for an N-by-N real 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) @@ -73747,8 +73749,6 @@ module stdlib_linalg_lapack_d !> 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. - - subroutine stdlib_dgeev( jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr,ldvr, work, lwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73996,7 +73996,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeev - !> DGEEVX: computes for an N-by-N real nonsymmetric matrix A, the + + subroutine stdlib_dgeevx( balanc, jobvl, jobvr, sense, n, a, lda, wr, wi,vl, ldvl, vr, ldvr, & + !> DGEEVX computes for an N-by-N real nonsymmetric matrix A, the !> eigenvalues and, optionally, the left and/or right eigenvectors. !> Optionally also, it computes a balancing transformation to improve !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, @@ -74021,8 +74023,6 @@ module stdlib_linalg_lapack_d !> (in exact arithmetic) but diagonal scaling will. For further !> explanation of balancing, see section 4.10.2_dp of the LAPACK !> Users' Guide. - - subroutine stdlib_dgeevx( balanc, jobvl, jobvr, sense, n, a, lda, wr, wi,vl, ldvl, vr, ldvr, & ilo, ihi, scale, abnrm,rconde, rcondv, work, lwork, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74308,7 +74308,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeevx - !> DGELSD: computes the minimum-norm solution to a real linear least + + subroutine stdlib_dgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, iwork, & + !> DGELSD 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 @@ -74333,8 +74335,6 @@ module stdlib_linalg_lapack_d !> 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. - - subroutine stdlib_dgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, iwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74631,7 +74631,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgelsd - !> DGELSS: computes the minimum norm solution to a real linear least + + subroutine stdlib_dgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, info ) + !> DGELSS 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 @@ -74643,8 +74645,6 @@ module stdlib_linalg_lapack_d !> The effective rank of A is determined by treating as zero those !> singular values which are less than RCOND times the largest singular !> value. - - subroutine stdlib_dgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75073,7 +75073,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgelss - !> DGESDD: computes the singular value decomposition (SVD) of a real + + subroutine stdlib_dgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, iwork, info ) + !> DGESDD computes the singular value decomposition (SVD) of a real !> M-by-N matrix A, optionally computing the left and right singular !> vectors. If singular vectors are desired, it uses a !> divide-and-conquer algorithm. @@ -75092,8 +75094,6 @@ module stdlib_linalg_lapack_d !> 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. - - subroutine stdlib_dgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76044,7 +76044,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgesdd - !> DGESVD: computes the singular value decomposition (SVD) of a real + + subroutine stdlib_dgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,vt, ldvt, work, lwork, info ) + !> DGESVD computes the singular value decomposition (SVD) of a real !> M-by-N matrix A, optionally computing the left and/or right singular !> vectors. The SVD is written !> A = U * SIGMA * transpose(V) @@ -76055,8 +76057,6 @@ module stdlib_linalg_lapack_d !> 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**T, not V. - - subroutine stdlib_dgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,vt, ldvt, work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78303,7 +78303,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgesvd - !> DGESVDQ: computes the singular value decomposition (SVD) of a real + + subroutine stdlib_dgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & + !> DGESVDQ computes the singular value decomposition (SVD) of a real !> 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] @@ -78312,8 +78314,6 @@ module stdlib_linalg_lapack_d !> matrix, and V is an N-by-N orthogonal 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. - - subroutine stdlib_dgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & numrank, iwork, liwork,work, lwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -79168,7 +79168,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgesvdq - !> DGGES3: computes for a pair of N-by-N real nonsymmetric matrices (A,B), + + subroutine stdlib_dgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alphar, & + !> DGGES3 computes for a pair of N-by-N real nonsymmetric matrices (A,B), !> the generalized eigenvalues, the generalized real Schur form (S,T), !> optionally, the left and/or right matrices of Schur vectors (VSL and !> VSR). This gives the generalized Schur factorization @@ -79194,8 +79196,6 @@ module stdlib_linalg_lapack_d !> [ 0 b ] !> and the pair of corresponding 2-by-2 blocks in S and T will have a !> complex conjugate pair of generalized eigenvalues. - - subroutine stdlib_dgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alphar, & alphai, beta, vsl, ldvsl,vsr, ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79482,7 +79482,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgges3 - !> DGGEV3: computes for a pair of N-by-N real nonsymmetric matrices (A,B) + + subroutine stdlib_dggev3( jobvl, jobvr, n, a, lda, b, ldb, alphar,alphai, beta, vl, ldvl, vr,& + !> DGGEV3 computes for a pair of N-by-N real 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 @@ -79497,8 +79499,6 @@ module stdlib_linalg_lapack_d !> 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). - - subroutine stdlib_dggev3( jobvl, jobvr, n, a, lda, b, ldb, alphar,alphai, beta, vl, ldvl, vr,& ldvr, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79782,7 +79782,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggev3 - !> DHSEQR: computes the eigenvalues of a Hessenberg matrix H + + subroutine stdlib_dhseqr( job, compz, n, ilo, ihi, h, ldh, wr, wi, z,ldz, work, lwork, info ) + !> DHSEQR computes the eigenvalues of a Hessenberg matrix H !> and, optionally, the matrices T and Z from the Schur decomposition !> H = Z T Z**T, where T is an upper quasi-triangular matrix (the !> Schur form), and Z is the orthogonal matrix of Schur vectors. @@ -79790,8 +79792,6 @@ module stdlib_linalg_lapack_d !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. - - subroutine stdlib_dhseqr( job, compz, n, ilo, ihi, h, ldh, wr, wi, z,ldz, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79929,7 +79929,9 @@ module stdlib_linalg_lapack_d end if end subroutine stdlib_dhseqr - !> DLALSA: is an itermediate step in solving the least squares problem + + pure subroutine stdlib_dlalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, difl,& + !> DLALSA 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.). @@ -79938,8 +79940,6 @@ module stdlib_linalg_lapack_d !> ICOMPQ = 1, DLALSA applies the right singular vector matrix to the !> right hand side. The singular vector matrices were generated in !> compact form by DLALSA. - - pure subroutine stdlib_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 ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80113,7 +80113,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlalsa - !> DLALSD: uses the singular value decomposition of A to solve the least + + pure subroutine stdlib_dlalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, iwork, & + !> DLALSD 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. @@ -80127,8 +80129,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dlalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, iwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80386,7 +80386,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlalsd - !> DLAQR0: computes the eigenvalues of a Hessenberg matrix H + + subroutine stdlib_dlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& + !> DLAQR0 computes the eigenvalues of a Hessenberg matrix H !> and, optionally, the matrices T and Z from the Schur decomposition !> H = Z T Z**T, where T is an upper quasi-triangular matrix (the !> Schur form), and Z is the orthogonal matrix of Schur vectors. @@ -80394,8 +80396,6 @@ module stdlib_linalg_lapack_d !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. - - subroutine stdlib_dlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80756,8 +80756,10 @@ module stdlib_linalg_lapack_d work( 1 ) = real( lwkopt,KIND=dp) end subroutine stdlib_dlaqr0 + + subroutine stdlib_dlaqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& !> Aggressive early deflation: - !> DLAQR3: accepts as input an upper Hessenberg matrix + !> DLAQR3 accepts as input an upper Hessenberg matrix !> H and performs an orthogonal similarity transformation !> designed to detect and deflate fully converged eigenvalues from !> a trailing principal submatrix. On output H has been over- @@ -80765,8 +80767,6 @@ module stdlib_linalg_lapack_d !> an orthogonal similarity transformation of H. It is to be !> hoped that the final version of H has many zero subdiagonal !> entries. - - subroutine stdlib_dlaqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& sr, si, v, ldv, nh, t,ldt, nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -81067,7 +81067,9 @@ module stdlib_linalg_lapack_d work( 1 ) = real( lwkopt,KIND=dp) end subroutine stdlib_dlaqr3 - !> DLAQR4: implements one level of recursion for DLAQR0. + + subroutine stdlib_dlaqr4( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& + !> DLAQR4 implements one level of recursion for DLAQR0. !> It is a complete implementation of the small bulge multi-shift !> QR algorithm. It may be called by DLAQR0 and, for large enough !> deflation window size, it may be called by DLAQR3. This @@ -81081,8 +81083,6 @@ module stdlib_linalg_lapack_d !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. - - subroutine stdlib_dlaqr4( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -81438,7 +81438,9 @@ module stdlib_linalg_lapack_d work( 1 ) = real( lwkopt,KIND=dp) end subroutine stdlib_dlaqr4 - !> DLAQZ0: computes the eigenvalues of a real matrix pair (H,T), + + recursive subroutine stdlib_dlaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alphar, & + !> DLAQZ0 computes the eigenvalues of a real 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 @@ -81486,8 +81488,6 @@ module stdlib_linalg_lapack_d !> 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" - - recursive subroutine stdlib_dlaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alphar, & alphai, beta,q, ldq, z, ldz, work, lwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -81830,9 +81830,9 @@ module stdlib_linalg_lapack_d info = norm_info end subroutine stdlib_dlaqz0 - !> DLAQZ3: performs AED recursive subroutine stdlib_dlaqz3( ilschur, ilq, ilz, n, ilo, ihi, nw,a, lda, b, ldb, q, & + !> DLAQZ3 performs AED ldq, z, ldz, ns,nd, alphar, alphai, beta, qc, ldqc,zc, ldzc, work, lwork, rec, info ) ! arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -82102,6 +82102,8 @@ module stdlib_linalg_lapack_d end if end subroutine stdlib_dlaqz3 + + pure subroutine stdlib_dlarre( range, n, vl, vu, il, iu, d, e, e2,rtol1, rtol2, spltol, & !> To find the desired eigenvalues of a given real symmetric !> tridiagonal matrix T, DLARRE: sets any "small" off-diagonal !> elements to zero, and for each unreduced block T_i, it finds @@ -82115,8 +82117,6 @@ module stdlib_linalg_lapack_d !> conpute all and then discard any unwanted one. !> As an added benefit, DLARRE also outputs the n !> Gerschgorin intervals for the matrices L_i D_i L_i^T. - - pure subroutine stdlib_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 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82627,6 +82627,8 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarre + + pure subroutine stdlib_dlasd0( n, sqre, d, e, u, ldu, vt, ldvt, smlsiz, iwork,work, info ) !> Using a divide and conquer approach, DLASD0: 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. @@ -82634,8 +82636,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dlasd0( n, sqre, d, e, u, ldu, vt, ldvt, smlsiz, iwork,work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82766,6 +82766,8 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd0 + + pure subroutine stdlib_dlasda( icompq, smlsiz, n, sqre, d, e, u, ldu, vt, k,difl, difr, z, & !> Using a divide and conquer approach, DLASDA: 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 @@ -82774,8 +82776,6 @@ module stdlib_linalg_lapack_d !> compact form. !> A related subroutine, DLASD0, computes the singular values and !> the singular vectors in explicit form. - - pure subroutine stdlib_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 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82968,7 +82968,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasda - !> DLASDQ: computes the singular value decomposition (SVD) of a real + + pure subroutine stdlib_dlasdq( uplo, sqre, n, ncvt, nru, ncc, d, e, vt, ldvt,u, ldu, c, ldc, & + !> DLASDQ 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 @@ -82980,8 +82982,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dlasdq( uplo, sqre, n, ncvt, nru, ncc, d, e, vt, ldvt,u, ldu, c, ldc, & work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83133,7 +83133,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasdq - !> DLASQ1: computes the singular values of a real N-by-N bidiagonal + + pure subroutine stdlib_dlasq1( n, d, e, work, info ) + !> DLASQ1 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 @@ -83143,8 +83145,6 @@ module stdlib_linalg_lapack_d !> 1994, !> and the present implementation is described in "An implementation of !> the dqds Algorithm (Positive Case)", LAPACK Working Note. - - pure subroutine stdlib_dlasq1( n, d, e, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83225,7 +83225,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasq1 - !> DLASQ2: computes all the eigenvalues of the symmetric positive + + pure subroutine stdlib_dlasq2( n, z, info ) + !> DLASQ2 computes all the eigenvalues of the symmetric positive !> definite tridiagonal matrix associated with the qd array Z to high !> relative accuracy are computed to high relative accuracy, in the !> absence of denormalization, underflow and overflow. @@ -83238,8 +83240,6 @@ module stdlib_linalg_lapack_d !> on machines which follow ieee-754 floating-point standard in their !> handling of infinities and NaNs, and false otherwise. This variable !> is passed to DLASQ3. - - pure subroutine stdlib_dlasq2( n, z, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83613,6 +83613,8 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasq2 + + pure subroutine stdlib_dlasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) !> DLATRF_AA factorizes a panel of a real 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. @@ -83623,8 +83625,6 @@ module stdlib_linalg_lapack_d !> 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. - - pure subroutine stdlib_dlasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83847,7 +83847,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasyf_aa - !> DPTEQR: computes all eigenvalues and, optionally, eigenvectors of a + + pure subroutine stdlib_dpteqr( compz, n, d, e, z, ldz, work, info ) + !> DPTEQR computes all eigenvalues and, optionally, eigenvectors of a !> symmetric positive definite tridiagonal matrix by first factoring the !> matrix using DPTTRF, and then calling DBDSQR to compute the singular !> values of the bidiagonal factor. @@ -83862,8 +83864,6 @@ module stdlib_linalg_lapack_d !> form, however, may preclude the possibility of obtaining high !> relative accuracy in the small eigenvalues of the original matrix, if !> these eigenvalues range over many orders of magnitude.) - - pure subroutine stdlib_dpteqr( compz, n, d, e, z, ldz, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83941,7 +83941,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpteqr - !> DSTEGR: computes selected eigenvalues and, optionally, eigenvectors + + pure subroutine stdlib_dstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> DSTEGR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has !> a well defined set of pairwise different real eigenvalues, the corresponding !> real eigenvectors are pairwise orthogonal. @@ -83957,8 +83959,6 @@ module stdlib_linalg_lapack_d !> NaNs. Normal execution may create these exceptiona values and hence !> may abort due to a floating point exception in environments which !> do not conform to the IEEE-754 standard. - - pure subroutine stdlib_dstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83983,7 +83983,9 @@ module stdlib_linalg_lapack_d tryrac, work, lwork,iwork, liwork, info ) end subroutine stdlib_dstegr - !> DSTEMR: computes selected eigenvalues and, optionally, eigenvectors + + pure subroutine stdlib_dstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & + !> DSTEMR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has !> a well defined set of pairwise different real eigenvalues, the corresponding !> real eigenvectors are pairwise orthogonal. @@ -84028,8 +84030,6 @@ module stdlib_linalg_lapack_d !> floating-point standard in their handling of infinities and NaNs. !> This permits the use of efficient inner loops avoiding a check for !> zero divisors. - - pure subroutine stdlib_dstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84403,7 +84403,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dstemr - !> DSTEVR: computes selected eigenvalues and, optionally, eigenvectors + + pure subroutine stdlib_dstevr( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & + !> DSTEVR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Eigenvalues and !> eigenvectors can be selected by specifying either a range of values !> or a range of indices for the desired eigenvalues. @@ -84438,8 +84440,6 @@ module stdlib_linalg_lapack_d !> hence may abort due to a floating point exception in environments !> which do not handle NaNs and infinities in the ieee standard default !> manner. - - pure subroutine stdlib_dstevr( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & isuppz, work, lwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84653,7 +84653,9 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dstevr - !> DSYEVR: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_dsyevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> DSYEVR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric matrix A. Eigenvalues and eigenvectors can be !> selected by specifying either a range of values or a range of !> indices for the desired eigenvalues. @@ -84703,8 +84705,6 @@ module stdlib_linalg_lapack_d !> hence may abort due to a floating point exception in environments !> which do not handle NaNs and infinities in the ieee standard default !> manner. - - subroutine stdlib_dsyevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & isuppz, work, lwork,iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84975,6 +84975,8 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyevr + + pure subroutine stdlib_dsysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) !> DSYSV computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS @@ -84985,8 +84987,6 @@ module stdlib_linalg_lapack_d !> where U (or L) is a product of permutation and unit upper (lower) !> triangular matrices, and T is symmetric tridiagonal. The factored !> form of A is then used to solve the system of equations A * X = B. - - pure subroutine stdlib_dsysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -85047,14 +85047,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsysv_aa - !> DSYTRF_AA: computes the factorization of a real symmetric matrix A + + pure subroutine stdlib_dsytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) + !> DSYTRF_AA computes the factorization of a real symmetric matrix A !> using the Aasen's algorithm. The form of the factorization is !> A = U**T*T*U or A = L*T*L**T !> where U (or L) is a product of permutation and unit upper (lower) !> triangular matrices, and T is a symmetric tridiagonal matrix. !> This is the blocked version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_dsytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_lapack_q.fypp b/src/stdlib_linalg_lapack_q.fypp index 66a9ecd67..6d4b7d263 100644 --- a/src/stdlib_linalg_lapack_q.fypp +++ b/src/stdlib_linalg_lapack_q.fypp @@ -523,6 +523,8 @@ module stdlib_linalg_lapack_q contains + + pure subroutine stdlib_qbbcsd( jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q,theta, phi, u1, & !> DBBCSD: computes the CS decomposition of an orthogonal matrix in !> bidiagonal-block form, !> [ B11 | B12 0 0 ] @@ -544,8 +546,6 @@ module stdlib_linalg_lapack_q !> The orthogonal matrices U1, U2, V1T, and V2T are input/output. !> The input matrices are pre- or post-multiplied by the appropriate !> singular vector matrices. - - pure subroutine stdlib_qbbcsd( 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, work, & lwork, info ) ! -- lapack computational routine -- @@ -1131,6 +1131,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qbbcsd + + pure subroutine stdlib_qbdsdc( uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq,work, iwork, & !> DBDSDC: 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 @@ -1147,8 +1149,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qbdsdc( uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq,work, iwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1389,6 +1389,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qbdsdc + + pure subroutine stdlib_qbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, work, & !> DBDSQR: 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 @@ -1413,8 +1415,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, work, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1855,6 +1855,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qbdsqr + + pure subroutine stdlib_qdisna( job, m, n, d, sep, info ) !> DDISNA: 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 @@ -1868,8 +1870,6 @@ module stdlib_linalg_lapack_q !> the error bound. !> DDISNA may also be used to compute error bounds for eigenvectors of !> the generalized symmetric definite eigenproblem. - - pure subroutine stdlib_qdisna( job, m, n, d, sep, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1960,12 +1960,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qdisna + + pure subroutine stdlib_qgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & !> DGBBRD: reduces a real general m-by-n band matrix A to upper !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. !> The routine computes B, and optionally forms Q or P**T, or computes !> Q**T*C for a given matrix C. - - pure subroutine stdlib_qgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2217,14 +2217,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbbrd + + pure subroutine stdlib_qgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, iwork, & !> DGBCON: estimates the reciprocal of the condition number of a real !> general band matrix A, in either the 1-norm or the infinity-norm, !> using the LU factorization computed by DGBTRF. !> 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)) ). - - pure subroutine stdlib_qgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, iwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2346,6 +2346,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbcon + + pure subroutine stdlib_qgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) !> DGBEQU: 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 @@ -2355,8 +2357,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2476,6 +2476,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbequ + + pure subroutine stdlib_qgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) !> DGBEQUB: 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 @@ -2491,8 +2493,6 @@ module stdlib_linalg_lapack_q !> 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). - - pure subroutine stdlib_qgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2621,11 +2621,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbequb + + pure subroutine stdlib_qgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, x, & !> DGBRFS: 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. - - pure subroutine stdlib_qgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, x, & ldx, ferr, berr, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2822,6 +2822,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbrfs + + pure subroutine stdlib_qgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) !> DGBSV: computes the solution to a real 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. @@ -2830,8 +2832,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2874,14 +2874,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbsv + + subroutine stdlib_qgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & !> DGBSVX: uses the LU factorization to compute the solution to a real !> system of linear equations A * X = B, A**T * X = B, or A**H * 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. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_qgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & c, b, ldb, x, ldx,rcond, ferr, berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -3097,11 +3097,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbsvx + + pure subroutine stdlib_qgbtf2( m, n, kl, ku, ab, ldab, ipiv, info ) !> DGBTF2: computes an LU factorization of a real m-by-n band matrix A !> using partial pivoting with row interchanges. !> This is the unblocked version of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_qgbtf2( m, n, kl, ku, ab, ldab, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3183,11 +3183,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbtf2 + + pure subroutine stdlib_qgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) !> DGBTRF: computes an LU factorization of a real m-by-n band matrix A !> using partial pivoting with row interchanges. !> This is the blocked version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_qgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3433,12 +3433,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbtrf + + pure subroutine stdlib_qgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) !> DGBTRS: solves a system of linear equations !> A * X = B or A**T * X = B !> with a general band matrix A using the LU factorization computed !> by DGBTRF. - - pure subroutine stdlib_qgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3527,11 +3527,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbtrs + + pure subroutine stdlib_qgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) !> DGEBAK: forms the right or left eigenvectors of a real general matrix !> by backward transformation on the computed eigenvectors of the !> balanced matrix output by DGEBAL. - - pure subroutine stdlib_qgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3624,6 +3624,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgebak + + pure subroutine stdlib_qgebal( job, n, a, lda, ilo, ihi, scale, info ) !> DGEBAL: balances a general real 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 @@ -3632,8 +3634,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qgebal( job, n, a, lda, ilo, ihi, scale, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3792,11 +3792,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgebal + + pure subroutine stdlib_qgebd2( m, n, a, lda, d, e, tauq, taup, work, info ) !> DGEBD2: reduces a real general m by n matrix A to upper or lower !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. - - pure subroutine stdlib_qgebd2( m, n, a, lda, d, e, tauq, taup, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3884,11 +3884,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgebd2 + + pure subroutine stdlib_qgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) !> DGEBRD: reduces a general real M-by-N matrix A to upper or lower !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. - - pure subroutine stdlib_qgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3989,14 +3989,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgebrd + + pure subroutine stdlib_qgecon( norm, n, a, lda, anorm, rcond, work, iwork,info ) !> DGECON: estimates the reciprocal of the condition number of a general !> real matrix A, in either the 1-norm or the infinity-norm, using !> the LU factorization computed by DGETRF. !> 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)) ). - - pure subroutine stdlib_qgecon( norm, n, a, lda, anorm, rcond, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4090,6 +4090,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgecon + + pure subroutine stdlib_qgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) !> DGEEQU: 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 @@ -4099,8 +4101,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4213,6 +4213,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeequ + + pure subroutine stdlib_qgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) !> DGEEQUB: 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 @@ -4228,8 +4230,6 @@ module stdlib_linalg_lapack_q !> 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). - - pure subroutine stdlib_qgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4352,6 +4352,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeequb + + subroutine stdlib_qgees( jobvs, sort, select, n, a, lda, sdim, wr, wi,vs, ldvs, work, lwork, & !> DGEES: computes for an N-by-N real nonsymmetric matrix A, the !> eigenvalues, the real Schur form T, and, optionally, the matrix of !> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). @@ -4365,8 +4367,6 @@ module stdlib_linalg_lapack_q !> [ a b ] !> [ c a ] !> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). - - subroutine stdlib_qgees( jobvs, sort, select, n, a, lda, sdim, wr, wi,vs, ldvs, work, lwork, & bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4598,6 +4598,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgees + + subroutine stdlib_qgeesx( jobvs, sort, select, sense, n, a, lda, sdim,wr, wi, vs, ldvs, & !> DGEESX: computes for an N-by-N real nonsymmetric matrix A, the !> eigenvalues, the real Schur form T, and, optionally, the matrix of !> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). @@ -4617,8 +4619,6 @@ module stdlib_linalg_lapack_q !> [ a b ] !> [ c a ] !> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). - - subroutine stdlib_qgeesx( jobvs, sort, select, sense, n, a, lda, sdim,wr, wi, vs, ldvs, & rconde, rcondv, work, lwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4892,6 +4892,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeesx + + subroutine stdlib_qgeev( jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr,ldvr, work, lwork, & !> DGEEV: computes for an N-by-N real nonsymmetric matrix A, the !> eigenvalues and, optionally, the left and/or right eigenvectors. !> The right eigenvector v(j) of A satisfies @@ -4902,8 +4904,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qgeev( jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr,ldvr, work, lwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5151,6 +5151,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeev + + subroutine stdlib_qgeevx( balanc, jobvl, jobvr, sense, n, a, lda, wr, wi,vl, ldvl, vr, ldvr, & !> DGEEVX: computes for an N-by-N real nonsymmetric matrix A, the !> eigenvalues and, optionally, the left and/or right eigenvectors. !> Optionally also, it computes a balancing transformation to improve @@ -5176,8 +5178,6 @@ module stdlib_linalg_lapack_q !> (in exact arithmetic) but diagonal scaling will. For further !> explanation of balancing, see section 4.10.2_qp of the LAPACK !> Users' Guide. - - subroutine stdlib_qgeevx( balanc, jobvl, jobvr, sense, n, a, lda, wr, wi,vl, ldvl, vr, ldvr, & ilo, ihi, scale, abnrm,rconde, rcondv, work, lwork, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5463,10 +5463,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeevx - !> DGEHD2: reduces a real general matrix A to upper Hessenberg form H by - !> an orthogonal similarity transformation: Q**T * A * Q = H . pure subroutine stdlib_qgehd2( n, ilo, ihi, a, lda, tau, work, info ) + !> DGEHD2: reduces a real general matrix A to upper Hessenberg form H by + !> an orthogonal similarity transformation: Q**T * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5515,10 +5515,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgehd2 - !> DGEHRD: reduces a real general matrix A to upper Hessenberg form H by - !> an orthogonal similarity transformation: Q**T * A * Q = H . pure subroutine stdlib_qgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info ) + !> DGEHRD: reduces a real general matrix A to upper Hessenberg form H by + !> an orthogonal similarity transformation: Q**T * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5644,6 +5644,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgehrd + + pure subroutine stdlib_qgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & !> DGEJSV: computes the singular value decomposition (SVD) of a real M-by-N !> matrix [A], where M >= N. The SVD of [A] is written as !> [A] = [U] * [SIGMA] * [V]^t, @@ -5656,8 +5658,6 @@ module stdlib_linalg_lapack_q !> of [SIGMA] is computed and stored in the array SVA. !> DGEJSV can sometimes compute tiny singular values and their singular vectors much !> more accurately than other SVD routines, see below under Further Details. - - pure subroutine stdlib_qgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & v, ldv,work, lwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -6734,14 +6734,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgejsv + + pure subroutine stdlib_qgelq( m, n, a, lda, t, tsize, work, lwork,info ) !> DGELQ: computes an LQ factorization of a real 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. - - pure subroutine stdlib_qgelq( m, n, a, lda, t, tsize, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -6859,14 +6859,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgelq + + pure subroutine stdlib_qgelq2( m, n, a, lda, tau, work, info ) !> DGELQ2: computes an LQ factorization of a real 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. - - pure subroutine stdlib_qgelq2( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6913,14 +6913,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgelq2 + + pure subroutine stdlib_qgelqf( m, n, a, lda, tau, work, lwork, info ) !> DGELQF: computes an LQ factorization of a real 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. - - pure subroutine stdlib_qgelqf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7010,10 +7010,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgelqf - !> DGELQT: computes a blocked LQ factorization of a real M-by-N matrix A - !> using the compact WY representation of Q. pure subroutine stdlib_qgelqt( m, n, mb, a, lda, t, ldt, work, info ) + !> DGELQT: computes a blocked LQ factorization of a real M-by-N matrix A + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7061,12 +7061,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgelqt + + pure recursive subroutine stdlib_qgelqt3( m, n, a, lda, t, ldt, info ) !> DGELQT3: recursively computes a LQ factorization of a real 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. - - pure recursive subroutine stdlib_qgelqt3( m, n, a, lda, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7148,6 +7148,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgelqt3 + + subroutine stdlib_qgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) !> DGELS: solves overdetermined or underdetermined real linear systems !> involving an M-by-N matrix A, or its transpose, using a QR or LQ !> factorization of A. It is assumed that A has full rank. @@ -7166,8 +7168,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7365,6 +7365,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgels + + subroutine stdlib_qgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, iwork, & !> DGELSD: computes the minimum-norm solution to a real linear least !> squares problem: !> minimize 2-norm(| b - A*x |) @@ -7390,8 +7392,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, iwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7688,6 +7688,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgelsd + + subroutine stdlib_qgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, info ) !> DGELSS: computes the minimum norm solution to a real linear least !> squares problem: !> Minimize 2-norm(| b - A*x |). @@ -7700,8 +7702,6 @@ module stdlib_linalg_lapack_q !> The effective rank of A is determined by treating as zero those !> singular values which are less than RCOND times the largest singular !> value. - - subroutine stdlib_qgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8130,6 +8130,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgelss + + subroutine stdlib_qgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, info ) !> DGELSY: computes the minimum-norm solution to a real linear least !> squares problem: !> minimize || A * X - B || @@ -8162,8 +8164,6 @@ module stdlib_linalg_lapack_q !> o Matrix B (the right hand side) is updated with Blas-3. !> o The permutation of matrix B (the right hand side) is faster and !> more simple. - - subroutine stdlib_qgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8363,6 +8363,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgelsy + + pure subroutine stdlib_qgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & !> DGEMLQ: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -8370,8 +8372,6 @@ module stdlib_linalg_lapack_q !> where Q is a real orthogonal matrix defined as the product !> of blocked elementary reflectors computed by short wide LQ !> factorization (DGELQ) - - pure subroutine stdlib_qgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8460,6 +8460,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgemlq + + pure subroutine stdlib_qgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) !> DGEMLQT: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q C C Q @@ -8469,8 +8471,6 @@ module stdlib_linalg_lapack_q !> Q = H(1) H(2) . . . H(K) = I - V T V**T !> generated using the compact WY representation as returned by DGELQT. !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. - - pure subroutine stdlib_qgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8558,6 +8558,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgemlqt + + pure subroutine stdlib_qgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & !> DGEMQR: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -8565,8 +8567,6 @@ module stdlib_linalg_lapack_q !> where Q is a real orthogonal matrix defined as the product !> of blocked elementary reflectors computed by tall skinny !> QR factorization (DGEQR) - - pure subroutine stdlib_qgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8655,6 +8655,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgemqr + + pure subroutine stdlib_qgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) !> DGEMQRT: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q C C Q @@ -8664,8 +8666,6 @@ module stdlib_linalg_lapack_q !> Q = H(1) H(2) . . . H(K) = I - V T V**T !> generated using the compact WY representation as returned by DGEQRT. !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. - - pure subroutine stdlib_qgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8753,10 +8753,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgemqrt - !> DGEQL2: computes a QL factorization of a real m by n matrix A: - !> A = Q * L. pure subroutine stdlib_qgeql2( m, n, a, lda, tau, work, info ) + !> DGEQL2: computes a QL factorization of a real m by n matrix A: + !> A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8802,10 +8802,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeql2 - !> DGEQLF: computes a QL factorization of a real M-by-N matrix A: - !> A = Q * L. pure subroutine stdlib_qgeqlf( m, n, a, lda, tau, work, lwork, info ) + !> DGEQLF: computes a QL factorization of a real M-by-N matrix A: + !> A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8908,10 +8908,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeqlf - !> DGEQP3: computes a QR factorization with column pivoting of a - !> matrix A: A*P = Q*R using Level 3 BLAS. pure subroutine stdlib_qgeqp3( m, n, a, lda, jpvt, tau, work, lwork, info ) + !> DGEQP3: computes a QR factorization with column pivoting of a + !> matrix A: A*P = Q*R using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9058,6 +9058,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeqp3 + + pure subroutine stdlib_qgeqr( m, n, a, lda, t, tsize, work, lwork,info ) !> DGEQR: computes a QR factorization of a real M-by-N matrix A: !> A = Q * ( R ), !> ( 0 ) @@ -9065,8 +9067,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qgeqr( m, n, a, lda, t, tsize, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -9173,6 +9173,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeqr + + pure subroutine stdlib_qgeqr2( m, n, a, lda, tau, work, info ) !> DGEQR2: computes a QR factorization of a real m-by-n matrix A: !> A = Q * ( R ), !> ( 0 ) @@ -9180,8 +9182,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qgeqr2( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9228,6 +9228,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeqr2 + + subroutine stdlib_qgeqr2p( m, n, a, lda, tau, work, info ) !> DGEQR2P: computes a QR factorization of a real m-by-n matrix A: !> A = Q * ( R ), !> ( 0 ) @@ -9236,8 +9238,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qgeqr2p( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9284,6 +9284,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeqr2p + + pure subroutine stdlib_qgeqrf( m, n, a, lda, tau, work, lwork, info ) !> DGEQRF: computes a QR factorization of a real M-by-N matrix A: !> A = Q * ( R ), !> ( 0 ) @@ -9291,8 +9293,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qgeqrf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9386,6 +9386,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeqrf + + subroutine stdlib_qgeqrfp( m, n, a, lda, tau, work, lwork, info ) !> DGEQR2P computes a QR factorization of a real M-by-N matrix A: !> A = Q * ( R ), !> ( 0 ) @@ -9394,8 +9396,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qgeqrfp( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9485,10 +9485,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeqrfp - !> DGEQRT: computes a blocked QR factorization of a real M-by-N matrix A - !> using the compact WY representation of Q. pure subroutine stdlib_qgeqrt( m, n, nb, a, lda, t, ldt, work, info ) + !> DGEQRT: computes a blocked QR factorization of a real M-by-N matrix A + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9542,10 +9542,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeqrt - !> DGEQRT2: computes a QR factorization of a real M-by-N matrix A, - !> using the compact WY representation of Q. pure subroutine stdlib_qgeqrt2( m, n, a, lda, t, ldt, info ) + !> DGEQRT2: computes a QR factorization of a real M-by-N matrix A, + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9610,12 +9610,12 @@ module stdlib_linalg_lapack_q end do end subroutine stdlib_qgeqrt2 + + pure recursive subroutine stdlib_qgeqrt3( m, n, a, lda, t, ldt, info ) !> DGEQRT3: recursively computes a QR factorization of a real 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. - - pure recursive subroutine stdlib_qgeqrt3( m, n, a, lda, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9695,11 +9695,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeqrt3 + + pure subroutine stdlib_qgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & !> DGERFS: improves the computed solution to a system of linear !> equations and provides error bounds and backward error estimates for !> the solution. - - pure subroutine stdlib_qgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -9888,10 +9888,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgerfs - !> DGERQ2: computes an RQ factorization of a real m by n matrix A: - !> A = R * Q. pure subroutine stdlib_qgerq2( m, n, a, lda, tau, work, info ) + !> DGERQ2: computes an RQ factorization of a real m by n matrix A: + !> A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9937,10 +9937,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgerq2 - !> DGERQF: computes an RQ factorization of a real M-by-N matrix A: - !> A = R * Q. pure subroutine stdlib_qgerqf( m, n, a, lda, tau, work, lwork, info ) + !> DGERQF: computes an RQ factorization of a real M-by-N matrix A: + !> A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10043,12 +10043,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgerqf + + pure subroutine stdlib_qgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) !> DGESC2: solves a system of linear equations !> A * X = scale* RHS !> with a general N-by-N matrix A using the LU factorization with !> complete pivoting computed by DGETC2. - - pure subroutine stdlib_qgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10101,6 +10101,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgesc2 + + subroutine stdlib_qgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, iwork, info ) !> DGESDD: computes the singular value decomposition (SVD) of a real !> M-by-N matrix A, optionally computing the left and right singular !> vectors. If singular vectors are desired, it uses a @@ -10120,8 +10122,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -11072,6 +11072,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgesdd + + pure subroutine stdlib_qgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) !> DGESV: computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N matrix and X and B are N-by-NRHS matrices. @@ -11081,8 +11083,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11120,6 +11120,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgesv + + subroutine stdlib_qgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,vt, ldvt, work, lwork, info ) !> DGESVD: computes the singular value decomposition (SVD) of a real !> M-by-N matrix A, optionally computing the left and/or right singular !> vectors. The SVD is written @@ -11131,8 +11133,6 @@ module stdlib_linalg_lapack_q !> 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**T, not V. - - subroutine stdlib_qgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,vt, ldvt, work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13379,6 +13379,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgesvd + + subroutine stdlib_qgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & !> DGESVDQ: computes the singular value decomposition (SVD) of a real !> M-by-N matrix A, where M >= N. The SVD of A is written as !> [++] [xx] [x0] [xx] @@ -13388,8 +13390,6 @@ module stdlib_linalg_lapack_q !> matrix, and V is an N-by-N orthogonal 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. - - subroutine stdlib_qgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & numrank, iwork, liwork,work, lwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -14244,6 +14244,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgesvdq + + pure subroutine stdlib_qgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, work, lwork, & !> DGESVJ: computes the singular value decomposition (SVD) of a real !> M-by-N matrix A, where M >= N. The SVD of A is written as !> [++] [xx] [x0] [xx] @@ -14255,8 +14257,6 @@ module stdlib_linalg_lapack_q !> left and the right singular vectors of A, respectively. !> DGESVJ can sometimes compute tiny singular values and their singular vectors much !> more accurately than other SVD routines, see below under Further Details. - - pure subroutine stdlib_qgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15223,14 +15223,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgesvj + + subroutine stdlib_qgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & !> DGESVX: uses the LU factorization to compute the solution to a real !> system of linear equations !> A * X = B, !> where A is an N-by-N matrix and X and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_qgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & x, ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15427,13 +15427,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgesvx + + pure subroutine stdlib_qgetc2( n, a, lda, ipiv, jpiv, info ) !> DGETC2: computes an LU factorization with complete pivoting of the !> n-by-n matrix A. The factorization has the form A = P * L * U * Q, !> where P and Q are permutation matrices, L is lower triangular with !> unit diagonal elements and U is upper triangular. !> This is the Level 2 BLAS algorithm. - - pure subroutine stdlib_qgetc2( n, a, lda, ipiv, jpiv, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15511,6 +15511,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgetc2 + + pure subroutine stdlib_qgetf2( m, n, a, lda, ipiv, info ) !> DGETF2: computes an LU factorization of a general m-by-n matrix A !> using partial pivoting with row interchanges. !> The factorization has the form @@ -15519,8 +15521,6 @@ module stdlib_linalg_lapack_q !> diagonal elements (lower trapezoidal if m > n), and U is upper !> triangular (upper trapezoidal if m < n). !> This is the right-looking Level 2 BLAS version of the algorithm. - - pure subroutine stdlib_qgetf2( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15584,6 +15584,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgetf2 + + pure subroutine stdlib_qgetrf( m, n, a, lda, ipiv, info ) !> DGETRF: computes an LU factorization of a general M-by-N matrix A !> using partial pivoting with row interchanges. !> The factorization has the form @@ -15592,8 +15594,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qgetrf( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15662,6 +15662,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgetrf + + pure recursive subroutine stdlib_qgetrf2( m, n, a, lda, ipiv, info ) !> DGETRF2: computes an LU factorization of a general M-by-N matrix A !> using partial pivoting with row interchanges. !> The factorization has the form @@ -15681,8 +15683,6 @@ module stdlib_linalg_lapack_q !> do the swaps on [ --- ], solve A12, update A22, !> [ A22 ] !> then calls itself to factor A22 and do the swaps on A21. - - pure recursive subroutine stdlib_qgetrf2( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15777,12 +15777,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgetrf2 + + pure subroutine stdlib_qgetri( n, a, lda, ipiv, work, lwork, info ) !> DGETRI: computes the inverse of a matrix using the LU factorization !> computed by DGETRF. !> This method inverts U and then computes inv(A) by solving the system !> inv(A)*L = inv(U) for inv(A). - - pure subroutine stdlib_qgetri( n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15879,12 +15879,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgetri + + pure subroutine stdlib_qgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) !> DGETRS: solves a system of linear equations !> A * X = B or A**T * X = B !> with a general N-by-N matrix A using the LU factorization computed !> by DGETRF. - - pure subroutine stdlib_qgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15948,6 +15948,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgetrs + + subroutine stdlib_qgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) !> DGETSLS: solves overdetermined or underdetermined real 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. @@ -15966,8 +15968,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16184,6 +16184,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgetsls + + pure subroutine stdlib_qgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) !> DGETSQRHRT: computes a NB2-sized column blocked QR-factorization !> of a real M-by-N matrix A with M >= N, !> A = Q * R. @@ -16196,8 +16198,6 @@ module stdlib_linalg_lapack_q !> The output Q and R factors are stored in the same format as in DGEQRT !> (Q is in blocked compact WY-representation). See the documentation !> of DGEQRT for more details on the format. - - pure subroutine stdlib_qgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16317,12 +16317,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgetsqrhrt + + pure subroutine stdlib_qggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) !> DGGBAK: forms the right or left eigenvectors of a real generalized !> eigenvalue problem A*x = lambda*B*x, by backward transformation on !> the computed eigenvectors of the balanced pair of matrices output by !> DGGBAL. - - pure subroutine stdlib_qggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16430,6 +16430,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggbak + + pure subroutine stdlib_qggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) !> DGGBAL: balances a pair of general real 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 @@ -16439,8 +16441,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16724,6 +16724,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggbal + + subroutine stdlib_qgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alphar, & !> DGGES: computes for a pair of N-by-N real nonsymmetric matrices (A,B), !> the generalized eigenvalues, the generalized real Schur form (S,T), !> optionally, the left and/or right matrices of Schur vectors (VSL and @@ -16750,8 +16752,6 @@ module stdlib_linalg_lapack_q !> [ 0 b ] !> and the pair of corresponding 2-by-2 blocks in S and T will have a !> complex conjugate pair of generalized eigenvalues. - - subroutine stdlib_qgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alphar, & alphai, beta, vsl, ldvsl, vsr,ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17043,6 +17043,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgges + + subroutine stdlib_qgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alphar, & !> DGGES3: computes for a pair of N-by-N real nonsymmetric matrices (A,B), !> the generalized eigenvalues, the generalized real Schur form (S,T), !> optionally, the left and/or right matrices of Schur vectors (VSL and @@ -17069,8 +17071,6 @@ module stdlib_linalg_lapack_q !> [ 0 b ] !> and the pair of corresponding 2-by-2 blocks in S and T will have a !> complex conjugate pair of generalized eigenvalues. - - subroutine stdlib_qgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alphar, & alphai, beta, vsl, ldvsl,vsr, ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17357,6 +17357,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgges3 + + subroutine stdlib_qggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, & !> DGGESX: computes for a pair of N-by-N real nonsymmetric matrices !> (A,B), the generalized eigenvalues, the real Schur form (S,T), and, !> optionally, the left and/or right matrices of Schur vectors (VSL and @@ -17385,8 +17387,6 @@ module stdlib_linalg_lapack_q !> [ 0 b ] !> and the pair of corresponding 2-by-2 blocks in S and T will have a !> complex conjugate pair of generalized eigenvalues. - - subroutine stdlib_qggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, & alphar, alphai, beta, vsl, ldvsl,vsr, ldvsr, rconde, rcondv, work, lwork, iwork,liwork, & bwork, info ) ! -- lapack driver routine -- @@ -17727,6 +17727,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggesx + + subroutine stdlib_qggev( jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai,beta, vl, ldvl, vr, & !> DGGEV: computes for a pair of N-by-N real nonsymmetric matrices (A,B) !> the generalized eigenvalues, and optionally, the left and/or right !> generalized eigenvectors. @@ -17742,8 +17744,6 @@ module stdlib_linalg_lapack_q !> 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). - - subroutine stdlib_qggev( jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai,beta, vl, ldvl, vr, & ldvr, work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -18025,6 +18025,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggev + + subroutine stdlib_qggev3( jobvl, jobvr, n, a, lda, b, ldb, alphar,alphai, beta, vl, ldvl, vr,& !> DGGEV3: computes for a pair of N-by-N real nonsymmetric matrices (A,B) !> the generalized eigenvalues, and optionally, the left and/or right !> generalized eigenvectors. @@ -18040,8 +18042,6 @@ module stdlib_linalg_lapack_q !> 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). - - subroutine stdlib_qggev3( jobvl, jobvr, n, a, lda, b, ldb, alphar,alphai, beta, vl, ldvl, vr,& ldvr, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -18325,6 +18325,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggev3 + + subroutine stdlib_qggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alphar, alphai, & !> DGGEVX: computes for a pair of N-by-N real nonsymmetric matrices (A,B) !> the generalized eigenvalues, and optionally, the left and/or right !> generalized eigenvectors. @@ -18345,8 +18347,6 @@ module stdlib_linalg_lapack_q !> 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). - - subroutine stdlib_qggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alphar, alphai, & beta, vl, ldvl, vr, ldvr, ilo,ihi, lscale, rscale, abnrm, bbnrm, rconde,rcondv, work, lwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -18720,6 +18720,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggevx + + pure subroutine stdlib_qggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) !> DGGGLM: solves a general Gauss-Markov linear model (GLM) problem: !> minimize || y ||_2 subject to d = A*x + B*y !> x @@ -18738,8 +18740,6 @@ module stdlib_linalg_lapack_q !> minimize || inv(B)*(d-A*x) ||_2 !> x !> where inv(B) denotes the inverse of B. - - pure subroutine stdlib_qggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18856,6 +18856,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggglm + + pure subroutine stdlib_qgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & !> DGGHD3: reduces a pair of real matrices (A,B) to generalized upper !> Hessenberg form using orthogonal transformations, where A is a !> general matrix and B is upper triangular. The form of the @@ -18881,8 +18883,6 @@ module stdlib_linalg_lapack_q !> problem to generalized Hessenberg form. !> This is a blocked variant of DGGHRD, using matrix-matrix !> multiplications for parts of the computation to enhance performance. - - pure subroutine stdlib_qgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19383,6 +19383,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgghd3 + + pure subroutine stdlib_qgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & !> DGGHRD: reduces a pair of real matrices (A,B) to generalized upper !> Hessenberg form using orthogonal transformations, where A is a !> general matrix and B is upper triangular. The form of the @@ -19406,8 +19408,6 @@ module stdlib_linalg_lapack_q !> If Q1 is the orthogonal matrix from the QR factorization of B in the !> original equation A*x = lambda*B*x, then DGGHRD reduces the original !> problem to generalized Hessenberg form. - - pure subroutine stdlib_qgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19513,6 +19513,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgghrd + + pure subroutine stdlib_qgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) !> DGGLSE: solves the linear equality-constrained least squares (LSE) !> problem: !> minimize || c - A*x ||_2 subject to B*x = d @@ -19525,8 +19527,6 @@ module stdlib_linalg_lapack_q !> which is obtained using a generalized RQ factorization of the !> matrices (B, A) given by !> B = (0 R)*Q, A = Z*T*Q. - - pure subroutine stdlib_qgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19645,6 +19645,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgglse + + pure subroutine stdlib_qggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) !> DGGQRF: 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, @@ -19663,8 +19665,6 @@ module stdlib_linalg_lapack_q !> inv(B)*A = Z**T*(inv(T)*R) !> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the !> transpose of the matrix Z. - - pure subroutine stdlib_qggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19723,6 +19723,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggqrf + + pure subroutine stdlib_qggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) !> DGGRQF: 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, @@ -19741,8 +19743,6 @@ module stdlib_linalg_lapack_q !> A*inv(B) = (R*inv(T))*Z**T !> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the !> transpose of the matrix Z. - - pure subroutine stdlib_qggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19801,12 +19801,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggrqf + + pure subroutine stdlib_qgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & !> DGSVJ0: is called from DGESVJ as a pre-processor and that is its main !> purpose. It applies Jacobi rotations in the same way as DGESVJ does, but !> it does not check convergence (stopping criterion). Few tuning !> parameters (marked by [TP]) are available for the implementer. - - pure subroutine stdlib_qgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20449,6 +20449,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgsvj0 + + pure subroutine stdlib_qgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & !> DGSVJ1: is called from DGESVJ as a pre-processor and that is its main !> purpose. It applies Jacobi rotations in the same way as DGESVJ does, but !> it targets only particular pivots and it does not check convergence @@ -20473,8 +20475,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20880,13 +20880,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgsvj1 + + pure subroutine stdlib_qgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, iwork, info & !> DGTCON: estimates the reciprocal of the condition number of a real !> tridiagonal matrix A using the LU factorization as computed by !> DGTTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_qgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, iwork, info & ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20963,11 +20963,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgtcon + + pure subroutine stdlib_qgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, x, & !> DGTRFS: 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. - - pure subroutine stdlib_qgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, x, & ldx, ferr, berr, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21165,14 +21165,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgtrfs + + pure subroutine stdlib_qgtsv( n, nrhs, dl, d, du, b, ldb, info ) !> DGTSV: 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. - - pure subroutine stdlib_qgtsv( n, nrhs, dl, d, du, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21344,14 +21344,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgtsv + + pure subroutine stdlib_qgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & !> DGTSVX: uses the LU factorization to compute the solution to a real !> system of linear equations A * X = B or A**T * X = B, !> where A is a tridiagonal matrix of order N and X and B are N-by-NRHS !> matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - pure subroutine stdlib_qgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & ldb, x, ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21433,6 +21433,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgtsvx + + pure subroutine stdlib_qgttrf( n, dl, d, du, du2, ipiv, info ) !> DGTTRF: computes an LU factorization of a real tridiagonal matrix A !> using elimination with partial pivoting and row interchanges. !> The factorization has the form @@ -21440,8 +21442,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qgttrf( n, dl, d, du, du2, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21525,12 +21525,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgttrf + + pure subroutine stdlib_qgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) !> DGTTRS: solves one of the systems of equations !> A*X = B or A**T*X = B, !> with a tridiagonal matrix A using the LU factorization computed !> by DGTTRF. - - pure subroutine stdlib_qgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21589,12 +21589,12 @@ module stdlib_linalg_lapack_q end if end subroutine stdlib_qgttrs + + pure subroutine stdlib_qgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) !> DGTTS2: solves one of the systems of equations !> A*X = B or A**T*X = B, !> with a tridiagonal matrix A using the LU factorization computed !> by DGTTRF. - - pure subroutine stdlib_qgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21702,6 +21702,8 @@ module stdlib_linalg_lapack_q end if end subroutine stdlib_qgtts2 + + subroutine stdlib_qhgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alphar, alphai, & !> DHGEQZ: computes the eigenvalues of a real matrix pair (H,T), !> where H is an upper Hessenberg matrix and T is upper triangular, !> using the double-shift QZ method. @@ -21745,8 +21747,6 @@ module stdlib_linalg_lapack_q !> Ref: C.B. Moler !> Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973), !> pp. 241--256. - - subroutine stdlib_qhgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alphar, alphai, & beta, q, ldq, z, ldz, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22577,14 +22577,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qhgeqz + + subroutine stdlib_qhsein( side, eigsrc, initv, select, n, h, ldh, wr, wi,vl, ldvl, vr, ldvr, & !> DHSEIN: uses inverse iteration to find specified right and/or left !> eigenvectors of a real 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. - - subroutine stdlib_qhsein( side, eigsrc, initv, select, n, h, ldh, wr, wi,vl, ldvl, vr, ldvr, & mm, m, work, ifaill,ifailr, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22792,6 +22792,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qhsein + + subroutine stdlib_qhseqr( job, compz, n, ilo, ihi, h, ldh, wr, wi, z,ldz, work, lwork, info ) !> DHSEQR: computes the eigenvalues of a Hessenberg matrix H !> and, optionally, the matrices T and Z from the Schur decomposition !> H = Z T Z**T, where T is an upper quasi-triangular matrix (the @@ -22800,8 +22802,6 @@ module stdlib_linalg_lapack_q !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. - - subroutine stdlib_qhseqr( job, compz, n, ilo, ihi, h, ldh, wr, wi, z,ldz, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22939,11 +22939,11 @@ module stdlib_linalg_lapack_q end if end subroutine stdlib_qhseqr + + pure logical(lk) function stdlib_qisnan( din ) !> DISNAN: returns .TRUE. if its argument is NaN, and .FALSE. !> otherwise. To be replaced by the Fortran 2003 intrinsic in the !> future. - - pure logical(lk) function stdlib_qisnan( din ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22955,6 +22955,8 @@ module stdlib_linalg_lapack_q return end function stdlib_qisnan + + subroutine stdlib_qla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) !> DLA_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), @@ -22968,8 +22970,6 @@ module stdlib_linalg_lapack_q !> "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. - - subroutine stdlib_qla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23141,6 +23141,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qla_gbamv + + real(qp) function stdlib_qla_gbrcond( trans, n, kl, ku, ab, ldab,afb, ldafb, ipiv, cmode, c,& !> DLA_GBRCOND: Estimates the Skeel condition number of op(A) * op2(C) !> where op2 is determined by CMODE as follows !> CMODE = 1 op2(C) = C @@ -23150,8 +23152,6 @@ module stdlib_linalg_lapack_q !> 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. - - real(qp) function stdlib_qla_gbrcond( trans, n, kl, ku, ab, ldab,afb, ldafb, ipiv, cmode, c,& info, work, iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23299,14 +23299,14 @@ module stdlib_linalg_lapack_q return end function stdlib_qla_gbrcond + + pure real(qp) function stdlib_qla_gbrpvgrw( n, kl, ku, ncols, ab,ldab, afb, ldafb ) !> DLA_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. - - pure real(qp) function stdlib_qla_gbrpvgrw( n, kl, ku, ncols, ab,ldab, afb, ldafb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23339,6 +23339,8 @@ module stdlib_linalg_lapack_q stdlib_qla_gbrpvgrw = rpvgrw end function stdlib_qla_gbrpvgrw + + subroutine stdlib_qla_geamv ( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) !> DLA_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), @@ -23352,8 +23354,6 @@ module stdlib_linalg_lapack_q !> "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. - - subroutine stdlib_qla_geamv ( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23518,6 +23518,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qla_geamv + + real(qp) function stdlib_qla_gercond( trans, n, a, lda, af,ldaf, ipiv, cmode, c,info, work, & !> DLA_GERCOND: estimates the Skeel condition number of op(A) * op2(C) !> where op2 is determined by CMODE as follows !> CMODE = 1 op2(C) = C @@ -23527,8 +23529,6 @@ module stdlib_linalg_lapack_q !> 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. - - real(qp) function stdlib_qla_gercond( trans, n, a, lda, af,ldaf, ipiv, cmode, c,info, work, & iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23668,14 +23668,14 @@ module stdlib_linalg_lapack_q return end function stdlib_qla_gercond + + pure real(qp) function stdlib_qla_gerpvgrw( n, ncols, a, lda, af,ldaf ) !> DLA_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. - - pure real(qp) function stdlib_qla_gerpvgrw( n, ncols, a, lda, af,ldaf ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23707,13 +23707,13 @@ module stdlib_linalg_lapack_q stdlib_qla_gerpvgrw = rpvgrw end function stdlib_qla_gerpvgrw + + pure subroutine stdlib_qla_lin_berr ( n, nz, nrhs, res, ayb, berr ) !> DLA_LIN_BERR: computes component-wise 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 component-wise absolute value of the matrix !> or vector Z. - - pure subroutine stdlib_qla_lin_berr ( n, nz, nrhs, res, ayb, berr ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23748,6 +23748,8 @@ module stdlib_linalg_lapack_q end do end subroutine stdlib_qla_lin_berr + + real(qp) function stdlib_qla_porcond( uplo, n, a, lda, af, ldaf,cmode, c, info, work,iwork ) !> DLA_PORCOND: Estimates the Skeel condition number of op(A) * op2(C) !> where op2 is determined by CMODE as follows !> CMODE = 1 op2(C) = C @@ -23757,8 +23759,6 @@ module stdlib_linalg_lapack_q !> 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. - - real(qp) function stdlib_qla_porcond( uplo, n, a, lda, af, ldaf,cmode, c, info, work,iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23907,14 +23907,14 @@ module stdlib_linalg_lapack_q return end function stdlib_qla_porcond + + real(qp) function stdlib_qla_porpvgrw( uplo, ncols, a, lda, af,ldaf, work ) !> DLA_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. - - real(qp) function stdlib_qla_porpvgrw( uplo, ncols, a, lda, af,ldaf, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23995,6 +23995,8 @@ module stdlib_linalg_lapack_q stdlib_qla_porpvgrw = rpvgrw end function stdlib_qla_porpvgrw + + subroutine stdlib_qla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) !> DLA_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 @@ -24007,8 +24009,6 @@ module stdlib_linalg_lapack_q !> "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. - - subroutine stdlib_qla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24184,6 +24184,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qla_syamv + + real(qp) function stdlib_qla_syrcond( uplo, n, a, lda, af, ldaf,ipiv, cmode, c, info, work,& !> DLA_SYRCOND: estimates the Skeel condition number of op(A) * op2(C) !> where op2 is determined by CMODE as follows !> CMODE = 1 op2(C) = C @@ -24193,8 +24195,6 @@ module stdlib_linalg_lapack_q !> 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. - - real(qp) function stdlib_qla_syrcond( uplo, n, a, lda, af, ldaf,ipiv, cmode, c, info, work,& iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24351,14 +24351,14 @@ module stdlib_linalg_lapack_q return end function stdlib_qla_syrcond + + real(qp) function stdlib_qla_syrpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) !> DLA_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. - - real(qp) function stdlib_qla_syrpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24535,11 +24535,11 @@ module stdlib_linalg_lapack_q stdlib_qla_syrpvgrw = rpvgrw end function stdlib_qla_syrpvgrw + + pure subroutine stdlib_qla_wwaddw( n, x, y, w ) !> DLA_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. - - pure subroutine stdlib_qla_wwaddw( n, x, y, w ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24562,6 +24562,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qla_wwaddw + + pure subroutine stdlib_qlabad( small, large ) !> DLABAD: 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 @@ -24570,8 +24572,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlabad( small, large ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24590,6 +24590,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlabad + + pure subroutine stdlib_qlabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) !> DLABRD: reduces the first NB rows and columns of a real general !> m by n matrix A to upper or lower bidiagonal form by an orthogonal !> transformation Q**T * A * P, and returns the matrices X and Y which @@ -24597,8 +24599,6 @@ module stdlib_linalg_lapack_q !> If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower !> bidiagonal form. !> This is an auxiliary routine called by DGEBRD - - pure subroutine stdlib_qlabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24720,10 +24720,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlabrd - !> DLACN2: estimates the 1-norm of a square, real matrix A. - !> Reverse communication is used for evaluating matrix-vector products. pure subroutine stdlib_qlacn2( n, v, x, isgn, est, kase, isave ) + !> DLACN2: estimates the 1-norm of a square, real matrix A. + !> Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24853,10 +24853,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlacn2 - !> DLACON: estimates the 1-norm of a square, real matrix A. - !> Reverse communication is used for evaluating matrix-vector products. subroutine stdlib_qlacon( n, v, x, isgn, est, kase ) + !> DLACON: estimates the 1-norm of a square, real matrix A. + !> Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24974,10 +24974,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlacon - !> DLACPY: copies all or part of a two-dimensional matrix A to another - !> matrix B. pure subroutine stdlib_qlacpy( uplo, m, n, a, lda, b, ldb ) + !> DLACPY: copies all or part of a two-dimensional matrix A to another + !> matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25015,6 +25015,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlacpy + + pure subroutine stdlib_qladiv( a, b, c, d, p, q ) !> DLADIV: performs complex division in real arithmetic !> a + i*b !> p + i*q = --------- @@ -25022,8 +25024,6 @@ module stdlib_linalg_lapack_q !> The algorithm is due to Michael Baudin and Robert L. Smith !> and can be found in the paper !> "A Robust Complex Division in Scilab" - - pure subroutine stdlib_qladiv( a, b, c, d, p, q ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25130,13 +25130,13 @@ module stdlib_linalg_lapack_q return end function stdlib_qladiv2 + + pure subroutine stdlib_qlae2( a, b, c, rt1, rt2 ) !> DLAE2: computes the eigenvalues of a 2-by-2 symmetric matrix !> [ A B ] !> [ B C ]. !> On return, RT1 is the eigenvalue of larger absolute value, and RT2 !> is the eigenvalue of smaller absolute value. - - pure subroutine stdlib_qlae2( a, b, c, rt1, rt2 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25194,6 +25194,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlae2 + + pure subroutine stdlib_qlaebz( ijob, nitmax, n, mmax, minp, nbmin, abstol,reltol, pivmin, d, & !> DLAEBZ: 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 @@ -25225,8 +25227,6 @@ module stdlib_linalg_lapack_q !> University, July 21, 1966 !> Note: the arguments are, in general, *not* checked for unreasonable !> values. - - pure subroutine stdlib_qlaebz( ijob, nitmax, n, mmax, minp, nbmin, abstol,reltol, pivmin, d, & e, e2, nval, ab, c, mout,nab, work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25465,10 +25465,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaebz - !> DLAED0: computes all eigenvalues and corresponding eigenvectors of a - !> symmetric tridiagonal matrix using the divide and conquer method. pure subroutine stdlib_qlaed0( icompq, qsiz, n, d, e, q, ldq, qstore, ldqs,work, iwork, info & + !> DLAED0: computes all eigenvalues and corresponding eigenvectors of a + !> symmetric tridiagonal matrix using the divide and conquer method. ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25669,6 +25669,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed0 + + pure subroutine stdlib_qlaed1( n, d, q, ldq, indxq, rho, cutpnt, work, iwork,info ) !> DLAED1: 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 @@ -25695,8 +25697,6 @@ module stdlib_linalg_lapack_q !> directly using the updated eigenvalues. The eigenvectors for !> the current problem are multiplied with the eigenvectors from !> the overall problem. - - pure subroutine stdlib_qlaed1( n, d, q, ldq, indxq, rho, cutpnt, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25772,14 +25772,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed1 + + pure subroutine stdlib_qlaed2( k, n, n1, d, q, ldq, indxq, rho, z, dlamda, w,q2, indx, indxc,& !> DLAED2: 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 entry in the !> Z vector. For each such occurrence the order of the related secular !> equation problem is reduced by one. - - pure subroutine stdlib_qlaed2( k, n, n1, d, q, ldq, indxq, rho, z, dlamda, w,q2, indx, indxc,& indxp, coltyp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26029,6 +26029,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed2 + + pure subroutine stdlib_qlaed3( k, n, n1, d, q, ldq, rho, dlamda, q2, indx,ctot, w, s, info ) !> DLAED3: finds the roots of the secular equation, as defined by the !> values in D, W, and RHO, between 1 and K. It makes the !> appropriate calls to DLAED4 and then updates the eigenvectors by @@ -26041,8 +26043,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlaed3( k, n, n1, d, q, ldq, rho, dlamda, q2, indx,ctot, w, s, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26164,6 +26164,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed3 + + pure subroutine stdlib_qlaed4( n, i, d, z, delta, rho, dlam, info ) !> 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 @@ -26174,8 +26176,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlaed4( n, i, d, z, delta, rho, dlam, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26769,6 +26769,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed4 + + pure subroutine stdlib_qlaed5( i, d, z, delta, rho, dlam ) !> 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) . @@ -26776,8 +26778,6 @@ module stdlib_linalg_lapack_q !> D(i) < D(j) for i < j . !> We also assume RHO > 0 and that the Euclidean norm of the vector !> Z is one. - - pure subroutine stdlib_qlaed5( i, d, z, delta, rho, dlam ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26840,6 +26840,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed5 + + pure subroutine stdlib_qlaed6( kniter, orgati, rho, d, z, finit, tau, info ) !> DLAED6: computes the positive or negative root (closest to the origin) !> of !> z(1) z(2) z(3) @@ -26851,8 +26853,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlaed6( kniter, orgati, rho, d, z, finit, tau, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27066,6 +27066,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed6 + + pure subroutine stdlib_qlaed7( icompq, n, qsiz, tlvls, curlvl, curpbm, d, q,ldq, indxq, rho, & !> DLAED7: 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 @@ -27092,8 +27094,6 @@ module stdlib_linalg_lapack_q !> directly using the updated eigenvalues. The eigenvectors for !> the current problem are multiplied with the eigenvectors from !> the overall problem. - - pure subroutine stdlib_qlaed7( icompq, n, qsiz, tlvls, curlvl, curpbm, d, q,ldq, indxq, rho, & cutpnt, qstore, qptr, prmptr,perm, givptr, givcol, givnum, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27200,14 +27200,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed7 + + pure subroutine stdlib_qlaed8( icompq, k, n, qsiz, d, q, ldq, indxq, rho,cutpnt, z, dlamda, & !> DLAED8: 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. - - pure subroutine stdlib_qlaed8( icompq, k, n, qsiz, d, q, ldq, indxq, rho,cutpnt, z, dlamda, & q2, ldq2, w, perm, givptr,givcol, givnum, indxp, indx, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27423,12 +27423,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed8 + + pure subroutine stdlib_qlaed9( k, kstart, kstop, n, d, q, ldq, rho, dlamda, w,s, lds, info ) !> DLAED9: 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. - - pure subroutine stdlib_qlaed9( k, kstart, kstop, n, d, q, ldq, rho, dlamda, w,s, lds, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27529,11 +27529,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed9 + + pure subroutine stdlib_qlaeda( n, tlvls, curlvl, curpbm, prmptr, perm, givptr,givcol, givnum,& !> DLAEDA: computes the Z vector corresponding to the merge step in the !> CURLVLth step of the merge process with TLVLS steps for the CURPBMth !> problem. - - pure subroutine stdlib_qlaeda( n, tlvls, curlvl, curpbm, prmptr, perm, givptr,givcol, givnum,& q, qptr, z, ztemp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27634,11 +27634,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaeda + + pure subroutine stdlib_qlaein( rightv, noinit, n, h, ldh, wr, wi, vr, vi, b,ldb, work, eps3, & !> DLAEIN: uses inverse iteration to find a right or left eigenvector !> corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg !> matrix H. - - pure subroutine stdlib_qlaein( rightv, noinit, n, h, ldh, wr, wi, vr, vi, b,ldb, work, eps3, & smlnum, bignum, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27980,6 +27980,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaein + + pure subroutine stdlib_qlaev2( a, b, c, rt1, rt2, cs1, sn1 ) !> DLAEV2: computes the eigendecomposition of a 2-by-2 symmetric matrix !> [ A B ] !> [ B C ]. @@ -27988,8 +27990,6 @@ module stdlib_linalg_lapack_q !> eigenvector for RT1, giving the decomposition !> [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ] !> [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ]. - - pure subroutine stdlib_qlaev2( a, b, c, rt1, rt2, cs1, sn1 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28079,6 +28079,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaev2 + + subroutine stdlib_qlaexc( wantq, n, t, ldt, q, ldq, j1, n1, n2, work,info ) !> DLAEXC: swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in !> an upper quasi-triangular matrix T by an orthogonal similarity !> transformation. @@ -28086,8 +28088,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qlaexc( wantq, n, t, ldt, q, ldq, j1, n1, n2, work,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28277,14 +28277,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaexc + + pure subroutine stdlib_qlag2( a, lda, b, ldb, safmin, scale1, scale2, wr1,wr2, wi ) !> DLAG2: computes the eigenvalues of a 2 x 2 generalized eigenvalue !> problem A - w B, with scaling as necessary to avoid over-/underflow. !> The scaling factor "s" results in a modified eigenvalue equation !> s A - w B !> where s is a non-negative scaling factor chosen so that w, w B, !> and s A do not overflow and, if possible, do not underflow, either. - - pure subroutine stdlib_qlag2( a, lda, b, ldb, safmin, scale1, scale2, wr1,wr2, wi ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28461,14 +28461,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlag2 + + pure subroutine stdlib_qlag2s( m, n, a, lda, sa, ldsa, info ) !> DLAG2S: converts a DOUBLE PRECISION matrix, SA, to a SINGLE !> PRECISION matrix, A. !> RMAX is the overflow for the SINGLE PRECISION arithmetic !> DLAG2S checks that all the entries of A are between -RMAX and !> RMAX. If not the conversion is aborted and a flag is raised. !> This is an auxiliary routine so there is no argument checking. - - pure subroutine stdlib_qlag2s( m, n, a, lda, sa, ldsa, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28498,6 +28498,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlag2s + + pure subroutine stdlib_qlags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) !> DLAGS2: computes 2-by-2 orthogonal matrices U, V and Q, such !> that if ( UPPER ) then !> U**T *A*Q = U**T *( A1 A2 )*Q = ( x 0 ) @@ -28515,8 +28517,6 @@ module stdlib_linalg_lapack_q !> U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ ) !> ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ ) !> Z**T denotes the transpose of Z. - - pure subroutine stdlib_qlags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28658,6 +28658,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlags2 + + pure subroutine stdlib_qlagtf( n, a, lambda, b, c, tol, d, in, info ) !> DLAGTF: 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, @@ -28670,8 +28672,6 @@ module stdlib_linalg_lapack_q !> The parameter LAMBDA is included in the routine so that DLAGTF may !> be used, in conjunction with DLAGTS, to obtain eigenvectors of T by !> inverse iteration. - - pure subroutine stdlib_qlagtf( n, a, lambda, b, c, tol, d, in, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28749,13 +28749,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlagtf + + pure subroutine stdlib_qlagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) !> DLAGTM: 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. - - pure subroutine stdlib_qlagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28851,6 +28851,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlagtm + + pure subroutine stdlib_qlagts( job, n, a, b, c, d, in, y, tol, info ) !> DLAGTS: 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 @@ -28860,8 +28862,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlagts( job, n, a, b, c, d, in, y, tol, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29048,6 +29048,8 @@ module stdlib_linalg_lapack_q end if end subroutine stdlib_qlagts + + pure subroutine stdlib_qlagv2( a, lda, b, ldb, alphar, alphai, beta, csl, snl,csr, snr ) !> DLAGV2: computes the Generalized Schur factorization of a real 2-by-2 !> matrix pencil (A,B) where B is upper triangular. This routine !> computes orthogonal (rotation) matrices given by CSL, SNL and CSR, @@ -29065,8 +29067,6 @@ module stdlib_linalg_lapack_q !> [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] !> [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ] !> where b11 >= b22 > 0. - - pure subroutine stdlib_qlagv2( a, lda, b, ldb, alphar, alphai, beta, csl, snl,csr, snr ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29212,12 +29212,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlagv2 + + pure subroutine stdlib_qlahqr( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, & !> DLAHQR: is an auxiliary routine called by DHSEQR to update the !> eigenvalues and Schur decomposition already computed by DHSEQR, by !> dealing with the Hessenberg submatrix in rows and columns ILO to !> IHI. - - pure subroutine stdlib_qlahqr( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, & info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29521,14 +29521,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlahqr + + pure subroutine stdlib_qlahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) !> DLAHR2: reduces the first NB columns of A real general n-BY-(n-k+1) !> matrix A so that elements below the k-th subdiagonal are zero. The !> reduction is performed by an orthogonal similarity transformation !> Q**T * A * Q. The routine returns the matrices V and T which determine !> Q as a block reflector I - V*T*V**T, and also the matrix Y = A * V * T. !> This is an auxiliary routine called by DGEHRD. - - pure subroutine stdlib_qlahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29609,6 +29609,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlahr2 + + pure subroutine stdlib_qlaic1( job, j, x, sest, w, gamma, sestpr, s, c ) !> DLAIC1: 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 @@ -29629,8 +29631,6 @@ module stdlib_linalg_lapack_q !> diag(sest*sest, 0) + [alpha gamma] * [ alpha ] !> [ gamma ] !> where alpha = x**T*w. - - pure subroutine stdlib_qlaic1( job, j, x, sest, w, gamma, sestpr, s, c ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29821,6 +29821,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaic1 + + pure logical(lk) function stdlib_qlaisnan( din1, din2 ) !> This routine is not for general use. It exists solely to avoid !> over-optimization in DISNAN. !> DLAISNAN: checks for NaNs by comparing its two arguments for @@ -29832,8 +29834,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure logical(lk) function stdlib_qlaisnan( din1, din2 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29845,6 +29845,8 @@ module stdlib_linalg_lapack_q return end function stdlib_qlaisnan + + pure subroutine stdlib_qlaln2( ltrans, na, nw, smin, ca, a, lda, d1, d2, b,ldb, wr, wi, x, & !> DLALN2: solves a system of the form (ca A - w D ) X = s B !> or (ca A**T - w D) X = s B with possible scaling ("s") and !> perturbation of A. (A**T means A-transpose.) @@ -29870,8 +29872,6 @@ module stdlib_linalg_lapack_q !> correct to a factor of 2 or so. !> Note: all input quantities are assumed to be smaller than overflow !> by a reasonable factor. (See BIGNUM.) - - pure subroutine stdlib_qlaln2( ltrans, na, nw, smin, ca, a, lda, d1, d2, b,ldb, wr, wi, x, & ldx, scale, xnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30170,6 +30170,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaln2 + + pure subroutine stdlib_qlals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, & !> DLALS0: 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 @@ -30190,8 +30192,6 @@ module stdlib_linalg_lapack_q !> null space. !> (3R) The inverse transformation of (2L). !> (4R) The inverse transformation of (1L). - - pure subroutine stdlib_qlals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, & givcol, ldgcol, givnum, ldgnum,poles, difl, difr, z, k, c, s, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30367,6 +30367,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlals0 + + pure subroutine stdlib_qlalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, difl,& !> DLALSA: 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 @@ -30376,8 +30378,6 @@ module stdlib_linalg_lapack_q !> ICOMPQ = 1, DLALSA applies the right singular vector matrix to the !> right hand side. The singular vector matrices were generated in !> compact form by DLALSA. - - pure subroutine stdlib_qlalsa( 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 ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30551,6 +30551,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlalsa + + pure subroutine stdlib_qlalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, iwork, & !> DLALSD: 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 @@ -30565,8 +30567,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, iwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30824,9 +30824,9 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlalsd - !> DLAMCH: determines quad precision machine parameters. pure real(qp) function stdlib_qlamch( cmach ) + !> DLAMCH: determines quad precision machine parameters. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30892,11 +30892,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlamc3 + + pure subroutine stdlib_qlamrg( n1, n2, a, dtrd1, dtrd2, index ) !> DLAMRG: 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. - - pure subroutine stdlib_qlamrg( n1, n2, a, dtrd1, dtrd2, index ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30956,6 +30956,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlamrg + + pure subroutine stdlib_qlamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & !> DLAMSWLQ: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -30963,8 +30965,6 @@ module stdlib_linalg_lapack_q !> where Q is a real orthogonal matrix defined as the product of blocked !> elementary reflectors computed by short wide LQ !> factorization (DLASWLQ) - - pure subroutine stdlib_qlamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31114,6 +31114,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlamswlq + + pure subroutine stdlib_qlamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & !> DLAMTSQR: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -31121,8 +31123,6 @@ module stdlib_linalg_lapack_q !> where Q is a real orthogonal matrix defined as the product !> of blocked elementary reflectors computed by tall skinny !> QR factorization (DLATSQR) - - pure subroutine stdlib_qlamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31276,6 +31276,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlamtsqr + + pure integer(ilp) function stdlib_qlaneg( n, d, lld, sigma, pivmin, r ) !> DLANEG: 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 @@ -31291,8 +31293,6 @@ module stdlib_linalg_lapack_q !> 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.) - - pure integer(ilp) function stdlib_qlaneg( n, d, lld, sigma, pivmin, r ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31381,11 +31381,11 @@ module stdlib_linalg_lapack_q stdlib_qlaneg = negcnt end function stdlib_qlaneg + + real(qp) function stdlib_qlangb( norm, n, kl, ku, ab, ldab,work ) !> DLANGB: 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. - - real(qp) function stdlib_qlangb( norm, n, kl, ku, ab, ldab,work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31456,11 +31456,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlangb + + real(qp) function stdlib_qlange( norm, m, n, a, lda, work ) !> DLANGE: 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 matrix A. - - real(qp) function stdlib_qlange( norm, m, n, a, lda, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31528,11 +31528,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlange + + pure real(qp) function stdlib_qlangt( norm, n, dl, d, du ) !> DLANGT: 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 tridiagonal matrix A. - - pure real(qp) function stdlib_qlangt( norm, n, dl, d, du ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31604,11 +31604,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlangt + + real(qp) function stdlib_qlanhs( norm, n, a, lda, work ) !> DLANHS: 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. - - real(qp) function stdlib_qlanhs( norm, n, a, lda, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31676,11 +31676,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlanhs + + real(qp) function stdlib_qlansb( norm, uplo, n, k, ab, ldab,work ) !> DLANSB: 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. - - real(qp) function stdlib_qlansb( norm, uplo, n, k, ab, ldab,work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31781,11 +31781,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlansb + + real(qp) function stdlib_qlansf( norm, transr, uplo, n, a, work ) !> DLANSF: 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. - - real(qp) function stdlib_qlansf( norm, transr, uplo, n, a, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32485,11 +32485,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlansf + + real(qp) function stdlib_qlansp( norm, uplo, n, ap, work ) !> DLANSP: 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, supplied in packed form. - - real(qp) function stdlib_qlansp( norm, uplo, n, ap, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32609,11 +32609,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlansp + + pure real(qp) function stdlib_qlanst( norm, n, d, e ) !> DLANST: 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. - - pure real(qp) function stdlib_qlanst( norm, n, d, e ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32671,11 +32671,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlanst + + real(qp) function stdlib_qlansy( norm, uplo, n, a, lda, work ) !> DLANSY: 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. - - real(qp) function stdlib_qlansy( norm, uplo, n, a, lda, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32767,11 +32767,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlansy + + real(qp) function stdlib_qlantb( norm, uplo, diag, n, k, ab,ldab, work ) !> DLANTB: 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. - - real(qp) function stdlib_qlantb( norm, uplo, diag, n, k, ab,ldab, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32960,11 +32960,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlantb + + real(qp) function stdlib_qlantp( norm, uplo, diag, n, ap, work ) !> DLANTP: 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. - - real(qp) function stdlib_qlantp( norm, uplo, diag, n, ap, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33166,11 +33166,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlantp + + real(qp) function stdlib_qlantr( norm, uplo, diag, m, n, a, lda,work ) !> DLANTR: 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. - - real(qp) function stdlib_qlantr( norm, uplo, diag, m, n, a, lda,work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33352,6 +33352,8 @@ module stdlib_linalg_lapack_q return end function stdlib_qlantr + + pure subroutine stdlib_qlanv2( a, b, c, d, rt1r, rt1i, rt2r, rt2i, cs, sn ) !> DLANV2: computes the Schur factorization of a real 2-by-2 nonsymmetric !> matrix in standard form: !> [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ] @@ -33360,8 +33362,6 @@ module stdlib_linalg_lapack_q !> 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or !> 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex !> conjugate eigenvalues. - - pure subroutine stdlib_qlanv2( a, b, c, d, rt1r, rt1i, rt2r, rt2i, cs, sn ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33498,6 +33498,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlanv2 + + pure subroutine stdlib_qlaorhr_col_getrfnp( m, n, a, lda, d, info ) !> DLAORHR_COL_GETRFNP: computes the modified LU factorization without !> pivoting of a real general M-by-N matrix A. The factorization has !> the form: @@ -33531,8 +33533,6 @@ module stdlib_linalg_lapack_q !> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, !> E. Solomonik, J. Parallel Distrib. Comput., !> vol. 85, pp. 3-31, 2015. - - pure subroutine stdlib_qlaorhr_col_getrfnp( m, n, a, lda, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33592,6 +33592,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaorhr_col_getrfnp + + pure recursive subroutine stdlib_qlaorhr_col_getrfnp2( m, n, a, lda, d, info ) !> DLAORHR_COL_GETRFNP2: computes the modified LU factorization without !> pivoting of a real general M-by-N matrix A. The factorization has !> the form: @@ -33640,8 +33642,6 @@ module stdlib_linalg_lapack_q !> [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. - - pure recursive subroutine stdlib_qlaorhr_col_getrfnp2( m, n, a, lda, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33722,14 +33722,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaorhr_col_getrfnp2 + + pure subroutine stdlib_qlapll( n, x, incx, y, incy, ssmin ) !> 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. - - pure subroutine stdlib_qlapll( n, x, incx, y, incy, ssmin ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33762,14 +33762,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlapll + + pure subroutine stdlib_qlapmr( forwrd, m, n, x, ldx, k ) !> DLAPMR: 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. - - pure subroutine stdlib_qlapmr( forwrd, m, n, x, ldx, k ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33830,14 +33830,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlapmr + + pure subroutine stdlib_qlapmt( forwrd, m, n, x, ldx, k ) !> DLAPMT: 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. - - pure subroutine stdlib_qlapmt( forwrd, m, n, x, ldx, k ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33898,10 +33898,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlapmt - !> DLAPY2: returns sqrt(x**2+y**2), taking care not to cause unnecessary - !> overflow and unnecessary underflow. pure real(qp) function stdlib_qlapy2( x, y ) + !> DLAPY2: returns sqrt(x**2+y**2), taking care not to cause unnecessary + !> overflow and unnecessary underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33935,10 +33935,10 @@ module stdlib_linalg_lapack_q return end function stdlib_qlapy2 - !> DLAPY3: returns sqrt(x**2+y**2+z**2), taking care not to cause - !> unnecessary overflow and unnecessary underflow. pure real(qp) function stdlib_qlapy3( x, y, z ) + !> DLAPY3: returns sqrt(x**2+y**2+z**2), taking care not to cause + !> unnecessary overflow and unnecessary underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33967,11 +33967,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlapy3 + + pure subroutine stdlib_qlaqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) !> DLAQGB: 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. - - pure subroutine stdlib_qlaqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34037,10 +34037,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaqgb - !> DLAQGE: equilibrates a general M by N matrix A using the row and - !> column scaling factors in the vectors R and C. pure subroutine stdlib_qlaqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed ) + !> DLAQGE: equilibrates a general M by N matrix A using the row and + !> column scaling factors in the vectors R and C. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34103,11 +34103,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaqge + + pure subroutine stdlib_qlaqp2( m, n, offset, a, lda, jpvt, tau, vn1, vn2,work ) !> DLAQP2: computes a QR factorization with column pivoting of !> the block A(OFFSET+1:M,1:N). !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. - - pure subroutine stdlib_qlaqp2( m, n, offset, a, lda, jpvt, tau, vn1, vn2,work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34180,6 +34180,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaqp2 + + pure subroutine stdlib_qlaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & !> DLAQPS: computes a step of QR factorization with column pivoting !> of a real 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 @@ -34188,8 +34190,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34314,6 +34314,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaqps + + subroutine stdlib_qlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& !> DLAQR0: computes the eigenvalues of a Hessenberg matrix H !> and, optionally, the matrices T and Z from the Schur decomposition !> H = Z T Z**T, where T is an upper quasi-triangular matrix (the @@ -34322,8 +34324,6 @@ module stdlib_linalg_lapack_q !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. - - subroutine stdlib_qlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34684,6 +34684,8 @@ module stdlib_linalg_lapack_q work( 1 ) = real( lwkopt,KIND=qp) end subroutine stdlib_qlaqr0 + + pure subroutine stdlib_qlaqr1( n, h, ldh, sr1, si1, sr2, si2, v ) !> Given a 2-by-2 or 3-by-3 matrix H, DLAQR1: sets v to a !> scalar multiple of the first column of the product !> (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I) @@ -34694,8 +34696,6 @@ module stdlib_linalg_lapack_q !> 2) si1 = si2 = 0. !> This is useful for starting double implicit shift bulges !> in the QR algorithm. - - pure subroutine stdlib_qlaqr1( n, h, ldh, sr1, si1, sr2, si2, v ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34744,6 +34744,8 @@ module stdlib_linalg_lapack_q end if end subroutine stdlib_qlaqr1 + + subroutine stdlib_qlaqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& !> DLAQR2: is identical to DLAQR3 except that it avoids !> recursion by calling DLAHQR instead of DLAQR4. !> Aggressive early deflation: @@ -34755,8 +34757,6 @@ module stdlib_linalg_lapack_q !> an orthogonal similarity transformation of H. It is to be !> hoped that the final version of H has many zero subdiagonal !> entries. - - subroutine stdlib_qlaqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& sr, si, v, ldv, nh, t,ldt, nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35047,6 +35047,8 @@ module stdlib_linalg_lapack_q work( 1 ) = real( lwkopt,KIND=qp) end subroutine stdlib_qlaqr2 + + subroutine stdlib_qlaqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& !> Aggressive early deflation: !> DLAQR3: accepts as input an upper Hessenberg matrix !> H and performs an orthogonal similarity transformation @@ -35056,8 +35058,6 @@ module stdlib_linalg_lapack_q !> an orthogonal similarity transformation of H. It is to be !> hoped that the final version of H has many zero subdiagonal !> entries. - - subroutine stdlib_qlaqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& sr, si, v, ldv, nh, t,ldt, nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35358,6 +35358,8 @@ module stdlib_linalg_lapack_q work( 1 ) = real( lwkopt,KIND=qp) end subroutine stdlib_qlaqr3 + + subroutine stdlib_qlaqr4( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& !> DLAQR4: implements one level of recursion for DLAQR0. !> It is a complete implementation of the small bulge multi-shift !> QR algorithm. It may be called by DLAQR0 and, for large enough @@ -35372,8 +35374,6 @@ module stdlib_linalg_lapack_q !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. - - subroutine stdlib_qlaqr4( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35729,10 +35729,10 @@ module stdlib_linalg_lapack_q work( 1 ) = real( lwkopt,KIND=qp) end subroutine stdlib_qlaqr4 - !> DLAQR5:, called by DLAQR0, performs a - !> single small-bulge multi-shift QR sweep. pure subroutine stdlib_qlaqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts,sr, si, h, ldh, & + !> DLAQR5:, called by DLAQR0, performs a + !> single small-bulge multi-shift QR sweep. iloz, ihiz, z, ldz, v, ldv, u,ldu, nv, wv, ldwv, nh, wh, ldwh ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36136,10 +36136,10 @@ module stdlib_linalg_lapack_q end do loop_180 end subroutine stdlib_qlaqr5 - !> DLAQSB: equilibrates a symmetric band matrix A using the scaling - !> factors in the vector S. pure subroutine stdlib_qlaqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) + !> DLAQSB: equilibrates a symmetric band matrix A using the scaling + !> factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36196,10 +36196,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaqsb - !> DLAQSP: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_qlaqsp( uplo, n, ap, s, scond, amax, equed ) + !> DLAQSP: equilibrates a symmetric matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36258,10 +36258,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaqsp - !> DLAQSY: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_qlaqsy( uplo, n, a, lda, s, scond, amax, equed ) + !> DLAQSY: equilibrates a symmetric matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36316,6 +36316,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaqsy + + subroutine stdlib_qlaqtr( ltran, lreal, n, t, ldt, b, w, scale, x, work,info ) !> DLAQTR: solves the real quasi-triangular system !> op(T)*p = scale*c, if LREAL = .TRUE. !> or the complex quasi-triangular systems @@ -36334,8 +36336,6 @@ module stdlib_linalg_lapack_q !> [ d ] [ q ] !> This subroutine is designed for the condition number estimation !> in routine DTRSNA. - - subroutine stdlib_qlaqtr( ltran, lreal, n, t, ldt, b, w, scale, x, work,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36762,6 +36762,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaqtr + + recursive subroutine stdlib_qlaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alphar, & !> DLAQZ0: computes the eigenvalues of a real matrix pair (H,T), !> where H is an upper Hessenberg matrix and T is upper triangular, !> using the double-shift QZ method. @@ -36810,8 +36812,6 @@ module stdlib_linalg_lapack_q !> 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" - - recursive subroutine stdlib_qlaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alphar, & alphai, beta,q, ldq, z, ldz, work, lwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -37154,6 +37154,8 @@ module stdlib_linalg_lapack_q info = norm_info end subroutine stdlib_qlaqz0 + + pure subroutine stdlib_qlaqz1( a, lda, b, ldb, sr1, sr2, si, beta1, beta2,v ) !> Given a 3-by-3 matrix pencil (A,B), DLAQZ1: sets v to a !> scalar multiple of the first column of the product !> (*) K = (A - (beta2*sr2 - i*si)*B)*B^(-1)*(beta1*A - (sr2 + i*si2)*B)*B^(-1). @@ -37163,8 +37165,6 @@ module stdlib_linalg_lapack_q !> 2) si = 0. !> This is useful for starting double implicit shift bulges !> in the QZ algorithm. - - pure subroutine stdlib_qlaqz1( a, lda, b, ldb, sr1, sr2, si, beta1, beta2,v ) ! arguments integer(ilp), intent( in ) :: lda, ldb real(qp), intent( in ) :: a( lda, * ), b( ldb, * ), sr1,sr2, si, beta1, beta2 @@ -37209,9 +37209,9 @@ module stdlib_linalg_lapack_q end if end subroutine stdlib_qlaqz1 - !> DLAQZ2: chases a 2x2 shift bulge in a matrix pencil down a single position pure subroutine stdlib_qlaqz2( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, qstart, & + !> DLAQZ2: chases a 2x2 shift bulge in a matrix pencil down a single position q, ldq, nz, zstart, z, ldz ) ! arguments logical(lk), intent( in ) :: ilq, ilz @@ -37320,9 +37320,9 @@ module stdlib_linalg_lapack_q end if end subroutine stdlib_qlaqz2 - !> DLAQZ3: performs AED recursive subroutine stdlib_qlaqz3( ilschur, ilq, ilz, n, ilo, ihi, nw,a, lda, b, ldb, q, & + !> DLAQZ3: performs AED ldq, z, ldz, ns,nd, alphar, alphai, beta, qc, ldqc,zc, ldzc, work, lwork, rec, info ) ! arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -37592,9 +37592,9 @@ module stdlib_linalg_lapack_q end if end subroutine stdlib_qlaqz3 - !> DLAQZ4: Executes a single multishift QZ sweep pure subroutine stdlib_qlaqz4( ilschur, ilq, ilz, n, ilo, ihi, nshifts,nblock_qesired, sr, & + !> DLAQZ4: Executes a single multishift QZ sweep si, ss, a, lda, b, ldb, q,ldq, z, ldz, qc, ldqc, zc, ldzc, work, lwork,info ) ! function arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -37849,6 +37849,8 @@ module stdlib_linalg_lapack_q end if end subroutine stdlib_qlaqz4 + + pure subroutine stdlib_qlar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & !> DLAR1V: 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 @@ -37864,8 +37866,6 @@ module stdlib_linalg_lapack_q !> (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. - - pure subroutine stdlib_qlar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38071,13 +38071,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlar1v + + pure subroutine stdlib_qlar2v( n, x, y, z, incx, c, s, incc ) !> DLAR2V: applies a vector of real plane rotations from both sides to !> a sequence of 2-by-2 real symmetric matrices, defined by the elements !> of the vectors x, y and z. For i = 1,2,...,n !> ( x(i) z(i) ) := ( c(i) s(i) ) ( x(i) z(i) ) ( c(i) -s(i) ) !> ( z(i) y(i) ) ( -s(i) c(i) ) ( z(i) y(i) ) ( s(i) c(i) ) - - pure subroutine stdlib_qlar2v( n, x, y, z, incx, c, s, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38114,13 +38114,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlar2v + + pure subroutine stdlib_qlarf( side, m, n, v, incv, tau, c, ldc, work ) !> DLARF: applies a real elementary reflector H to a real m by n matrix !> C, from either the left or the right. H is represented in the form !> H = I - tau * v * v**T !> where tau is a real scalar and v is a real vector. !> If tau = 0, then H is taken to be the unit matrix. - - pure subroutine stdlib_qlarf( side, m, n, v, incv, tau, c, ldc, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38191,10 +38191,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarf - !> DLARFB: applies a real block reflector H or its transpose H**T to a - !> real m by n matrix C, from either the left or the right. pure subroutine stdlib_qlarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, ldc, & + !> DLARFB: applies a real block reflector H or its transpose H**T to a + !> real m by n matrix C, from either the left or the right. work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38513,6 +38513,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarfb + + pure subroutine stdlib_qlarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) !> DLARFB_GETT: applies a real Householder block reflector H from the !> left to a real (K+M)-by-N "triangular-pentagonal" matrix !> composed of two block matrices: an upper trapezoidal K-by-N matrix A @@ -38520,8 +38522,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38650,6 +38650,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarfb_gett + + pure subroutine stdlib_qlarfg( n, alpha, x, incx, tau ) !> DLARFG: generates a real elementary reflector H of order n, such !> that !> H * ( alpha ) = ( beta ), H**T * H = I. @@ -38663,8 +38665,6 @@ module stdlib_linalg_lapack_q !> If the elements of x are all zero, then tau = 0 and H is taken to be !> the unit matrix. !> Otherwise 1 <= tau <= 2. - - pure subroutine stdlib_qlarfg( n, alpha, x, incx, tau ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38719,6 +38719,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarfg + + subroutine stdlib_qlarfgp( n, alpha, x, incx, tau ) !> DLARFGP: generates a real elementary reflector H of order n, such !> that !> H * ( alpha ) = ( beta ), H**T * H = I. @@ -38731,8 +38733,6 @@ module stdlib_linalg_lapack_q !> vector. !> If the elements of x are all zero, then tau = 0 and H is taken to be !> the unit matrix. - - subroutine stdlib_qlarfgp( n, alpha, x, incx, tau ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38827,6 +38827,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarfgp + + pure subroutine stdlib_qlarft( direct, storev, n, k, v, ldv, tau, t, ldt ) !> DLARFT: forms the triangular factor T of a real 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; @@ -38837,8 +38839,6 @@ module stdlib_linalg_lapack_q !> 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**T * T * V - - pure subroutine stdlib_qlarft( direct, storev, n, k, v, ldv, tau, t, ldt ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38954,6 +38954,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarft + + pure subroutine stdlib_qlarfx( side, m, n, v, tau, c, ldc, work ) !> DLARFX: applies a real elementary reflector H to a real m by n !> matrix C, from either the left or the right. H is represented in the !> form @@ -38961,8 +38963,6 @@ module stdlib_linalg_lapack_q !> where tau is a real scalar and v is a real vector. !> If tau = 0, then H is taken to be the unit matrix !> This version uses inline code if H has order < 11. - - pure subroutine stdlib_qlarfx( side, m, n, v, tau, c, ldc, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39457,14 +39457,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarfx + + pure subroutine stdlib_qlarfy( uplo, n, v, incv, tau, c, ldc, work ) !> DLARFY: applies an elementary reflector, or Householder matrix, H, !> to an n x n symmetric 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. - - pure subroutine stdlib_qlarfy( uplo, n, v, incv, tau, c, ldc, work ) ! -- lapack test routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39491,12 +39491,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarfy + + pure subroutine stdlib_qlargv( n, x, incx, y, incy, c, incc ) !> DLARGV: generates a vector of real plane rotations, determined by !> elements of the real vectors x and y. For i = 1,2,...,n !> ( c(i) s(i) ) ( x(i) ) = ( a(i) ) !> ( -s(i) c(i) ) ( y(i) ) = ( 0 ) - - pure subroutine stdlib_qlargv( n, x, incx, y, incy, c, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39545,10 +39545,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlargv - !> DLARNV: returns a vector of n random real numbers from a uniform or - !> normal distribution. pure subroutine stdlib_qlarnv( idist, iseed, n, x ) + !> DLARNV: returns a vector of n random real numbers from a uniform or + !> normal distribution. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39601,10 +39601,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarnv - !> Compute the splitting points with threshold SPLTOL. - !> DLARRA: sets any "small" off-diagonal elements to zero. pure subroutine stdlib_qlarra( n, d, e, e2, spltol, tnrm,nsplit, isplit, info ) + !> Compute the splitting points with threshold SPLTOL. + !> DLARRA: sets any "small" off-diagonal elements to zero. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39659,6 +39659,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarra + + pure subroutine stdlib_qlarrb( n, d, lld, ifirst, ilast, rtol1,rtol2, offset, w, wgap, werr, & !> Given the relatively robust representation(RRR) L D L^T, DLARRB: !> does "limited" bisection to refine the eigenvalues of L D L^T, !> W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial @@ -39667,8 +39669,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlarrb( n, d, lld, ifirst, ilast, rtol1,rtol2, offset, w, wgap, werr, & work, iwork,pivmin, spdiam, twist, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39832,11 +39832,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarrb + + pure subroutine stdlib_qlarrc( jobt, n, vl, vu, d, e, pivmin,eigcnt, lcnt, rcnt, info ) !> 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'. - - pure subroutine stdlib_qlarrc( jobt, n, vl, vu, d, e, pivmin,eigcnt, lcnt, rcnt, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39925,6 +39925,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarrc + + pure subroutine stdlib_qlarrd( range, order, n, vl, vu, il, iu, gers,reltol, d, e, e2, & !> DLARRD: computes the eigenvalues of a symmetric tridiagonal !> matrix T to suitable accuracy. This is an auxiliary code to be !> called from DSTEMR. @@ -39937,8 +39939,6 @@ module stdlib_linalg_lapack_q !> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal !> Matrix", Report CS41, Computer Science Dept., Stanford !> University, July 21, 1966. - - pure subroutine stdlib_qlarrd( 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 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40396,6 +40396,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarrd + + pure subroutine stdlib_qlarre( range, n, vl, vu, il, iu, d, e, e2,rtol1, rtol2, spltol, & !> To find the desired eigenvalues of a given real symmetric !> tridiagonal matrix T, DLARRE: sets any "small" off-diagonal !> elements to zero, and for each unreduced block T_i, it finds @@ -40409,8 +40411,6 @@ module stdlib_linalg_lapack_q !> conpute all and then discard any unwanted one. !> As an added benefit, DLARRE also outputs the n !> Gerschgorin intervals for the matrices L_i D_i L_i^T. - - pure subroutine stdlib_qlarre( 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 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40921,13 +40921,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarre + + pure subroutine stdlib_qlarrf( n, d, l, ld, clstrt, clend,w, wgap, werr,spdiam, clgapl, & !> 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 ), DLARRF: 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. - - pure subroutine stdlib_qlarrf( n, d, l, ld, clstrt, clend,w, wgap, werr,spdiam, clgapl, & clgapr, pivmin, sigma,dplus, lplus, work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41180,6 +41180,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarrf + + pure subroutine stdlib_qlarrj( n, d, e2, ifirst, ilast,rtol, offset, w, werr, work, iwork,& !> Given the initial eigenvalue approximations of T, DLARRJ: !> does bisection to refine the eigenvalues of T, !> W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial @@ -41187,8 +41189,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlarrj( n, d, e2, ifirst, ilast,rtol, offset, w, werr, work, iwork,& pivmin, spdiam, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41358,6 +41358,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarrj + + pure subroutine stdlib_qlarrk( n, iw, gl, gu,d, e2, pivmin, reltol, w, werr, info) !> DLARRK: computes one eigenvalue of a symmetric tridiagonal !> matrix T to suitable accuracy. This is an auxiliary code to be !> called from DSTEMR. @@ -41367,8 +41369,6 @@ module stdlib_linalg_lapack_q !> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal !> Matrix", Report CS41, Computer Science Dept., Stanford !> University, July 21, 1966. - - pure subroutine stdlib_qlarrk( n, iw, gl, gu,d, e2, pivmin, reltol, w, werr, info) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41438,11 +41438,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarrk + + pure subroutine stdlib_qlarrr( n, d, e, info ) !> Perform tests to decide whether the symmetric tridiagonal matrix T !> warrants expensive computations which guarantee high relative accuracy !> in the eigenvalues. - - pure subroutine stdlib_qlarrr( n, d, e, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41520,11 +41520,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarrr + + pure subroutine stdlib_qlarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, & !> DLARRV: 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 DLARRE. - - pure subroutine stdlib_qlarrv( 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 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42151,6 +42151,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarrv + + pure subroutine stdlib_qlartg( f, g, c, s, r ) !> ! !> !> DLARTG: generates a plane rotation so that @@ -42175,8 +42177,6 @@ module stdlib_linalg_lapack_q !> there are zeros on the diagonal). !> If F exceeds G in magnitude, C will be positive. !> Below, wp=>dp stands for quad precision from LA_CONSTANTS module. - - pure subroutine stdlib_qlartg( f, g, c, s, r ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42220,6 +42220,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlartg + + pure subroutine stdlib_qlartgp( f, g, cs, sn, r ) !> DLARTGP: generates a plane rotation so that !> [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1. !> [ -SN CS ] [ G ] [ 0 ] @@ -42229,8 +42231,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlartgp( f, g, cs, sn, r ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42314,6 +42314,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlartgp + + pure subroutine stdlib_qlartgs( x, y, sigma, cs, sn ) !> DLARTGS: 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. @@ -42322,8 +42324,6 @@ module stdlib_linalg_lapack_q !> [ -SN CS ] [ X * Y ] [ 0 ] !> with R nonnegative. If X^2 - SIGMA and X * Y are 0, then the !> rotation is by PI/2. - - pure subroutine stdlib_qlartgs( x, y, sigma, cs, sn ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42370,12 +42370,12 @@ module stdlib_linalg_lapack_q ! end stdlib_qlartgs end subroutine stdlib_qlartgs + + pure subroutine stdlib_qlartv( n, x, incx, y, incy, c, s, incc ) !> DLARTV: applies a vector of real plane rotations to elements of the !> real vectors x and y. For i = 1,2,...,n !> ( x(i) ) := ( c(i) s(i) ) ( x(i) ) !> ( y(i) ) ( -s(i) c(i) ) ( y(i) ) - - pure subroutine stdlib_qlartv( n, x, incx, y, incy, c, s, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42404,11 +42404,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlartv + + pure subroutine stdlib_qlaruv( iseed, n, x ) !> DLARUV: 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. - - pure subroutine stdlib_qlaruv( iseed, n, x ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42606,6 +42606,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaruv + + pure subroutine stdlib_qlarz( side, m, n, l, v, incv, tau, c, ldc, work ) !> DLARZ: applies a real elementary reflector H to a real M-by-N !> matrix C, from either the left or the right. H is represented in the !> form @@ -42613,8 +42615,6 @@ module stdlib_linalg_lapack_q !> where tau is a real scalar and v is a real vector. !> If tau = 0, then H is taken to be the unit matrix. !> H is a product of k elementary reflectors as returned by DTZRZF. - - pure subroutine stdlib_qlarz( side, m, n, l, v, incv, tau, c, ldc, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42661,11 +42661,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarz + + pure subroutine stdlib_qlarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & !> DLARZB: applies a real block reflector H or its transpose H**T to !> a real distributed M-by-N C from the left or the right. !> Currently, only STOREV = 'R' and DIRECT = 'B' are supported. - - pure subroutine stdlib_qlarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & ldc, work, ldwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42750,6 +42750,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarzb + + pure subroutine stdlib_qlarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) !> DLARZT: forms the triangular factor T of a real block reflector !> H of order > n, which is defined as a product of k elementary !> reflectors. @@ -42762,8 +42764,6 @@ module stdlib_linalg_lapack_q !> H(i) is stored in the i-th row of the array V, and !> H = I - V**T * T * V !> Currently, only STOREV = 'R' and DIRECT = 'B' are supported. - - pure subroutine stdlib_qlarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42812,13 +42812,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarzt + + pure subroutine stdlib_qlas2( f, g, h, ssmin, ssmax ) !> DLAS2: computes the singular values of the 2-by-2 matrix !> [ F G ] !> [ 0 H ]. !> On return, SSMIN is the smaller singular value and SSMAX is the !> larger singular value. - - pure subroutine stdlib_qlas2( f, g, h, ssmin, ssmax ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42876,13 +42876,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlas2 + + pure subroutine stdlib_qlascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) !> DLASCL: multiplies the M by N real 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. - - pure subroutine stdlib_qlascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43046,6 +43046,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlascl + + pure subroutine stdlib_qlasd0( n, sqre, d, e, u, ldu, vt, ldvt, smlsiz, iwork,work, info ) !> Using a divide and conquer approach, DLASD0: 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. @@ -43053,8 +43055,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlasd0( n, sqre, d, e, u, ldu, vt, ldvt, smlsiz, iwork,work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43185,6 +43185,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd0 + + pure subroutine stdlib_qlasd1( nl, nr, sqre, d, alpha, beta, u, ldu, vt, ldvt,idxq, iwork, & !> DLASD1: computes the SVD of an upper bidiagonal N-by-M matrix B, !> where N = NL + NR + 1 and M = N + SQRE. DLASD1 is called from DLASD0. !> A related subroutine DLASD7 handles the case in which the singular @@ -43214,8 +43216,6 @@ module stdlib_linalg_lapack_q !> directly using the updated singular values. The singular vectors !> for the current problem are multiplied with the singular vectors !> from the overall problem. - - pure subroutine stdlib_qlasd1( nl, nr, sqre, d, alpha, beta, u, ldu, vt, ldvt,idxq, iwork, & work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43300,6 +43300,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd1 + + pure subroutine stdlib_qlasd2( nl, nr, sqre, k, d, z, alpha, beta, u, ldu, vt,ldvt, dsigma, & !> DLASD2: 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 @@ -43307,8 +43309,6 @@ module stdlib_linalg_lapack_q !> Z vector. For each such occurrence the order of the related secular !> equation problem is reduced by one. !> DLASD2 is called from DLASD1. - - pure subroutine stdlib_qlasd2( nl, nr, sqre, k, d, z, alpha, beta, u, ldu, vt,ldvt, dsigma, & u2, ldu2, vt2, ldvt2, idxp, idx,idxc, idxq, coltyp, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43585,6 +43585,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd2 + + pure subroutine stdlib_qlasd3( nl, nr, sqre, k, d, q, ldq, dsigma, u, ldu, u2,ldu2, vt, ldvt,& !> DLASD3: finds all the square roots of the roots of the secular !> equation, as defined by the values in D and Z. It makes the !> appropriate calls to DLASD4 and then updates the singular @@ -43596,8 +43598,6 @@ module stdlib_linalg_lapack_q !> It could conceivably fail on hexadecimal or decimal machines !> without guard digits, but we know of none. !> DLASD3 is called from DLASD1. - - pure subroutine stdlib_qlasd3( nl, nr, sqre, k, d, q, ldq, dsigma, u, ldu, u2,ldu2, vt, ldvt,& vt2, ldvt2, idxc, ctot, z,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43787,6 +43787,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd3 + + pure subroutine stdlib_qlasd4( n, i, d, z, delta, rho, sigma, work, info ) !> 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 @@ -43798,8 +43800,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlasd4( n, i, d, z, delta, rho, sigma, work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44515,6 +44515,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd4 + + pure subroutine stdlib_qlasd5( i, d, z, delta, rho, dsigma, work ) !> 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 @@ -44523,8 +44525,6 @@ module stdlib_linalg_lapack_q !> 0 <= D(i) < D(j) for i < j . !> We also assume RHO > 0 and that the Euclidean norm of the vector !> Z is one. - - pure subroutine stdlib_qlasd5( i, d, z, delta, rho, dsigma, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44610,6 +44610,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd5 + + pure subroutine stdlib_qlasd6( icompq, nl, nr, sqre, d, vf, vl, alpha, beta,idxq, perm, & !> DLASD6: 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 @@ -44645,8 +44647,6 @@ module stdlib_linalg_lapack_q !> between the updated singular values and the old singular !> values. !> DLASD6 is called from DLASDA. - - pure subroutine stdlib_qlasd6( 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 ) ! -- lapack auxiliary routine -- @@ -44738,6 +44738,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd6 + + pure subroutine stdlib_qlasd7( icompq, nl, nr, sqre, k, d, z, zw, vf, vfw, vl,vlw, alpha, & !> DLASD7: 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 @@ -44745,8 +44747,6 @@ module stdlib_linalg_lapack_q !> vector. For each such occurrence the order of the related !> secular equation problem is reduced by one. !> DLASD7 is called from DLASD6. - - pure subroutine stdlib_qlasd7( 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 ) ! -- lapack auxiliary routine -- @@ -44977,6 +44977,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd7 + + pure subroutine stdlib_qlasd8( icompq, k, d, z, vf, vl, difl, difr, lddifr,dsigma, work, & !> DLASD8: 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 @@ -44984,8 +44986,6 @@ module stdlib_linalg_lapack_q !> the arrays VF and VL, the first and last components of all the !> right singular vectors of the original bidiagonal matrix. !> DLASD8 is called from DLASD6. - - pure subroutine stdlib_qlasd8( icompq, k, d, z, vf, vl, difl, difr, lddifr,dsigma, work, & info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45113,6 +45113,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd8 + + pure subroutine stdlib_qlasda( icompq, smlsiz, n, sqre, d, e, u, ldu, vt, k,difl, difr, z, & !> Using a divide and conquer approach, DLASDA: 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 @@ -45121,8 +45123,6 @@ module stdlib_linalg_lapack_q !> compact form. !> A related subroutine, DLASD0, computes the singular values and !> the singular vectors in explicit form. - - pure subroutine stdlib_qlasda( icompq, smlsiz, n, sqre, d, e, u, ldu, vt, k,difl, difr, z, & poles, givptr, givcol, ldgcol,perm, givnum, c, s, work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45315,6 +45315,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasda + + pure subroutine stdlib_qlasdq( uplo, sqre, n, ncvt, nru, ncc, d, e, vt, ldvt,u, ldu, c, ldc, & !> DLASDQ: 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 @@ -45327,8 +45329,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlasdq( uplo, sqre, n, ncvt, nru, ncc, d, e, vt, ldvt,u, ldu, c, ldc, & work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45480,10 +45480,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasdq - !> DLASDT: creates a tree of subproblems for bidiagonal divide and - !> conquer. pure subroutine stdlib_qlasdt( n, lvl, nd, inode, ndiml, ndimr, msub ) + !> DLASDT: creates a tree of subproblems for bidiagonal divide and + !> conquer. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45531,10 +45531,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasdt - !> DLASET: initializes an m-by-n matrix A to BETA on the diagonal and - !> ALPHA on the offdiagonals. pure subroutine stdlib_qlaset( uplo, m, n, alpha, beta, a, lda ) + !> DLASET: initializes an m-by-n matrix A to BETA on the diagonal and + !> ALPHA on the offdiagonals. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45581,6 +45581,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaset + + pure subroutine stdlib_qlasq1( n, d, e, work, info ) !> DLASQ1: 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 @@ -45591,8 +45593,6 @@ module stdlib_linalg_lapack_q !> 1994, !> and the present implementation is described in "An implementation of !> the dqds Algorithm (Positive Case)", LAPACK Working Note. - - pure subroutine stdlib_qlasq1( n, d, e, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45673,6 +45673,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasq1 + + pure subroutine stdlib_qlasq2( n, z, info ) !> DLASQ2: computes all the eigenvalues of the symmetric positive !> definite tridiagonal matrix associated with the qd array Z to high !> relative accuracy are computed to high relative accuracy, in the @@ -45686,8 +45688,6 @@ module stdlib_linalg_lapack_q !> on machines which follow ieee-754 floating-point standard in their !> handling of infinities and NaNs, and false otherwise. This variable !> is passed to DLASQ3. - - pure subroutine stdlib_qlasq2( n, z, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46061,11 +46061,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasq2 + + pure subroutine stdlib_qlasq3( i0, n0, z, pp, dmin, sigma, desig, qmax, nfail,iter, ndiv, & !> DLASQ3: checks for deflation, computes a shift (TAU) and calls dqds. !> In case of failure it changes shifts, and tries again until output !> is positive. - - pure subroutine stdlib_qlasq3( i0, n0, z, pp, dmin, sigma, desig, qmax, nfail,iter, ndiv, & ieee, ttype, dmin1, dmin2, dn, dn1,dn2, g, tau ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46231,10 +46231,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasq3 - !> DLASQ4: computes an approximation TAU to the smallest eigenvalue - !> using values of d from the previous transform. pure subroutine stdlib_qlasq4( i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn,dn1, dn2, tau, & + !> DLASQ4: computes an approximation TAU to the smallest eigenvalue + !> using values of d from the previous transform. ttype, g ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46439,10 +46439,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasq4 - !> DLASQ5: computes one dqds transform in ping-pong form, one - !> version for IEEE machines another for non IEEE machines. pure subroutine stdlib_qlasq5( i0, n0, z, pp, tau, sigma, dmin, dmin1, dmin2,dn, dnm1, dnm2, & + !> DLASQ5: computes one dqds transform in ping-pong form, one + !> version for IEEE machines another for non IEEE machines. ieee, eps ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46667,10 +46667,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasq5 - !> DLASQ6: computes one dqd (shift equal to zero) transform in - !> ping-pong form, with protection against underflow and overflow. pure subroutine stdlib_qlasq6( i0, n0, z, pp, dmin, dmin1, dmin2, dn,dnm1, dnm2 ) + !> DLASQ6: computes one dqd (shift equal to zero) transform in + !> ping-pong form, with protection against underflow and overflow. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46777,6 +46777,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasq6 + + pure subroutine stdlib_qlasr( side, pivot, direct, m, n, c, s, a, lda ) !> DLASR: applies a sequence of plane rotations to a real matrix A, !> from either the left or the right. !> When SIDE = 'L', the transformation takes the form @@ -46828,8 +46830,6 @@ module stdlib_linalg_lapack_q !> ( -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. - - pure subroutine stdlib_qlasr( side, pivot, direct, m, n, c, s, a, lda ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47036,12 +47036,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasr + + pure subroutine stdlib_qlasrt( id, n, d, info ) !> 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. - - pure subroutine stdlib_qlasrt( id, n, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47210,6 +47210,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasrt + + pure subroutine stdlib_qlassq( n, x, incx, scl, sumsq ) !> ! !> !> DLASSQ: returns the values scl and smsq such that @@ -47230,8 +47232,6 @@ module stdlib_linalg_lapack_q !> and !> TINY*EPS -- tiniest representable number; !> HUGE -- biggest representable number. - - pure subroutine stdlib_qlassq( n, x, incx, scl, sumsq ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47327,6 +47327,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlassq + + pure subroutine stdlib_qlasv2( f, g, h, ssmin, ssmax, snr, csr, snl, csl ) !> DLASV2: computes the singular value decomposition of a 2-by-2 !> triangular matrix !> [ F G ] @@ -47336,8 +47338,6 @@ module stdlib_linalg_lapack_q !> right singular vectors for abs(SSMAX), giving the decomposition !> [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ] !> [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ]. - - pure subroutine stdlib_qlasv2( f, g, h, ssmin, ssmax, snr, csr, snl, csl ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47472,6 +47472,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasv2 + + pure subroutine stdlib_qlaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) !> DLASWLQ: computes a blocked Tall-Skinny LQ factorization of !> a real M-by-N matrix A for M <= N: !> A = ( L 0 ) * Q, @@ -47482,8 +47484,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -47556,10 +47556,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaswlq - !> DLASWP: performs a series of row interchanges on the matrix A. - !> One row interchange is initiated for each of rows K1 through K2 of A. pure subroutine stdlib_qlaswp( n, a, lda, k1, k2, ipiv, incx ) + !> DLASWP: performs a series of row interchanges on the matrix A. + !> One row interchange is initiated for each of rows K1 through K2 of A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47623,12 +47623,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaswp + + pure subroutine stdlib_qlasy2( ltranl, ltranr, isgn, n1, n2, tl, ldtl, tr,ldtr, b, ldb, & !> DLASY2: solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in !> op(TL)*X + ISGN*X*op(TR) = SCALE*B, !> where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or !> -1. op(T) = T or T**T, where T**T denotes the transpose of T. - - pure subroutine stdlib_qlasy2( ltranl, ltranr, isgn, n1, n2, tl, ldtl, tr,ldtr, b, ldb, & scale, x, ldx, xnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47883,6 +47883,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasy2 + + pure subroutine stdlib_qlasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) !> DLASYF: computes a partial factorization of a real symmetric matrix A !> using the Bunch-Kaufman diagonal pivoting method. The partial !> factorization has the form: @@ -47895,8 +47897,6 @@ module stdlib_linalg_lapack_q !> DLASYF is an auxiliary routine called by DSYTRF. It uses blocked code !> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or !> A22 (if UPLO = 'L'). - - pure subroutine stdlib_qlasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48320,6 +48320,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasyf + + pure subroutine stdlib_qlasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) !> DLATRF_AA factorizes a panel of a real 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. @@ -48330,8 +48332,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qlasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48554,6 +48554,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasyf_aa + + pure subroutine stdlib_qlasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) !> DLASYF_RK: computes a partial factorization of a real symmetric !> matrix A using the bounded Bunch-Kaufman (rook) diagonal !> pivoting method. The partial factorization has the form: @@ -48566,8 +48568,6 @@ module stdlib_linalg_lapack_q !> DLASYF_RK is an auxiliary routine called by DSYTRF_RK. It uses !> blocked code (calling Level 3 BLAS) to update the submatrix !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). - - pure subroutine stdlib_qlasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48995,6 +48995,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasyf_rk + + pure subroutine stdlib_qlasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) !> DLASYF_ROOK: computes a partial factorization of a real symmetric !> matrix A using the bounded Bunch-Kaufman ("rook") diagonal !> pivoting method. The partial factorization has the form: @@ -49007,8 +49009,6 @@ module stdlib_linalg_lapack_q !> DLASYF_ROOK is an auxiliary routine called by DSYTRF_ROOK. It uses !> blocked code (calling Level 3 BLAS) to update the submatrix !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). - - pure subroutine stdlib_qlasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49456,14 +49456,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasyf_rook + + pure subroutine stdlib_qlat2s( uplo, n, a, lda, sa, ldsa, info ) !> DLAT2S: converts a DOUBLE PRECISION triangular matrix, SA, to a SINGLE !> PRECISION triangular matrix, A. !> RMAX is the overflow for the SINGLE PRECISION arithmetic !> DLAS2S checks that all the entries of A are between -RMAX and !> RMAX. If not the conversion is aborted and a flag is raised. !> This is an auxiliary routine so there is no argument checking. - - pure subroutine stdlib_qlat2s( uplo, n, a, lda, sa, ldsa, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49507,6 +49507,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlat2s + + pure subroutine stdlib_qlatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & !> DLATBS: solves one of the triangular systems !> A *x = s*b or A**T*x = s*b !> with scaling to prevent overflow, where A is an upper or lower @@ -49517,8 +49519,6 @@ module stdlib_linalg_lapack_q !> overflow, the Level 2 BLAS routine DTBSV 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. - - pure subroutine stdlib_qlatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49927,6 +49927,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlatbs + + pure subroutine stdlib_qlatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) !> DLATDF: uses the LU factorization of the n-by-n matrix Z computed by !> DGETC2 and computes a contribution to the reciprocal Dif-estimate !> by solving Z * x = b for x, and choosing the r.h.s. b such that @@ -49935,8 +49937,6 @@ module stdlib_linalg_lapack_q !> The factorization of Z returned by DGETC2 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. - - pure subroutine stdlib_qlatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50037,6 +50037,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlatdf + + pure subroutine stdlib_qlatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) !> DLATPS: solves one of the triangular systems !> A *x = s*b or A**T*x = s*b !> with scaling to prevent overflow, where A is an upper or lower @@ -50047,8 +50049,6 @@ module stdlib_linalg_lapack_q !> unscaled problem will not cause overflow, the Level 2 BLAS routine !> DTPSV 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. - - pure subroutine stdlib_qlatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50455,6 +50455,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlatps + + pure subroutine stdlib_qlatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) !> DLATRD: reduces NB rows and columns of a real symmetric matrix A to !> symmetric tridiagonal form by an orthogonal similarity !> transformation Q**T * A * Q, and returns the matrices V and W which are @@ -50464,8 +50466,6 @@ module stdlib_linalg_lapack_q !> if UPLO = 'L', DLATRD reduces the first NB rows and columns of a !> matrix, of which the lower triangle is supplied. !> This is an auxiliary routine called by DSYTRD. - - pure subroutine stdlib_qlatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50557,6 +50557,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlatrd + + pure subroutine stdlib_qlatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) !> DLATRS: solves one of the triangular systems !> A *x = s*b or A**T *x = s*b !> with scaling to prevent overflow. Here A is an upper or lower @@ -50567,8 +50569,6 @@ module stdlib_linalg_lapack_q !> overflow, the Level 2 BLAS routine DTRSV 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. - - pure subroutine stdlib_qlatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50958,12 +50958,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlatrs + + pure subroutine stdlib_qlatrz( m, n, l, a, lda, tau, work ) !> DLATRZ: factors the M-by-(M+L) real upper trapezoidal matrix !> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z, by means !> of orthogonal transformations. Z is an (M+L)-by-(M+L) orthogonal !> matrix and, R and A1 are M-by-M upper triangular matrices. - - pure subroutine stdlib_qlatrz( m, n, l, a, lda, tau, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50998,6 +50998,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlatrz + + pure subroutine stdlib_qlatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) !> DLATSQR: computes a blocked Tall-Skinny QR factorization of !> a real M-by-N matrix A for M >= N: !> A = Q * ( R ), @@ -51009,8 +51011,6 @@ module stdlib_linalg_lapack_q !> R is an upper-triangular N-by-N matrix, stored on exit in !> the elements on and above the diagonal of the array A. !> 0 is a (M-N)-by-N zero matrix, and is not stored. - - pure subroutine stdlib_qlatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -51083,6 +51083,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlatsqr + + pure subroutine stdlib_qlauu2( uplo, n, a, lda, info ) !> DLAUU2: computes the product U * U**T or L**T * L, where the triangular !> factor U or L is stored in the upper or lower triangular part of !> the array A. @@ -51091,8 +51093,6 @@ module stdlib_linalg_lapack_q !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, !> overwriting the factor L in A. !> This is the unblocked form of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_qlauu2( uplo, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51155,6 +51155,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlauu2 + + pure subroutine stdlib_qlauum( uplo, n, a, lda, info ) !> DLAUUM: computes the product U * U**T or L**T * L, where the triangular !> factor U or L is stored in the upper or lower triangular part of !> the array A. @@ -51163,8 +51165,6 @@ module stdlib_linalg_lapack_q !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, !> overwriting the factor L in A. !> This is the blocked form of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_qlauum( uplo, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51238,13 +51238,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlauum + + pure subroutine stdlib_qopgtr( uplo, n, ap, tau, q, ldq, work, info ) !> DOPGTR: generates a real orthogonal matrix Q which is defined as the !> product of n-1 elementary reflectors H(i) of order n, as returned by !> DSPTRD using packed storage: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - - pure subroutine stdlib_qopgtr( uplo, n, ap, tau, q, ldq, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51325,6 +51325,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qopgtr + + pure subroutine stdlib_qopmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) !> DOPMTR: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -51335,8 +51337,6 @@ module stdlib_linalg_lapack_q !> storage: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - - pure subroutine stdlib_qopmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51472,6 +51472,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qopmtr + + subroutine stdlib_qorbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & !> DORBDB: simultaneously bidiagonalizes the blocks of an M-by-M !> partitioned orthogonal matrix X: !> [ B11 | B12 0 0 ] @@ -51488,8 +51490,6 @@ module stdlib_linalg_lapack_q !> represented implicitly by Householder vectors. !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_qorbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51800,6 +51800,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorbdb + + subroutine stdlib_qorbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & !> DORBDB1: simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] @@ -51815,8 +51817,6 @@ module stdlib_linalg_lapack_q !> Householder vectors. !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by !> angles THETA, PHI. - - subroutine stdlib_qorbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51903,6 +51903,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorbdb1 + + subroutine stdlib_qorbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & !> DORBDB2: simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] @@ -51918,8 +51920,6 @@ module stdlib_linalg_lapack_q !> Householder vectors. !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by !> angles THETA, PHI. - - subroutine stdlib_qorbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52016,6 +52016,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorbdb2 + + subroutine stdlib_qorbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & !> DORBDB3: simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] @@ -52031,8 +52033,6 @@ module stdlib_linalg_lapack_q !> Householder vectors. !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_qorbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52128,6 +52128,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorbdb3 + + subroutine stdlib_qorbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & !> DORBDB4: simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] @@ -52143,8 +52145,6 @@ module stdlib_linalg_lapack_q !> Householder vectors. !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_qorbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52270,6 +52270,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorbdb4 + + pure subroutine stdlib_qorbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & !> DORBDB5: orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] @@ -52281,8 +52283,6 @@ module stdlib_linalg_lapack_q !> criterion, then some other vector from the orthogonal complement !> is returned. This vector is chosen in an arbitrary but deterministic !> way. - - pure subroutine stdlib_qorbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52369,6 +52369,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorbdb5 + + pure subroutine stdlib_qorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & !> DORBDB6: orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] @@ -52378,8 +52380,6 @@ module stdlib_linalg_lapack_q !> The columns of Q must be orthonormal. !> If the projection is zero according to Kahan's "twice is enough" !> criterion, then the zero vector is returned. - - pure subroutine stdlib_qorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52497,6 +52497,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorbdb6 + + recursive subroutine stdlib_qorcsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & !> DORCSD: computes the CS decomposition of an M-by-M partitioned !> orthogonal matrix X: !> [ I 0 0 | 0 0 0 ] @@ -52510,8 +52512,6 @@ module stdlib_linalg_lapack_q !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in !> which R = MIN(P,M-P,Q,M-Q). - - recursive subroutine stdlib_qorcsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, ldv1t, v2t,ldv2t, & work, lwork, iwork, info ) ! -- lapack computational routine -- @@ -52772,6 +52772,8 @@ module stdlib_linalg_lapack_q ! end stdlib_qorcsd end subroutine stdlib_qorcsd + + subroutine stdlib_qorcsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & !> DORCSD2BY1: computes the CS decomposition of an M-by-Q matrix X with !> orthonormal columns that has been partitioned into a 2-by-1 block !> structure: @@ -52787,8 +52789,6 @@ module stdlib_linalg_lapack_q !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). - - subroutine stdlib_qorcsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, iwork, info ) ! -- lapack computational routine (3.5.0_qp) -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53187,13 +53187,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorcsd2by1 + + pure subroutine stdlib_qorg2l( m, n, k, a, lda, tau, work, info ) !> DORG2L: generates an m by n real matrix Q with orthonormal columns, !> which is defined as the last n columns of a product of k elementary !> reflectors of order m !> Q = H(k) . . . H(2) H(1) !> as returned by DGEQLF. - - pure subroutine stdlib_qorg2l( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53251,13 +53251,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorg2l + + pure subroutine stdlib_qorg2r( m, n, k, a, lda, tau, work, info ) !> DORG2R: generates an m by n real matrix Q with orthonormal columns, !> which is defined as the first n columns of a product of k elementary !> reflectors of order m !> Q = H(1) H(2) . . . H(k) !> as returned by DGEQRF. - - pure subroutine stdlib_qorg2r( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53316,6 +53316,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorg2r + + pure subroutine stdlib_qorgbr( vect, m, n, k, a, lda, tau, work, lwork, info ) !> DORGBR: generates one of the real orthogonal matrices Q or P**T !> determined by DGEBRD when reducing a real matrix A to bidiagonal !> form: A = Q * B * P**T. Q and P**T are defined as products of @@ -53332,8 +53334,6 @@ module stdlib_linalg_lapack_q !> rows of P**T, where n >= m >= k; !> if k >= n, P**T = G(n-1) . . . G(2) G(1) and DORGBR returns P**T as !> an N-by-N matrix. - - pure subroutine stdlib_qorgbr( vect, m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53465,12 +53465,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgbr + + pure subroutine stdlib_qorghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) !> DORGHR: generates a real orthogonal matrix Q which is defined as the !> product of IHI-ILO elementary reflectors of order N, as returned by !> DGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - - pure subroutine stdlib_qorghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53555,13 +53555,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorghr + + pure subroutine stdlib_qorgl2( m, n, k, a, lda, tau, work, info ) !> DORGL2: generates an m by n real matrix Q with orthonormal rows, !> which is defined as the first m rows of a product of k elementary !> reflectors of order n !> Q = H(k) . . . H(2) H(1) !> as returned by DGELQF. - - pure subroutine stdlib_qorgl2( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53624,13 +53624,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgl2 + + pure subroutine stdlib_qorglq( m, n, k, a, lda, tau, work, lwork, info ) !> DORGLQ: generates an M-by-N real matrix Q with orthonormal rows, !> which is defined as the first M rows of a product of K elementary !> reflectors of order N !> Q = H(k) . . . H(2) H(1) !> as returned by DGELQF. - - pure subroutine stdlib_qorglq( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53740,13 +53740,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorglq + + pure subroutine stdlib_qorgql( m, n, k, a, lda, tau, work, lwork, info ) !> DORGQL: generates an M-by-N real matrix Q with orthonormal columns, !> which is defined as the last N columns of a product of K elementary !> reflectors of order M !> Q = H(k) . . . H(2) H(1) !> as returned by DGEQLF. - - pure subroutine stdlib_qorgql( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53861,13 +53861,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgql + + pure subroutine stdlib_qorgqr( m, n, k, a, lda, tau, work, lwork, info ) !> DORGQR: generates an M-by-N real matrix Q with orthonormal columns, !> which is defined as the first N columns of a product of K elementary !> reflectors of order M !> Q = H(1) H(2) . . . H(k) !> as returned by DGEQRF. - - pure subroutine stdlib_qorgqr( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53977,13 +53977,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgqr + + pure subroutine stdlib_qorgr2( m, n, k, a, lda, tau, work, info ) !> DORGR2: generates an m by n real matrix Q with orthonormal rows, !> which is defined as the last m rows of a product of k elementary !> reflectors of order n !> Q = H(1) H(2) . . . H(k) !> as returned by DGERQF. - - pure subroutine stdlib_qorgr2( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54043,13 +54043,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgr2 + + pure subroutine stdlib_qorgrq( m, n, k, a, lda, tau, work, lwork, info ) !> DORGRQ: generates an M-by-N real matrix Q with orthonormal rows, !> which is defined as the last M rows of a product of K elementary !> reflectors of order N !> Q = H(1) H(2) . . . H(k) !> as returned by DGERQF. - - pure subroutine stdlib_qorgrq( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54164,13 +54164,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgrq + + pure subroutine stdlib_qorgtr( uplo, n, a, lda, tau, work, lwork, info ) !> DORGTR: generates a real orthogonal matrix Q which is defined as the !> product of n-1 elementary reflectors of order N, as returned by !> DSYTRD: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - - pure subroutine stdlib_qorgtr( uplo, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54265,13 +54265,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgtr + + pure subroutine stdlib_qorgtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) !> DORGTSQR: generates an M-by-N real matrix Q_out with orthonormal columns, !> which are the first N columns of a product of real orthogonal !> matrices of order M which are returned by DLATSQR !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). !> See the documentation for DLATSQR. - - pure subroutine stdlib_qorgtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54363,6 +54363,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgtsqr + + pure subroutine stdlib_qorgtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) !> DORGTSQR_ROW: generates an M-by-N real matrix Q_out with !> orthonormal columns from the output of DLATSQR. These N orthonormal !> columns are the first N columns of a product of complex unitary @@ -54378,8 +54380,6 @@ module stdlib_linalg_lapack_q !> starting in the bottom row block and continues to the top row block !> (hence _ROW in the routine name). This sweep is in reverse order of !> the order in which DLATSQR generates the output blocks. - - pure subroutine stdlib_qorgtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54506,6 +54506,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgtsqr_row + + pure subroutine stdlib_qorhr_col( m, n, nb, a, lda, t, ldt, d, info ) !> DORHR_COL: takes an M-by-N real matrix Q_in with orthonormal columns !> as input, stored in A, and performs Householder Reconstruction (HR), !> i.e. reconstructs Householder vectors V(i) implicitly representing @@ -54515,8 +54517,6 @@ module stdlib_linalg_lapack_q !> stored in A on output, and the diagonal entries of S are stored in D. !> Block reflectors are also returned in T !> (same output format as DGEQRT). - - pure subroutine stdlib_qorhr_col( m, n, nb, a, lda, t, ldt, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54825,6 +54825,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorm22 + + pure subroutine stdlib_qorm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) !> DORM2L: overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T * C if SIDE = 'L' and TRANS = 'T', or @@ -54835,8 +54837,6 @@ module stdlib_linalg_lapack_q !> Q = H(k) . . . H(2) H(1) !> as returned by DGEQLF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_qorm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54919,6 +54919,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorm2l + + pure subroutine stdlib_qorm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) !> DORM2R: overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T* C if SIDE = 'L' and TRANS = 'T', or @@ -54929,8 +54931,6 @@ module stdlib_linalg_lapack_q !> Q = H(1) H(2) . . . H(k) !> as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_qorm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55018,6 +55018,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorm2r + + pure subroutine stdlib_qormbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & !> If VECT = 'Q', DORMBR: overwrites the general real M-by-N matrix C !> with !> SIDE = 'L' SIDE = 'R' @@ -55040,8 +55042,6 @@ module stdlib_linalg_lapack_q !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: !> if k < nq, P = G(1) G(2) . . . G(k); !> if k >= nq, P = G(1) G(2) . . . G(nq-1). - - pure subroutine stdlib_qormbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55176,6 +55176,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormbr + + pure subroutine stdlib_qormhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & !> DORMHR: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -55184,8 +55186,6 @@ module stdlib_linalg_lapack_q !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of !> IHI-ILO elementary reflectors, as returned by DGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - - pure subroutine stdlib_qormhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55275,6 +55275,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormhr + + pure subroutine stdlib_qorml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) !> DORML2: overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T* C if SIDE = 'L' and TRANS = 'T', or @@ -55285,8 +55287,6 @@ module stdlib_linalg_lapack_q !> Q = H(k) . . . H(2) H(1) !> as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_qorml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55374,6 +55374,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorml2 + + pure subroutine stdlib_qormlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) !> DORMLQ: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -55383,8 +55385,6 @@ module stdlib_linalg_lapack_q !> Q = H(k) . . . H(2) H(1) !> as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_qormlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55517,6 +55517,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormlq + + pure subroutine stdlib_qormql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) !> DORMQL: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -55526,8 +55528,6 @@ module stdlib_linalg_lapack_q !> Q = H(k) . . . H(2) H(1) !> as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_qormql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55654,6 +55654,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormql + + pure subroutine stdlib_qormqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) !> DORMQR: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -55663,8 +55665,6 @@ module stdlib_linalg_lapack_q !> Q = H(1) H(2) . . . H(k) !> as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_qormqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55791,6 +55791,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormqr + + pure subroutine stdlib_qormr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) !> DORMR2: overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T* C if SIDE = 'L' and TRANS = 'T', or @@ -55801,8 +55803,6 @@ module stdlib_linalg_lapack_q !> Q = H(1) H(2) . . . H(k) !> as returned by DGERQF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_qormr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55885,6 +55885,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormr2 + + pure subroutine stdlib_qormr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) !> DORMR3: overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T* C if SIDE = 'L' and TRANS = 'C', or @@ -55895,8 +55897,6 @@ module stdlib_linalg_lapack_q !> Q = H(1) H(2) . . . H(k) !> as returned by DTZRZF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_qormr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55984,6 +55984,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormr3 + + pure subroutine stdlib_qormrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) !> DORMRQ: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -55993,8 +55995,6 @@ module stdlib_linalg_lapack_q !> Q = H(1) H(2) . . . H(k) !> as returned by DGERQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_qormrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56127,6 +56127,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormrq + + pure subroutine stdlib_qormrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & !> DORMRZ: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -56136,8 +56138,6 @@ module stdlib_linalg_lapack_q !> Q = H(1) H(2) . . . H(k) !> as returned by DTZRZF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_qormrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56280,6 +56280,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormrz + + pure subroutine stdlib_qormtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & !> DORMTR: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -56289,8 +56291,6 @@ module stdlib_linalg_lapack_q !> nq-1 elementary reflectors, as returned by DSYTRD: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - - pure subroutine stdlib_qormtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56396,13 +56396,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormtr + + pure subroutine stdlib_qpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,iwork, info ) !> DPBCON: estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric positive definite band matrix using the !> Cholesky factorization A = U**T*U or A = L*L**T computed by DPBTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_qpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56494,6 +56494,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbcon + + pure subroutine stdlib_qpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) !> DPBEQU: computes row and column scalings intended to equilibrate a !> symmetric positive definite band matrix A and reduce its condition !> number (with respect to the two-norm). S contains the scale factors, @@ -56502,8 +56504,6 @@ module stdlib_linalg_lapack_q !> choice of S puts the condition number of B within a factor N of the !> smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_qpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56581,12 +56581,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbequ + + pure subroutine stdlib_qpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & !> DPBRFS: improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric positive definite !> and banded, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_qpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56775,6 +56775,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbrfs + + pure subroutine stdlib_qpbstf( uplo, n, kd, ab, ldab, info ) !> DPBSTF: computes a split Cholesky factorization of a real !> symmetric positive definite band matrix A. !> This routine is designed to be used in conjunction with DSBGST. @@ -56784,8 +56786,6 @@ module stdlib_linalg_lapack_q !> ( M L ) !> where U is upper triangular of order m = (n+kd)/2, and L is lower !> triangular of order n-m. - - pure subroutine stdlib_qpbstf( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56893,6 +56893,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbstf + + pure subroutine stdlib_qpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) !> DPBSV: computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite band matrix and X @@ -56904,8 +56906,6 @@ module stdlib_linalg_lapack_q !> triangular band matrix, with the same number of superdiagonals or !> subdiagonals as A. The factored form of A is then used to solve the !> system of equations A * X = B. - - pure subroutine stdlib_qpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56947,6 +56947,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbsv + + subroutine stdlib_qpbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & !> DPBSVX: uses the Cholesky factorization A = U**T*U or A = L*L**T to !> compute the solution to a real system of linear equations !> A * X = B, @@ -56954,8 +56956,6 @@ module stdlib_linalg_lapack_q !> and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_qpbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57103,6 +57103,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbsvx + + pure subroutine stdlib_qpbtf2( uplo, n, kd, ab, ldab, info ) !> DPBTF2: computes the Cholesky factorization of a real symmetric !> positive definite band matrix A. !> The factorization has the form @@ -57111,8 +57113,6 @@ module stdlib_linalg_lapack_q !> where U is an upper triangular matrix, U**T is the transpose of U, and !> L is lower triangular. !> This is the unblocked version of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_qpbtf2( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57190,14 +57190,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbtf2 + + pure subroutine stdlib_qpbtrf( uplo, n, kd, ab, ldab, info ) !> DPBTRF: computes the Cholesky factorization of a real symmetric !> positive definite band matrix A. !> The factorization has the form !> A = U**T * U, if UPLO = 'U', or !> A = L * L**T, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. - - pure subroutine stdlib_qpbtrf( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57389,11 +57389,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbtrf + + pure subroutine stdlib_qpbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) !> DPBTRS: solves a system of linear equations A*X = B with a symmetric !> positive definite band matrix A using the Cholesky factorization !> A = U**T*U or A = L*L**T computed by DPBTRF. - - pure subroutine stdlib_qpbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57457,6 +57457,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbtrs + + pure subroutine stdlib_qpftrf( transr, uplo, n, a, info ) !> DPFTRF: computes the Cholesky factorization of a real symmetric !> positive definite matrix A. !> The factorization has the form @@ -57464,8 +57466,6 @@ module stdlib_linalg_lapack_q !> A = L * L**T, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the block version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_qpftrf( transr, uplo, n, a, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57632,11 +57632,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpftrf + + pure subroutine stdlib_qpftri( transr, uplo, n, a, info ) !> DPFTRI: computes the inverse of a (real) symmetric positive definite !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T !> computed by DPFTRF. - - pure subroutine stdlib_qpftri( transr, uplo, n, a, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57790,11 +57790,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpftri + + pure subroutine stdlib_qpftrs( transr, uplo, n, nrhs, a, b, ldb, info ) !> DPFTRS: solves a system of linear equations A*X = B with a symmetric !> positive definite matrix A using the Cholesky factorization !> A = U**T*U or A = L*L**T computed by DPFTRF. - - pure subroutine stdlib_qpftrs( transr, uplo, n, nrhs, a, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57844,13 +57844,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpftrs + + pure subroutine stdlib_qpocon( uplo, n, a, lda, anorm, rcond, work, iwork,info ) !> DPOCON: estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric positive definite matrix using the !> Cholesky factorization A = U**T*U or A = L*L**T computed by DPOTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_qpocon( uplo, n, a, lda, anorm, rcond, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57939,6 +57939,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpocon + + pure subroutine stdlib_qpoequ( n, a, lda, s, scond, amax, info ) !> DPOEQU: computes row and column scalings intended to equilibrate a !> symmetric positive definite matrix A and reduce its condition number !> (with respect to the two-norm). S contains the scale factors, @@ -57947,8 +57949,6 @@ module stdlib_linalg_lapack_q !> choice of S puts the condition number of B within a factor N of the !> smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_qpoequ( n, a, lda, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58013,6 +58013,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpoequ + + pure subroutine stdlib_qpoequb( n, a, lda, s, scond, amax, info ) !> DPOEQUB: computes row and column scalings intended to equilibrate a !> symmetric positive definite matrix A and reduce its condition number !> (with respect to the two-norm). S contains the scale factors, @@ -58026,8 +58028,6 @@ module stdlib_linalg_lapack_q !> these factors introduces no additional rounding errors. However, the !> scaled diagonal entries are no longer approximately 1 but lie !> between sqrt(radix) and 1/sqrt(radix). - - pure subroutine stdlib_qpoequb( n, a, lda, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58095,12 +58095,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpoequb + + pure subroutine stdlib_qporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & !> DPORFS: improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric positive definite, !> and provides error bounds and backward error estimates for the !> solution. - - pure subroutine stdlib_qporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58284,6 +58284,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qporfs + + pure subroutine stdlib_qposv( uplo, n, nrhs, a, lda, b, ldb, info ) !> DPOSV: computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite matrix and X and B @@ -58294,8 +58296,6 @@ module stdlib_linalg_lapack_q !> where U is an upper triangular matrix and L is a lower triangular !> matrix. The factored form of A is then used to solve the system of !> equations A * X = B. - - pure subroutine stdlib_qposv( uplo, n, nrhs, a, lda, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58335,6 +58335,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qposv + + subroutine stdlib_qposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & !> DPOSVX: uses the Cholesky factorization A = U**T*U or A = L*L**T to !> compute the solution to a real system of linear equations !> A * X = B, @@ -58342,8 +58344,6 @@ module stdlib_linalg_lapack_q !> are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_qposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & rcond, ferr, berr, work,iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58478,6 +58478,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qposvx + + pure subroutine stdlib_qpotf2( uplo, n, a, lda, info ) !> DPOTF2: computes the Cholesky factorization of a real symmetric !> positive definite matrix A. !> The factorization has the form @@ -58485,8 +58487,6 @@ module stdlib_linalg_lapack_q !> A = L * L**T, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the unblocked version of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_qpotf2( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58565,6 +58565,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpotf2 + + pure subroutine stdlib_qpotrf( uplo, n, a, lda, info ) !> DPOTRF: computes the Cholesky factorization of a real symmetric !> positive definite matrix A. !> The factorization has the form @@ -58572,8 +58574,6 @@ module stdlib_linalg_lapack_q !> A = L * L**T, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the block version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_qpotrf( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58659,6 +58659,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpotrf + + pure recursive subroutine stdlib_qpotrf2( uplo, n, a, lda, info ) !> DPOTRF2: computes the Cholesky factorization of a real symmetric !> positive definite matrix A using the recursive algorithm. !> The factorization has the form @@ -58672,8 +58674,6 @@ module stdlib_linalg_lapack_q !> [ A21 | A22 ] n2 = n-n1 !> The subroutine calls itself to factor A11. Update and scale A21 !> or A12, update A22 then calls itself to factor A22. - - pure recursive subroutine stdlib_qpotrf2( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58757,11 +58757,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpotrf2 + + pure subroutine stdlib_qpotri( uplo, n, a, lda, info ) !> DPOTRI: computes the inverse of a real symmetric positive definite !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T !> computed by DPOTRF. - - pure subroutine stdlib_qpotri( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58798,11 +58798,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpotri + + pure subroutine stdlib_qpotrs( uplo, n, nrhs, a, lda, b, ldb, info ) !> DPOTRS: solves a system of linear equations A*X = B with a symmetric !> positive definite matrix A using the Cholesky factorization !> A = U**T*U or A = L*L**T computed by DPOTRF. - - pure subroutine stdlib_qpotrs( uplo, n, nrhs, a, lda, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58860,14 +58860,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpotrs + + pure subroutine stdlib_qppcon( uplo, n, ap, anorm, rcond, work, iwork, info ) !> DPPCON: estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric positive definite packed matrix using !> the Cholesky factorization A = U**T*U or A = L*L**T computed by !> DPPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_qppcon( uplo, n, ap, anorm, rcond, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58954,6 +58954,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qppcon + + pure subroutine stdlib_qppequ( uplo, n, ap, s, scond, amax, info ) !> DPPEQU: computes row and column scalings intended to equilibrate a !> symmetric positive definite matrix A in packed storage and reduce !> its condition number (with respect to the two-norm). S contains the @@ -58962,8 +58964,6 @@ module stdlib_linalg_lapack_q !> This choice of S puts the condition number of B within a factor N of !> the smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_qppequ( uplo, n, ap, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59047,12 +59047,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qppequ + + pure subroutine stdlib_qpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & !> DPPRFS: improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric positive definite !> and packed, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_qpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59239,6 +59239,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpprfs + + pure subroutine stdlib_qppsv( uplo, n, nrhs, ap, b, ldb, info ) !> DPPSV: computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite matrix stored in @@ -59249,8 +59251,6 @@ module stdlib_linalg_lapack_q !> where U is an upper triangular matrix and L is a lower triangular !> matrix. The factored form of A is then used to solve the system of !> equations A * X = B. - - pure subroutine stdlib_qppsv( uplo, n, nrhs, ap, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59288,6 +59288,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qppsv + + subroutine stdlib_qppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& !> DPPSVX: uses the Cholesky factorization A = U**T*U or A = L*L**T to !> compute the solution to a real system of linear equations !> A * X = B, @@ -59295,8 +59297,6 @@ module stdlib_linalg_lapack_q !> packed format and X and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_qppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59427,14 +59427,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qppsvx + + pure subroutine stdlib_qpptrf( uplo, n, ap, info ) !> DPPTRF: computes the Cholesky factorization of a real symmetric !> positive definite matrix A stored in packed format. !> The factorization has the form !> A = U**T * U, if UPLO = 'U', or !> A = L * L**T, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. - - pure subroutine stdlib_qpptrf( uplo, n, ap, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59512,11 +59512,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpptrf + + pure subroutine stdlib_qpptri( uplo, n, ap, info ) !> DPPTRI: computes the inverse of a real symmetric positive definite !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T !> computed by DPPTRF. - - pure subroutine stdlib_qpptri( uplo, n, ap, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59574,11 +59574,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpptri + + pure subroutine stdlib_qpptrs( uplo, n, nrhs, ap, b, ldb, info ) !> DPPTRS: solves a system of linear equations A*X = B with a symmetric !> positive definite matrix A in packed storage using the Cholesky !> factorization A = U**T*U or A = L*L**T computed by DPPTRF. - - pure subroutine stdlib_qpptrs( uplo, n, nrhs, ap, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59636,6 +59636,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpptrs + + pure subroutine stdlib_qpstf2( uplo, n, a, lda, piv, rank, tol, work, info ) !> DPSTF2: computes the Cholesky factorization with complete !> pivoting of a real symmetric positive semidefinite matrix A. !> The factorization has the form @@ -59645,8 +59647,6 @@ module stdlib_linalg_lapack_q !> P is stored as vector PIV. !> This algorithm does not attempt to check that A is positive !> semidefinite. This version of the algorithm calls level 2 BLAS. - - pure subroutine stdlib_qpstf2( uplo, n, a, lda, piv, rank, tol, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59815,6 +59815,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpstf2 + + pure subroutine stdlib_qpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) !> DPSTRF: computes the Cholesky factorization with complete !> pivoting of a real symmetric positive semidefinite matrix A. !> The factorization has the form @@ -59824,8 +59826,6 @@ module stdlib_linalg_lapack_q !> P is stored as vector PIV. !> This algorithm does not attempt to check that A is positive !> semidefinite. This version of the algorithm calls level 3 BLAS. - - pure subroutine stdlib_qpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60026,6 +60026,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpstrf + + pure subroutine stdlib_qptcon( n, d, e, anorm, rcond, work, info ) !> DPTCON: computes the reciprocal of the condition number (in the !> 1-norm) of a real symmetric positive definite tridiagonal matrix !> using the factorization A = L*D*L**T or A = U**T*D*U computed by @@ -60033,8 +60035,6 @@ module stdlib_linalg_lapack_q !> Norm(inv(A)) is computed by a direct method, and the reciprocal of !> the condition number is computed as !> RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_qptcon( n, d, e, anorm, rcond, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60099,6 +60099,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qptcon + + pure subroutine stdlib_qpteqr( compz, n, d, e, z, ldz, work, info ) !> DPTEQR: computes all eigenvalues and, optionally, eigenvectors of a !> symmetric positive definite tridiagonal matrix by first factoring the !> matrix using DPTTRF, and then calling DBDSQR to compute the singular @@ -60114,8 +60116,6 @@ module stdlib_linalg_lapack_q !> form, however, may preclude the possibility of obtaining high !> relative accuracy in the small eigenvalues of the original matrix, if !> these eigenvalues range over many orders of magnitude.) - - pure subroutine stdlib_qpteqr( compz, n, d, e, z, ldz, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60193,12 +60193,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpteqr + + pure subroutine stdlib_qptrfs( n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr,berr, work, info ) !> DPTRFS: improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric positive definite !> and tridiagonal, and provides error bounds and backward error !> estimates for the solution. - - pure subroutine stdlib_qptrfs( n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr,berr, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60365,13 +60365,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qptrfs + + pure subroutine stdlib_qptsv( n, nrhs, d, e, b, ldb, info ) !> DPTSV: computes the solution to a real system of linear equations !> A*X = B, where A is an N-by-N symmetric positive definite tridiagonal !> matrix, and X and B are N-by-NRHS matrices. !> A is factored as A = L*D*L**T, and the factored form of A is then !> used to solve the system of equations. - - pure subroutine stdlib_qptsv( n, nrhs, d, e, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60406,14 +60406,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qptsv + + pure subroutine stdlib_qptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& !> DPTSVX: uses the factorization A = L*D*L**T to compute the solution !> to a real system of linear equations A*X = B, where A is an N-by-N !> symmetric positive definite tridiagonal matrix and X and B are !> N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - pure subroutine stdlib_qptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& work, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60480,11 +60480,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qptsvx + + pure subroutine stdlib_qpttrf( n, d, e, info ) !> DPTTRF: computes the L*D*L**T factorization of a real symmetric !> positive definite tridiagonal matrix A. The factorization may also !> be regarded as having the form A = U**T*D*U. - - pure subroutine stdlib_qpttrf( n, d, e, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60563,14 +60563,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpttrf + + pure subroutine stdlib_qpttrs( n, nrhs, d, e, b, ldb, info ) !> DPTTRS: solves a tridiagonal system of the form !> A * X = B !> using the L*D*L**T factorization of A computed by DPTTRF. D is a !> diagonal matrix specified in the vector D, L is a unit bidiagonal !> matrix whose subdiagonal is specified in the vector E, and X and B !> are N by NRHS matrices. - - pure subroutine stdlib_qpttrs( n, nrhs, d, e, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60618,14 +60618,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpttrs + + pure subroutine stdlib_qptts2( n, nrhs, d, e, b, ldb ) !> DPTTS2: solves a tridiagonal system of the form !> A * X = B !> using the L*D*L**T factorization of A computed by DPTTRF. D is a !> diagonal matrix specified in the vector D, L is a unit bidiagonal !> matrix whose subdiagonal is specified in the vector E, and X and B !> are N by NRHS matrices. - - pure subroutine stdlib_qptts2( n, nrhs, d, e, b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60659,11 +60659,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qptts2 + + pure subroutine stdlib_qrscl( n, sa, sx, incx ) !> DRSCL: multiplies an n-element real vector x by the real scalar 1/a. !> This is done without overflow or underflow as long as !> the final result x/a does not overflow or underflow. - - pure subroutine stdlib_qrscl( n, sa, sx, incx ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60713,10 +60713,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qrscl - !> DSB2ST_KERNELS: is an internal routine used by the DSYTRD_SB2ST - !> subroutine. pure subroutine stdlib_qsb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, lda, & + !> DSB2ST_KERNELS: is an internal routine used by the DSYTRD_SB2ST + !> subroutine. v, tau, ldvt, work) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60858,10 +60858,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsb2st_kernels - !> DSBEV: computes all the eigenvalues and, optionally, eigenvectors of - !> a real symmetric band matrix A. subroutine stdlib_qsbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,info ) + !> DSBEV: computes all the eigenvalues and, optionally, eigenvectors of + !> a real symmetric band matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60960,6 +60960,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsbev + + subroutine stdlib_qsbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, iwork, liwork, & !> DSBEVD: computes all the eigenvalues and, optionally, eigenvectors of !> a real symmetric band matrix A. If eigenvectors are desired, it uses !> a divide and conquer algorithm. @@ -60969,8 +60971,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qsbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, iwork, liwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61092,12 +61092,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsbevd + + subroutine stdlib_qsbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & !> DSBEVX: computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric band matrix A. Eigenvalues and eigenvectors can !> be selected by specifying either a range of values or a range of !> indices for the desired eigenvalues. - - subroutine stdlib_qsbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & m, w, z, ldz, work, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61318,6 +61318,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsbevx + + pure subroutine stdlib_qsbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, info ) !> DSBGST: reduces a real symmetric-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. @@ -61325,8 +61327,6 @@ module stdlib_linalg_lapack_q !> split Cholesky factorization. A is overwritten by C = X**T*A*X, where !> X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the !> bandwidth of A. - - pure subroutine stdlib_qsbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62231,12 +62231,12 @@ module stdlib_linalg_lapack_q go to 490 end subroutine stdlib_qsbgst + + pure subroutine stdlib_qsbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & !> DSBGV: computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-definite banded eigenproblem, of !> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric !> and banded, and B is also positive definite. - - pure subroutine stdlib_qsbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62309,6 +62309,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsbgv + + pure subroutine stdlib_qsbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & !> DSBGVD: computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-definite banded eigenproblem, of the !> form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric and @@ -62320,8 +62322,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qsbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & lwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62426,14 +62426,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsbgvd + + pure subroutine stdlib_qsbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & !> DSBGVX: computes selected eigenvalues, and optionally, eigenvectors !> of a real generalized symmetric-definite banded eigenproblem, of !> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric !> and banded, and B is also positive definite. Eigenvalues and !> eigenvectors can be selected by specifying either all eigenvalues, !> a range of values or a range of indices for the desired eigenvalues. - - pure subroutine stdlib_qsbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & vu, il, iu, abstol, m, w, z,ldz, work, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62611,11 +62611,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsbgvx + + pure subroutine stdlib_qsbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) !> DSBTRD: reduces a real symmetric band matrix A to symmetric !> tridiagonal form T by an orthogonal similarity transformation: !> Q**T * A * Q = T. - - pure subroutine stdlib_qsbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62942,6 +62942,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsbtrd + + pure subroutine stdlib_qsfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) !> Level 3 BLAS like routine for C in RFP Format. !> DSFRK: performs one of the symmetric rank--k operations !> C := alpha*A*A**T + beta*C, @@ -62950,8 +62952,6 @@ module stdlib_linalg_lapack_q !> where alpha and beta are real scalars, C is an n--by--n symmetric !> matrix and A is an n--by--k matrix in the first case and a k--by--n !> matrix in the second case. - - pure subroutine stdlib_qsfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63198,6 +63198,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsfrk + + subroutine stdlib_qsgesv( n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work,swork, iter, info ) !> DSGESV: computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N matrix and X and B are N-by-NRHS matrices. @@ -63225,8 +63227,6 @@ module stdlib_linalg_lapack_q !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 !> respectively. - - subroutine stdlib_qsgesv( n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work,swork, iter, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63378,13 +63378,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsgesv + + pure subroutine stdlib_qspcon( uplo, n, ap, ipiv, anorm, rcond, work, iwork,info ) !> DSPCON: estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric packed matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by DSPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_qspcon( uplo, n, ap, ipiv, anorm, rcond, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63460,10 +63460,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspcon - !> DSPEV: computes all the eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A in packed storage. subroutine stdlib_qspev( jobz, uplo, n, ap, w, z, ldz, work, info ) + !> DSPEV: computes all the eigenvalues and, optionally, eigenvectors of a + !> real symmetric matrix A in packed storage. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63553,6 +63553,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspev + + subroutine stdlib_qspevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,iwork, liwork, info ) !> DSPEVD: computes all the eigenvalues and, optionally, eigenvectors !> of a real symmetric matrix A in packed storage. If eigenvectors are !> desired, it uses a divide and conquer algorithm. @@ -63562,8 +63564,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qspevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63678,12 +63678,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspevd + + subroutine stdlib_qspevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & !> DSPEVX: computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric matrix A in packed storage. Eigenvalues/vectors !> can be selected by specifying either a range of values or a range of !> indices for the desired eigenvalues. - - subroutine stdlib_qspevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & work, iwork, ifail,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63891,6 +63891,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspevx + + pure subroutine stdlib_qspgst( itype, uplo, n, ap, bp, info ) !> DSPGST: reduces a real symmetric-definite generalized eigenproblem !> to standard form, using packed storage. !> If ITYPE = 1, the problem is A*x = lambda*B*x, @@ -63898,8 +63900,6 @@ module stdlib_linalg_lapack_q !> 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**T or L**T*A*L. !> B must have been previously factorized as U**T*U or L*L**T by DPPTRF. - - pure subroutine stdlib_qspgst( itype, uplo, n, ap, bp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64013,13 +64013,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspgst + + subroutine stdlib_qspgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,info ) !> DSPGV: computes all the eigenvalues and, optionally, the eigenvectors !> of a real generalized symmetric-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 symmetric, stored in packed format, !> and B is also positive definite. - - subroutine stdlib_qspgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64097,6 +64097,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspgv + + subroutine stdlib_qspgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, iwork, liwork,& !> DSPGVD: computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-definite eigenproblem, of the form !> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and @@ -64109,8 +64111,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qspgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, iwork, liwork,& info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64221,6 +64221,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspgvd + + subroutine stdlib_qspgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & !> DSPGVX: computes selected eigenvalues, and optionally, eigenvectors !> of a real generalized symmetric-definite eigenproblem, of the form !> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A @@ -64228,8 +64230,6 @@ module stdlib_linalg_lapack_q !> is also positive definite. Eigenvalues and eigenvectors can be !> selected by specifying either a range of values or a range of indices !> for the desired eigenvalues. - - subroutine stdlib_qspgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & z, ldz, work, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64333,6 +64333,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspgvx + + subroutine stdlib_qsposv( uplo, n, nrhs, a, lda, b, ldb, x, ldx, work,swork, iter, info ) !> DSPOSV: computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite matrix and X and B @@ -64361,8 +64363,6 @@ module stdlib_linalg_lapack_q !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 !> respectively. - - subroutine stdlib_qsposv( uplo, n, nrhs, a, lda, b, ldb, x, ldx, work,swork, iter, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64512,12 +64512,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsposv + + pure subroutine stdlib_qsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& !> DSPRFS: improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric indefinite !> and packed, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_qsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64705,6 +64705,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsprfs + + pure subroutine stdlib_qspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) !> DSPSV: computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix stored in packed format and X @@ -64716,8 +64718,6 @@ module stdlib_linalg_lapack_q !> triangular matrices, D is symmetric 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. - - pure subroutine stdlib_qspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64756,14 +64756,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspsv + + subroutine stdlib_qspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & !> DSPSVX: uses the diagonal pivoting factorization A = U*D*U**T or !> A = L*D*L**T to compute the solution to a real system of linear !> equations A * X = B, where A is an N-by-N symmetric matrix stored !> in packed format and X and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_qspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64834,11 +64834,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspsvx + + pure subroutine stdlib_qsptrd( uplo, n, ap, d, e, tau, info ) !> DSPTRD: reduces a real symmetric matrix A stored in packed form to !> symmetric tridiagonal form T by an orthogonal similarity !> transformation: Q**T * A * Q = T. - - pure subroutine stdlib_qsptrd( uplo, n, ap, d, e, tau, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64931,14 +64931,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsptrd + + pure subroutine stdlib_qsptrf( uplo, n, ap, ipiv, info ) !> DSPTRF: computes the factorization of a real symmetric matrix A stored !> in packed format using the Bunch-Kaufman diagonal pivoting method: !> 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 symmetric and block diagonal with !> 1-by-1 and 2-by-2 diagonal blocks. - - pure subroutine stdlib_qsptrf( uplo, n, ap, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65254,11 +65254,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsptrf + + pure subroutine stdlib_qsptri( uplo, n, ap, ipiv, work, info ) !> DSPTRI: computes the inverse of a real symmetric indefinite matrix !> A in packed storage using the factorization A = U*D*U**T or !> A = L*D*L**T computed by DSPTRF. - - pure subroutine stdlib_qsptri( uplo, n, ap, ipiv, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65465,11 +65465,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsptri + + pure subroutine stdlib_qsptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) !> DSPTRS: solves a system of linear equations A*X = B with a real !> symmetric matrix A stored in packed format using the factorization !> A = U*D*U**T or A = L*D*L**T computed by DSPTRF. - - pure subroutine stdlib_qsptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65685,6 +65685,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsptrs + + pure subroutine stdlib_qstebz( range, order, n, vl, vu, il, iu, abstol, d, e,m, nsplit, w, & !> DSTEBZ: computes the eigenvalues of a symmetric tridiagonal !> matrix T. The user may ask for all eigenvalues, all eigenvalues !> in the half-open interval (VL, VU], or the IL-th through IU-th @@ -65695,8 +65697,6 @@ module stdlib_linalg_lapack_q !> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal !> Matrix", Report CS41, Computer Science Dept., Stanford !> University, July 21, 1966. - - pure subroutine stdlib_qstebz( range, order, n, vl, vu, il, iu, abstol, d, e,m, nsplit, w, & iblock, isplit, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66078,6 +66078,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstebz + + pure subroutine stdlib_qstedc( compz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) !> DSTEDC: computes all eigenvalues and, optionally, eigenvectors of a !> symmetric tridiagonal matrix using the divide and conquer method. !> The eigenvectors of a full or band real symmetric matrix can also be @@ -66089,8 +66091,6 @@ module stdlib_linalg_lapack_q !> 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 DLAED3 for details. - - pure subroutine stdlib_qstedc( compz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66304,6 +66304,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstedc + + pure subroutine stdlib_qstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & !> DSTEGR: computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has !> a well defined set of pairwise different real eigenvalues, the corresponding @@ -66320,8 +66322,6 @@ module stdlib_linalg_lapack_q !> NaNs. Normal execution may create these exceptiona values and hence !> may abort due to a floating point exception in environments which !> do not conform to the IEEE-754 standard. - - pure subroutine stdlib_qstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66346,13 +66346,13 @@ module stdlib_linalg_lapack_q tryrac, work, lwork,iwork, liwork, info ) end subroutine stdlib_qstegr + + pure subroutine stdlib_qstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & !> DSTEIN: computes the eigenvectors of a real symmetric tridiagonal !> matrix T corresponding to specified eigenvalues, using inverse !> iteration. !> The maximum number of iterations allowed for each eigenvector is !> specified by an internal parameter MAXITS (currently set to 5). - - pure subroutine stdlib_qstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66544,6 +66544,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstein + + pure subroutine stdlib_qstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & !> DSTEMR: computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has !> a well defined set of pairwise different real eigenvalues, the corresponding @@ -66589,8 +66591,6 @@ module stdlib_linalg_lapack_q !> floating-point standard in their handling of infinities and NaNs. !> This permits the use of efficient inner loops avoiding a check for !> zero divisors. - - pure subroutine stdlib_qstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66964,13 +66964,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstemr + + pure subroutine stdlib_qsteqr( compz, n, d, e, z, ldz, work, info ) !> DSTEQR: computes all eigenvalues and, optionally, eigenvectors of a !> symmetric tridiagonal matrix using the implicit QL or QR method. !> The eigenvectors of a full or band symmetric matrix can also be found !> if DSYTRD or DSPTRD or DSBTRD has been used to reduce this matrix to !> tridiagonal form. - - pure subroutine stdlib_qsteqr( compz, n, d, e, z, ldz, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67281,10 +67281,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsteqr - !> DSTERF: computes all eigenvalues of a symmetric tridiagonal matrix - !> using the Pal-Walker-Kahan variant of the QL or QR algorithm. pure subroutine stdlib_qsterf( n, d, e, info ) + !> DSTERF: computes all eigenvalues of a symmetric tridiagonal matrix + !> using the Pal-Walker-Kahan variant of the QL or QR algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67516,10 +67516,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsterf - !> DSTEV: computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric tridiagonal matrix A. pure subroutine stdlib_qstev( jobz, n, d, e, z, ldz, work, info ) + !> DSTEV: computes all eigenvalues and, optionally, eigenvectors of a + !> real symmetric tridiagonal matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67599,6 +67599,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstev + + pure subroutine stdlib_qstevd( jobz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) !> DSTEVD: computes all eigenvalues and, optionally, eigenvectors of a !> real symmetric tridiagonal matrix. If eigenvectors are desired, it !> uses a divide and conquer algorithm. @@ -67608,8 +67610,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qstevd( jobz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67704,6 +67704,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstevd + + pure subroutine stdlib_qstevr( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & !> DSTEVR: computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Eigenvalues and !> eigenvectors can be selected by specifying either a range of values @@ -67739,8 +67741,6 @@ module stdlib_linalg_lapack_q !> hence may abort due to a floating point exception in environments !> which do not handle NaNs and infinities in the ieee standard default !> manner. - - pure subroutine stdlib_qstevr( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & isuppz, work, lwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67954,12 +67954,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstevr + + pure subroutine stdlib_qstevx( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & !> DSTEVX: computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix A. Eigenvalues and !> eigenvectors can be selected by specifying either a range of values !> or a range of indices for the desired eigenvalues. - - pure subroutine stdlib_qstevx( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & work, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68148,13 +68148,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstevx + + pure subroutine stdlib_qsycon( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) !> DSYCON: estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by DSYTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_qsycon( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68231,13 +68231,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsycon + + pure subroutine stdlib_qsycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) !> DSYCON_ROOK: estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by DSYTRF_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))). - - pure subroutine stdlib_qsycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68314,11 +68314,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsycon_rook + + pure subroutine stdlib_qsyconv( uplo, way, n, a, lda, ipiv, e, info ) !> DSYCONV: convert A given by TRF into L and D and vice-versa. !> Get Non-diag elements of D (returned in workspace) and !> apply or reverse permutation done in TRF. - - pure subroutine stdlib_qsyconv( uplo, way, n, a, lda, ipiv, e, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -68519,6 +68519,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyconv + + pure subroutine stdlib_qsyconvf( uplo, way, n, a, lda, e, ipiv, info ) !> If parameter WAY = 'C': !> DSYCONVF: converts the factorization output format used in !> DSYTRF provided on entry in parameter A into the factorization @@ -68534,8 +68536,6 @@ module stdlib_linalg_lapack_q !> on exit in parameter A. It also converts in place details of !> the intechanges stored in IPIV from the format used in DSYTRF_RK !> (or DSYTRF_BK) into the format used in DSYTRF. - - pure subroutine stdlib_qsyconvf( uplo, way, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -68774,6 +68774,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyconvf + + pure subroutine stdlib_qsyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) !> If parameter WAY = 'C': !> DSYCONVF_ROOK: converts the factorization output format used in !> DSYTRF_ROOK provided on entry in parameter A into the factorization @@ -68787,8 +68789,6 @@ module stdlib_linalg_lapack_q !> the factorization output format used in DSYTRF_ROOK that is stored !> on exit in parameter A. IPIV format for DSYTRF_ROOK and !> DSYTRF_RK (or DSYTRF_BK) is the same and is not converted. - - pure subroutine stdlib_qsyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -69027,6 +69027,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyconvf_rook + + pure subroutine stdlib_qsyequb( uplo, n, a, lda, s, scond, amax, work, info ) !> DSYEQUB: computes row and column scalings intended to equilibrate a !> symmetric matrix A (with respect to the Euclidean norm) and reduce !> its condition number. The scale factors S are computed by the BIN @@ -69034,8 +69036,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qsyequb( uplo, n, a, lda, s, scond, amax, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -69203,10 +69203,10 @@ module stdlib_linalg_lapack_q scond = max( smin, smlnum ) / min( smax, bignum ) end subroutine stdlib_qsyequb - !> DSYEV: computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A. subroutine stdlib_qsyev( jobz, uplo, n, a, lda, w, work, lwork, info ) + !> DSYEV: computes all eigenvalues and, optionally, eigenvectors of a + !> real symmetric matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -69310,6 +69310,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyev + + subroutine stdlib_qsyevd( jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info ) !> DSYEVD: computes all eigenvalues and, optionally, eigenvectors of a !> real symmetric matrix A. If eigenvectors are desired, it uses a !> divide and conquer algorithm. @@ -69321,8 +69323,6 @@ module stdlib_linalg_lapack_q !> without guard digits, but we know of none. !> Because of large use of BLAS of level 3, DSYEVD needs N**2 more !> workspace than DSYEVX. - - subroutine stdlib_qsyevd( jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -69444,6 +69444,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyevd + + subroutine stdlib_qsyevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & !> DSYEVR: computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric matrix A. Eigenvalues and eigenvectors can be !> selected by specifying either a range of values or a range of @@ -69494,8 +69496,6 @@ module stdlib_linalg_lapack_q !> hence may abort due to a floating point exception in environments !> which do not handle NaNs and infinities in the ieee standard default !> manner. - - subroutine stdlib_qsyevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & isuppz, work, lwork,iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69766,12 +69766,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyevr + + subroutine stdlib_qsyevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & !> DSYEVX: computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric matrix A. Eigenvalues and eigenvectors can be !> selected by specifying either a range of values or a range of indices !> for the desired eigenvalues. - - subroutine stdlib_qsyevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & work, lwork, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70013,6 +70013,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyevx + + pure subroutine stdlib_qsygs2( itype, uplo, n, a, lda, b, ldb, info ) !> DSYGS2: reduces a real symmetric-definite generalized eigenproblem !> to standard form. !> If ITYPE = 1, the problem is A*x = lambda*B*x, @@ -70020,8 +70022,6 @@ module stdlib_linalg_lapack_q !> 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**T or L**T *A*L. !> B must have been previously factorized as U**T *U or L*L**T by DPOTRF. - - pure subroutine stdlib_qsygs2( itype, uplo, n, a, lda, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -70136,6 +70136,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsygs2 + + pure subroutine stdlib_qsygst( itype, uplo, n, a, lda, b, ldb, info ) !> DSYGST: reduces a real symmetric-definite generalized eigenproblem !> to standard form. !> If ITYPE = 1, the problem is A*x = lambda*B*x, @@ -70143,8 +70145,6 @@ module stdlib_linalg_lapack_q !> 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**T or L**T*A*L. !> B must have been previously factorized as U**T*U or L*L**T by DPOTRF. - - pure subroutine stdlib_qsygst( itype, uplo, n, a, lda, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -70275,13 +70275,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsygst + + subroutine stdlib_qsygv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, info ) !> DSYGV: computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-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 symmetric and B is also !> positive definite. - - subroutine stdlib_qsygv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -70375,6 +70375,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsygv + + subroutine stdlib_qsygvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, iwork, liwork,& !> DSYGVD: computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-definite eigenproblem, of the form !> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and @@ -70386,8 +70388,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qsygvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, iwork, liwork,& info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70496,14 +70496,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsygvd + + subroutine stdlib_qsygvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& !> DSYGVX: computes selected eigenvalues, and optionally, eigenvectors !> of a real generalized symmetric-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 symmetric and B is also positive definite. !> Eigenvalues and eigenvectors can be selected by specifying either a !> range of values or a range of indices for the desired eigenvalues. - - subroutine stdlib_qsygvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& m, w, z, ldz, work,lwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70624,11 +70624,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsygvx + + pure subroutine stdlib_qsyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & !> DSYRFS: improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric indefinite, and !> provides error bounds and backward error estimates for the solution. - - pure subroutine stdlib_qsyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70813,6 +70813,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyrfs + + pure subroutine stdlib_qsysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) !> DSYSV: computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS @@ -70824,8 +70826,6 @@ module stdlib_linalg_lapack_q !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_qsysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -70891,6 +70891,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsysv + + pure subroutine stdlib_qsysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) !> DSYSV computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS @@ -70901,8 +70903,6 @@ module stdlib_linalg_lapack_q !> where U (or L) is a product of permutation and unit upper (lower) !> triangular matrices, and T is symmetric tridiagonal. The factored !> form of A is then used to solve the system of equations A * X = B. - - pure subroutine stdlib_qsysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70963,6 +70963,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsysv_aa + + pure subroutine stdlib_qsysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,work, lwork, info ) !> DSYSV_RK: computes the solution to a real system of linear !> equations A * X = B, where A is an N-by-N symmetric matrix !> and X and B are N-by-NRHS matrices. @@ -70977,8 +70979,6 @@ module stdlib_linalg_lapack_q !> DSYTRF_RK is called to compute the factorization of a real !> symmetric matrix. The factored form of A is then used to solve !> the system of equations A * X = B by calling BLAS3 routine DSYTRS_3. - - pure subroutine stdlib_qsysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71040,6 +71040,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsysv_rk + + pure subroutine stdlib_qsysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) !> DSYSV_ROOK: computes the solution to a real system of linear !> equations !> A * X = B, @@ -71056,8 +71058,6 @@ module stdlib_linalg_lapack_q !> pivoting method. !> The factored form of A is then used to solve the system !> of equations A * X = B by calling DSYTRS_ROOK. - - pure subroutine stdlib_qsysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71119,14 +71119,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsysv_rook + + subroutine stdlib_qsysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & !> DSYSVX: uses the diagonal pivoting factorization to compute the !> solution to a real system of linear equations A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS !> matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_qsysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & ferr, berr, work, lwork,iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71216,10 +71216,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsysvx - !> DSYSWAPR: applies an elementary permutation on the rows and the columns of - !> a symmetric matrix. pure subroutine stdlib_qsyswapr( uplo, n, a, lda, i1, i2) + !> DSYSWAPR: applies an elementary permutation on the rows and the columns of + !> a symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -71284,10 +71284,10 @@ module stdlib_linalg_lapack_q endif end subroutine stdlib_qsyswapr - !> DSYTD2: reduces a real symmetric matrix A to symmetric tridiagonal - !> form T by an orthogonal similarity transformation: Q**T * A * Q = T. pure subroutine stdlib_qsytd2( uplo, n, a, lda, d, e, tau, info ) + !> DSYTD2: reduces a real symmetric matrix A to symmetric tridiagonal + !> form T by an orthogonal similarity transformation: Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -71378,6 +71378,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytd2 + + pure subroutine stdlib_qsytf2( uplo, n, a, lda, ipiv, info ) !> DSYTF2: computes the factorization of a real symmetric matrix A using !> the Bunch-Kaufman diagonal pivoting method: !> A = U*D*U**T or A = L*D*L**T @@ -71385,8 +71387,6 @@ module stdlib_linalg_lapack_q !> triangular matrices, U**T is the transpose of U, and D is symmetric 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. - - pure subroutine stdlib_qsytf2( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -71663,6 +71663,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytf2 + + pure subroutine stdlib_qsytf2_rk( uplo, n, a, lda, e, ipiv, info ) !> DSYTF2_RK: computes the factorization of a real symmetric matrix A !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), @@ -71672,8 +71674,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qsytf2_rk( uplo, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72115,6 +72115,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytf2_rk + + pure subroutine stdlib_qsytf2_rook( uplo, n, a, lda, ipiv, info ) !> DSYTF2_ROOK: computes the factorization of a real symmetric matrix A !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: !> A = U*D*U**T or A = L*D*L**T @@ -72122,8 +72124,6 @@ module stdlib_linalg_lapack_q !> triangular matrices, U**T is the transpose of U, and D is symmetric 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. - - pure subroutine stdlib_qsytf2_rook( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72526,11 +72526,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytf2_rook + + pure subroutine stdlib_qsytrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) !> DSYTRD: reduces a real symmetric matrix A to real symmetric !> tridiagonal form T by an orthogonal similarity transformation: !> Q**T * A * Q = T. - - pure subroutine stdlib_qsytrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72652,11 +72652,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrd + + pure subroutine stdlib_qsytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & !> DSYTRD_SB2ST: reduces a real symmetric band matrix A to real symmetric !> tridiagonal form T by a orthogonal similarity transformation: !> Q**T * A * Q = T. - - pure subroutine stdlib_qsytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72898,11 +72898,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrd_sb2st + + pure subroutine stdlib_qsytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) !> DSYTRD_SY2SB: reduces a real symmetric matrix A to real symmetric !> band-diagonal form AB by a orthogonal similarity transformation: !> Q**T * A * Q = AB. - - pure subroutine stdlib_qsytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73074,6 +73074,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrd_sy2sb + + pure subroutine stdlib_qsytrf( uplo, n, a, lda, ipiv, work, lwork, info ) !> DSYTRF: computes the factorization of a real symmetric matrix A using !> the Bunch-Kaufman diagonal pivoting method. The form of the !> factorization is @@ -73082,8 +73084,6 @@ module stdlib_linalg_lapack_q !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_qsytrf( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73200,14 +73200,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrf + + pure subroutine stdlib_qsytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) !> DSYTRF_AA: computes the factorization of a real symmetric matrix A !> using the Aasen's algorithm. The form of the factorization is !> A = U**T*T*U or A = L*T*L**T !> where U (or L) is a product of permutation and unit upper (lower) !> triangular matrices, and T is a symmetric tridiagonal matrix. !> This is the blocked version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_qsytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73424,6 +73424,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrf_aa + + pure subroutine stdlib_qsytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) !> DSYTRF_RK: computes the factorization of a real symmetric matrix A !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), @@ -73433,8 +73435,6 @@ module stdlib_linalg_lapack_q !> 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. - - pure subroutine stdlib_qsytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73590,6 +73590,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrf_rk + + pure subroutine stdlib_qsytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) !> DSYTRF_ROOK: computes the factorization of a real symmetric matrix A !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. !> The form of the factorization is @@ -73598,8 +73600,6 @@ module stdlib_linalg_lapack_q !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_qsytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73718,11 +73718,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrf_rook + + pure subroutine stdlib_qsytri( uplo, n, a, lda, ipiv, work, info ) !> DSYTRI: computes the inverse of a real symmetric indefinite matrix !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by !> DSYTRF. - - pure subroutine stdlib_qsytri( uplo, n, a, lda, ipiv, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73906,11 +73906,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytri + + pure subroutine stdlib_qsytri_rook( uplo, n, a, lda, ipiv, work, info ) !> DSYTRI_ROOK: computes the inverse of a real symmetric !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T !> computed by DSYTRF_ROOK. - - pure subroutine stdlib_qsytri_rook( uplo, n, a, lda, ipiv, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -74134,11 +74134,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytri_rook + + pure subroutine stdlib_qsytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) !> DSYTRS: solves a system of linear equations A*X = B with a real !> symmetric matrix A using the factorization A = U*D*U**T or !> A = L*D*L**T computed by DSYTRF. - - pure subroutine stdlib_qsytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -74344,11 +74344,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrs + + pure subroutine stdlib_qsytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) !> DSYTRS2: solves a system of linear equations A*X = B with a real !> symmetric matrix A using the factorization A = U*D*U**T or !> A = L*D*L**T computed by DSYTRF and converted by DSYCONV. - - pure subroutine stdlib_qsytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -74522,6 +74522,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrs2 + + pure subroutine stdlib_qsytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) !> DSYTRS_3: solves a system of linear equations A * X = B with a real !> symmetric matrix A using the factorization computed !> by DSYTRF_RK or DSYTRF_BK: @@ -74531,8 +74533,6 @@ module stdlib_linalg_lapack_q !> matrix, P**T is the transpose of P, and D is symmetric and block !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. !> This algorithm is using Level 3 BLAS. - - pure subroutine stdlib_qsytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -74679,11 +74679,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrs_3 + + pure subroutine stdlib_qsytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) !> DSYTRS_AA: solves a system of linear equations A*X = B with a real !> symmetric matrix A using the factorization A = U**T*T*U or !> A = L*T*L**T computed by DSYTRF_AA. - - pure subroutine stdlib_qsytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74798,11 +74798,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrs_aa + + pure subroutine stdlib_qsytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) !> DSYTRS_ROOK: solves a system of linear equations A*X = B with !> a real symmetric matrix A using the factorization A = U*D*U**T or !> A = L*D*L**T computed by DSYTRF_ROOK. - - pure subroutine stdlib_qsytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -75020,14 +75020,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrs_rook + + subroutine stdlib_qtbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,iwork, info ) !> DTBCON: estimates the reciprocal of the condition number of a !> triangular band matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_qtbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75124,14 +75124,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtbcon + + pure subroutine stdlib_qtbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& !> DTBRFS: provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular band !> coefficient matrix. !> The solution matrix X must be computed by DTBTRS or some other !> means before entering this routine. DTBRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_qtbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75362,12 +75362,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtbrfs + + pure subroutine stdlib_qtbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) !> DTBTRS: solves a triangular system of the form !> A * X = B or A**T * X = B, !> where A is a triangular band matrix of order N, and B is an !> N-by NRHS matrix. A check is made to verify that A is nonsingular. - - pure subroutine stdlib_qtbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75435,6 +75435,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtbtrs + + pure subroutine stdlib_qtfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) !> Level 3 BLAS like routine for A in RFP Format. !> DTFSM: solves the matrix equation !> op( A )*X = alpha*B or X*op( A ) = alpha*B @@ -75443,8 +75445,6 @@ module stdlib_linalg_lapack_q !> op( A ) = A or op( A ) = A**T. !> A is in Rectangular Full Packed (RFP) Format. !> The matrix X is overwritten on B. - - pure subroutine stdlib_qtfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75937,11 +75937,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtfsm + + pure subroutine stdlib_qtftri( transr, uplo, diag, n, a, info ) !> DTFTRI: computes the inverse of a triangular matrix A stored in RFP !> format. !> This is a Level 3 BLAS version of the algorithm. - - pure subroutine stdlib_qtftri( transr, uplo, diag, n, a, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -76120,10 +76120,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtftri - !> DTFTTP: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard packed format (TP). pure subroutine stdlib_qtfttp( transr, uplo, n, arf, ap, info ) + !> DTFTTP: copies a triangular matrix A from rectangular full packed + !> format (TF) to standard packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -76376,10 +76376,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtfttp - !> DTFTTR: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard full format (TR). pure subroutine stdlib_qtfttr( transr, uplo, n, arf, a, lda, info ) + !> DTFTTR: copies a triangular matrix A from rectangular full packed + !> format (TF) to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -76605,6 +76605,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtfttr + + pure subroutine stdlib_qtgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & !> DTGEVC: computes some or all of the right and/or left eigenvectors of !> a pair of real matrices (S,P), where S is a quasi-triangular matrix !> and P is upper triangular. Matrix pairs of this type are produced by @@ -76623,8 +76625,6 @@ module stdlib_linalg_lapack_q !> If Q and Z are the orthogonal factors from the generalized Schur !> factorization of a matrix pair (A,B), then Z*X and Q*Y !> are the matrices of right and left eigenvectors of (A,B). - - pure subroutine stdlib_qtgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & mm, m, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77335,6 +77335,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgevc + + pure subroutine stdlib_qtgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, n1, n2, & !> DTGEX2: swaps adjacent diagonal blocks (A11, B11) and (A22, B22) !> of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair !> (A, B) by an orthogonal equivalence transformation. @@ -77345,8 +77347,6 @@ module stdlib_linalg_lapack_q !> updated. !> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T !> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T - - pure subroutine stdlib_qtgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, n1, n2, & work, lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77700,6 +77700,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgex2 + + pure subroutine stdlib_qtgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & !> DTGEXC: reorders the generalized real Schur decomposition of a real !> matrix pair (A,B) using an orthogonal equivalence transformation !> (A, B) = Q * (A, B) * Z**T, @@ -77712,8 +77714,6 @@ module stdlib_linalg_lapack_q !> updated. !> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T !> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T - - pure subroutine stdlib_qtgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77949,6 +77949,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgexc + + pure subroutine stdlib_qtgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alphar, alphai, & !> DTGSEN: reorders the generalized real Schur decomposition of a real !> matrix pair (A, B) (in terms of an orthonormal equivalence trans- !> formation Q**T * (A, B) * Z), so that a selected cluster of eigenvalues @@ -77969,8 +77971,6 @@ module stdlib_linalg_lapack_q !> the selected cluster and the eigenvalues outside the cluster, resp., !> and norms of "projections" onto left and right eigenspaces w.r.t. !> the selected cluster in the (1,1)-block. - - pure subroutine stdlib_qtgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alphar, alphai, & beta, q, ldq, z, ldz, m, pl,pr, dif, work, lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78275,6 +78275,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgsen + + pure subroutine stdlib_qtgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & !> DTGSJA: computes the generalized singular value decomposition (GSVD) !> of two real upper triangular (or trapezoidal) matrices A and B. !> On entry, it is assumed that matrices A and B have the following @@ -78336,8 +78338,6 @@ module stdlib_linalg_lapack_q !> The computation of the orthogonal transformation matrices U, V or Q !> is optional. These matrices may either be formed explicitly, or they !> may be postmultiplied into input matrices U1, V1, or Q1. - - pure subroutine stdlib_qtgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & alpha, beta, u, ldu, v, ldv,q, ldq, work, ncycle, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78516,6 +78516,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgsja + + pure subroutine stdlib_qtgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & !> DTGSNA: estimates reciprocal condition numbers for specified !> eigenvalues and/or eigenvectors of a matrix pair (A, B) in !> generalized real Schur canonical form (or of any matrix pair @@ -78524,8 +78526,6 @@ module stdlib_linalg_lapack_q !> (A, B) must be in generalized real Schur form (as returned by DGGES), !> i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal !> blocks. B is upper triangular. - - pure subroutine stdlib_qtgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & dif, mm, m, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78764,6 +78764,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgsna + + pure subroutine stdlib_qtgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & !> DTGSY2: solves the generalized Sylvester equation: !> A * R - L * B = scale * C (1) !> D * R - L * E = scale * F, @@ -78792,8 +78794,6 @@ module stdlib_linalg_lapack_q !> of an upper bound on the separation between to matrix pairs. Then !> the input (A, D), (B, E) are sub-pencils of the matrix pair in !> DTGSYL. See DTGSYL for details. - - pure subroutine stdlib_qtgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & ldf, scale, rdsum, rdscal,iwork, pq, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79404,6 +79404,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgsy2 + + pure subroutine stdlib_qtgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & !> DTGSYL: solves the generalized Sylvester equation: !> A * R - L * B = scale * C (1) !> D * R - L * E = scale * F @@ -79432,8 +79434,6 @@ module stdlib_linalg_lapack_q !> reciprocal of the smallest singular value of Z. See [1-2] for more !> information. !> This is a level 3 BLAS algorithm. - - pure subroutine stdlib_qtgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79733,14 +79733,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgsyl + + subroutine stdlib_qtpcon( norm, uplo, diag, n, ap, rcond, work, iwork,info ) !> DTPCON: estimates the reciprocal of the condition number of a packed !> triangular matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_qtpcon( norm, uplo, diag, n, ap, rcond, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79832,12 +79832,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtpcon + + pure subroutine stdlib_qtplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) !> DTPLQT: computes a blocked LQ factorization of a real !> "triangular-pentagonal" matrix C, which is composed of a !> triangular block A and pentagonal block B, using the compact !> WY representation for Q. - - pure subroutine stdlib_qtplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79894,11 +79894,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtplqt + + pure subroutine stdlib_qtplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) !> DTPLQT2: computes a LQ a factorization of a real "triangular-pentagonal" !> matrix C, which is composed of a triangular block A and pentagonal block B, !> using the compact WY representation for Q. - - pure subroutine stdlib_qtplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79991,11 +79991,11 @@ module stdlib_linalg_lapack_q end do end subroutine stdlib_qtplqt2 + + pure subroutine stdlib_qtpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, ldb, & !> DTPMQRT applies a real orthogonal matrix Q obtained from a !> "triangular-pentagonal" real block reflector H to a general !> real matrix C, which consists of two blocks A and B. - - pure subroutine stdlib_qtpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, ldb, & work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80109,11 +80109,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtpmlqt + + pure subroutine stdlib_qtpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, ldb, & !> DTPMQRT: applies a real orthogonal matrix Q obtained from a !> "triangular-pentagonal" real block reflector H to a general !> real matrix C, which consists of two blocks A and B. - - pure subroutine stdlib_qtpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, ldb, & work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80229,12 +80229,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtpmqrt + + pure subroutine stdlib_qtpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) !> DTPQRT: computes a blocked QR factorization of a real !> "triangular-pentagonal" matrix C, which is composed of a !> triangular block A and pentagonal block B, using the compact !> WY representation for Q. - - pure subroutine stdlib_qtpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -80291,11 +80291,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtpqrt + + pure subroutine stdlib_qtpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) !> DTPQRT2: computes a QR factorization of a real "triangular-pentagonal" !> matrix C, which is composed of a triangular block A and pentagonal block B, !> using the compact WY representation for Q. - - pure subroutine stdlib_qtpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -80382,11 +80382,11 @@ module stdlib_linalg_lapack_q end do end subroutine stdlib_qtpqrt2 + + pure subroutine stdlib_qtprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & !> DTPRFB: applies a real "triangular-pentagonal" block reflector H or its !> transpose H**T to a real matrix C, which is composed of two !> blocks A and B, either from the left or right. - - pure subroutine stdlib_qtprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & lda, b, ldb, work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80800,14 +80800,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtprfb + + pure subroutine stdlib_qtprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & !> DTPRFS: provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular packed !> coefficient matrix. !> The solution matrix X must be computed by DTPTRS or some other !> means before entering this routine. DTPRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_qtprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -81045,10 +81045,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtprfs - !> DTPTRI: computes the inverse of a real upper or lower triangular - !> matrix A stored in packed format. pure subroutine stdlib_qtptri( uplo, diag, n, ap, info ) + !> DTPTRI: computes the inverse of a real upper or lower triangular + !> matrix A stored in packed format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -81135,13 +81135,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtptri + + pure subroutine stdlib_qtptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) !> DTPTRS: solves a triangular system of the form !> A * X = B or A**T * X = B, !> where A is a triangular matrix of order N stored in packed format, !> and B is an N-by-NRHS matrix. A check is made to verify that A is !> nonsingular. - - pure subroutine stdlib_qtptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -81208,10 +81208,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtptrs - !> DTPTTF: copies a triangular matrix A from standard packed format (TP) - !> to rectangular full packed format (TF). pure subroutine stdlib_qtpttf( transr, uplo, n, ap, arf, info ) + !> DTPTTF: copies a triangular matrix A from standard packed format (TP) + !> to rectangular full packed format (TF). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -81450,10 +81450,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtpttf - !> DTPTTR: copies a triangular matrix A from standard packed format (TP) - !> to standard full format (TR). pure subroutine stdlib_qtpttr( uplo, n, ap, a, lda, info ) + !> DTPTTR: copies a triangular matrix A from standard packed format (TP) + !> to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -81504,14 +81504,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtpttr + + subroutine stdlib_qtrcon( norm, uplo, diag, n, a, lda, rcond, work,iwork, info ) !> DTRCON: estimates the reciprocal of the condition number of a !> triangular matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_qtrcon( norm, uplo, diag, n, a, lda, rcond, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -81605,6 +81605,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrcon + + pure subroutine stdlib_qtrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & !> DTREVC: computes some or all of the right and/or left eigenvectors of !> a real upper quasi-triangular matrix T. !> Matrices of this type are produced by the Schur factorization of @@ -81620,8 +81622,6 @@ module stdlib_linalg_lapack_q !> input matrix. If Q is the orthogonal factor that reduces a matrix !> A to Schur form T, then Q*X and Q*Y are the matrices of right and !> left eigenvectors of A. - - pure subroutine stdlib_qtrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82218,6 +82218,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrevc + + pure subroutine stdlib_qtrevc3( side, howmny, select, n, t, ldt, vl, ldvl,vr, ldvr, mm, m, & !> DTREVC3: computes some or all of the right and/or left eigenvectors of !> a real upper quasi-triangular matrix T. !> Matrices of this type are produced by the Schur factorization of @@ -82234,8 +82236,6 @@ module stdlib_linalg_lapack_q !> A to Schur form T, then Q*X and Q*Y are the matrices of right and !> left eigenvectors of A. !> This uses a Level 3 BLAS version of the back transformation. - - pure subroutine stdlib_qtrevc3( side, howmny, select, n, t, ldt, vl, ldvl,vr, ldvr, mm, m, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83040,6 +83040,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrevc3 + + subroutine stdlib_qtrexc( compq, n, t, ldt, q, ldq, ifst, ilst, work,info ) !> DTREXC: reorders the real Schur factorization of a real matrix !> A = Q*T*Q**T, so that the diagonal block of T with row index IFST is !> moved to row ILST. @@ -83050,8 +83052,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qtrexc( compq, n, t, ldt, q, ldq, ifst, ilst, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83244,14 +83244,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrexc + + pure subroutine stdlib_qtrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& !> DTRRFS: provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular !> coefficient matrix. !> The solution matrix X must be computed by DTRTRS or some other !> means before entering this routine. DTRRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_qtrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83479,6 +83479,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrrfs + + subroutine stdlib_qtrsen( job, compq, select, n, t, ldt, q, ldq, wr, wi,m, s, sep, work, & !> DTRSEN: reorders the real Schur factorization of a real matrix !> A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in !> the leading diagonal blocks of the upper quasi-triangular matrix T, @@ -83490,8 +83492,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qtrsen( job, compq, select, n, t, ldt, q, ldq, wr, wi,m, s, sep, work, & lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83674,6 +83674,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrsen + + subroutine stdlib_qtrsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm, m, & !> DTRSNA: estimates reciprocal condition numbers for specified !> eigenvalues and/or right eigenvectors of a real upper !> quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q @@ -83682,8 +83684,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qtrsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm, m, & work, ldwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83919,6 +83919,8 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrsna + + subroutine stdlib_qtrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) !> DTRSYL: solves the real Sylvester matrix equation: !> op(A)*X + X*op(B) = scale*C or !> op(A)*X - X*op(B) = scale*C, @@ -83930,8 +83932,6 @@ module stdlib_linalg_lapack_q !> 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. - - subroutine stdlib_qtrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84580,11 +84580,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrsyl + + pure subroutine stdlib_qtrti2( uplo, diag, n, a, lda, info ) !> DTRTI2: computes the inverse of a real upper or lower triangular !> matrix. !> This is the Level 2 BLAS version of the algorithm. - - pure subroutine stdlib_qtrti2( uplo, diag, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -84654,11 +84654,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrti2 + + pure subroutine stdlib_qtrtri( uplo, diag, n, a, lda, info ) !> DTRTRI: computes the inverse of a real upper or lower triangular !> matrix A. !> This is the Level 3 BLAS version of the algorithm. - - pure subroutine stdlib_qtrtri( uplo, diag, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -84741,12 +84741,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrtri + + pure subroutine stdlib_qtrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) !> DTRTRS: solves a triangular system of the form !> A * X = B or A**T * X = B, !> where A is a triangular matrix of order N, and B is an N-by-NRHS !> matrix. A check is made to verify that A is nonsingular. - - pure subroutine stdlib_qtrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -84801,10 +84801,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrtrs - !> DTRTTF: copies a triangular matrix A from standard full format (TR) - !> to rectangular full packed format (TF) . pure subroutine stdlib_qtrttf( transr, uplo, n, a, lda, arf, info ) + !> DTRTTF: copies a triangular matrix A from standard full format (TR) + !> to rectangular full packed format (TF) . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -85029,10 +85029,10 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrttf - !> DTRTTP: copies a triangular matrix A from full format (TR) to standard - !> packed format (TP). pure subroutine stdlib_qtrttp( uplo, n, a, lda, ap, info ) + !> DTRTTP: copies a triangular matrix A from full format (TR) to standard + !> packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -85083,14 +85083,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrttp + + pure subroutine stdlib_qtzrzf( m, n, a, lda, tau, work, lwork, info ) !> DTZRZF: reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A !> to upper triangular form by means of orthogonal transformations. !> The upper trapezoidal matrix A is factored as !> A = ( R 0 ) * Z, !> where Z is an N-by-N orthogonal matrix and R is an M-by-M upper !> triangular matrix. - - pure subroutine stdlib_qtzrzf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -85199,12 +85199,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtzrzf + + pure real(qp) function stdlib_qzsum1( n, cx, incx ) !> DZSUM1: takes the sum of the absolute values of a complex !> vector and returns a quad precision result. !> Based on DZASUM from the Level 1 BLAS. !> The change is to use the 'genuine' absolute value. - - pure real(qp) function stdlib_qzsum1( n, cx, incx ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -85241,14 +85241,14 @@ module stdlib_linalg_lapack_q return end function stdlib_qzsum1 + + pure subroutine stdlib_qlag2q( m, n, sa, ldsa, a, lda, info ) !> DLAG2Q: converts a SINGLE PRECISION matrix, SA, to a DOUBLE !> PRECISION matrix, A. !> Note that while it is possible to overflow while converting !> from double to single, it is not possible to overflow when !> converting from single to double. !> This is an auxiliary routine so there is no argument checking. - - pure subroutine stdlib_qlag2q( m, n, sa, ldsa, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_lapack_s.fypp b/src/stdlib_linalg_lapack_s.fypp index 51897399a..a01a33639 100644 --- a/src/stdlib_linalg_lapack_s.fypp +++ b/src/stdlib_linalg_lapack_s.fypp @@ -514,12 +514,12 @@ module stdlib_linalg_lapack_s contains - !> SCSUM1: takes the sum of the absolute values of a complex + + pure real(sp) function stdlib_scsum1( n, cx, incx ) + !> SCSUM1 takes the sum of the absolute values of a complex !> vector and returns a single precision result. !> Based on SCASUM from the Level 1 BLAS. !> The change is to use the 'genuine' absolute value. - - pure real(sp) function stdlib_scsum1( n, cx, incx ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -556,11 +556,11 @@ module stdlib_linalg_lapack_s return end function stdlib_scsum1 - !> SGBTF2: computes an LU factorization of a real m-by-n band matrix A - !> using partial pivoting with row interchanges. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. pure subroutine stdlib_sgbtf2( m, n, kl, ku, ab, ldab, ipiv, info ) + !> SGBTF2 computes an LU factorization of a real m-by-n band matrix A + !> using partial pivoting with row interchanges. + !> This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -642,12 +642,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbtf2 - !> SGBTRS: solves a system of linear equations + + pure subroutine stdlib_sgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) + !> SGBTRS solves a system of linear equations !> A * X = B or A**T * X = B !> with a general band matrix A using the LU factorization computed !> by SGBTRF. - - pure subroutine stdlib_sgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -736,11 +736,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbtrs - !> SGEBAK: forms the right or left eigenvectors of a real general matrix - !> by backward transformation on the computed eigenvectors of the - !> balanced matrix output by SGEBAL. pure subroutine stdlib_sgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) + !> SGEBAK forms the right or left eigenvectors of a real general matrix + !> by backward transformation on the computed eigenvectors of the + !> balanced matrix output by SGEBAL. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -833,12 +833,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgebak - !> SGGBAK: forms the right or left eigenvectors of a real generalized + + pure subroutine stdlib_sggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) + !> SGGBAK forms the right or left eigenvectors of a real generalized !> eigenvalue problem A*x = lambda*B*x, by backward transformation on !> the computed eigenvectors of the balanced pair of matrices output by !> SGGBAL. - - pure subroutine stdlib_sggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -946,14 +946,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggbak - !> SGTSV: solves the equation + + pure subroutine stdlib_sgtsv( n, nrhs, dl, d, du, b, ldb, info ) + !> SGTSV 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. - - pure subroutine stdlib_sgtsv( n, nrhs, dl, d, du, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1125,15 +1125,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgtsv - !> SGTTRF: computes an LU factorization of a real tridiagonal matrix A + + pure subroutine stdlib_sgttrf( n, dl, d, du, du2, ipiv, info ) + !> SGTTRF computes an LU factorization of a real 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. - - pure subroutine stdlib_sgttrf( n, dl, d, du, du2, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1217,12 +1217,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgttrf - !> SGTTS2: solves one of the systems of equations + + pure subroutine stdlib_sgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) + !> SGTTS2 solves one of the systems of equations !> A*X = B or A**T*X = B, !> with a tridiagonal matrix A using the LU factorization computed !> by SGTTRF. - - pure subroutine stdlib_sgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1330,14 +1330,14 @@ module stdlib_linalg_lapack_s end if end subroutine stdlib_sgtts2 - !> SLA_GBRPVGRW: computes the reciprocal pivot growth factor + + pure real(sp) function stdlib_sla_gbrpvgrw( n, kl, ku, ncols, ab, ldab, afb,ldafb ) + !> SLA_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. - - pure real(sp) function stdlib_sla_gbrpvgrw( n, kl, ku, ncols, ab, ldab, afb,ldafb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1370,14 +1370,14 @@ module stdlib_linalg_lapack_s stdlib_sla_gbrpvgrw = rpvgrw end function stdlib_sla_gbrpvgrw - !> SLA_GERPVGRW: computes the reciprocal pivot growth factor + + pure real(sp) function stdlib_sla_gerpvgrw( n, ncols, a, lda, af, ldaf ) + !> SLA_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. - - pure real(sp) function stdlib_sla_gerpvgrw( n, ncols, a, lda, af, ldaf ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1409,11 +1409,11 @@ module stdlib_linalg_lapack_s stdlib_sla_gerpvgrw = rpvgrw end function stdlib_sla_gerpvgrw - !> SLA_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. pure subroutine stdlib_sla_wwaddw( n, x, y, w ) + !> SLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1436,7 +1436,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sla_wwaddw - !> SLABAD: takes as input the values computed by SLAMCH for underflow and + + pure subroutine stdlib_slabad( small, large ) + !> SLABAD takes as input the values computed by SLAMCH 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 @@ -1444,8 +1446,6 @@ module stdlib_linalg_lapack_s !> the values computed by SLAMCH. This subroutine is needed because !> SLAMCH does not compensate for poor arithmetic in the upper half of !> the exponent range, as is found on a Cray. - - pure subroutine stdlib_slabad( small, large ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1464,10 +1464,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slabad - !> SLACN2: estimates the 1-norm of a square, real matrix A. - !> Reverse communication is used for evaluating matrix-vector products. pure subroutine stdlib_slacn2( n, v, x, isgn, est, kase, isave ) + !> SLACN2 estimates the 1-norm of a square, real matrix A. + !> Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1597,10 +1597,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slacn2 - !> SLACON: estimates the 1-norm of a square, real matrix A. - !> Reverse communication is used for evaluating matrix-vector products. subroutine stdlib_slacon( n, v, x, isgn, est, kase ) + !> SLACON estimates the 1-norm of a square, real matrix A. + !> Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1718,10 +1718,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slacon - !> SLACPY: copies all or part of a two-dimensional matrix A to another - !> matrix B. pure subroutine stdlib_slacpy( uplo, m, n, a, lda, b, ldb ) + !> SLACPY copies all or part of a two-dimensional matrix A to another + !> matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1784,13 +1784,13 @@ module stdlib_linalg_lapack_s return end function stdlib_sladiv2 - !> SLAE2: computes the eigenvalues of a 2-by-2 symmetric matrix + + pure subroutine stdlib_slae2( a, b, c, rt1, rt2 ) + !> SLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix !> [ A B ] !> [ B C ]. !> On return, RT1 is the eigenvalue of larger absolute value, and RT2 !> is the eigenvalue of smaller absolute value. - - pure subroutine stdlib_slae2( a, b, c, rt1, rt2 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1848,7 +1848,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slae2 - !> SLAEBZ: contains the iteration loops which compute and use the + + pure subroutine stdlib_slaebz( ijob, nitmax, n, mmax, minp, nbmin, abstol,reltol, pivmin, d, & + !> SLAEBZ 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: @@ -1879,8 +1881,6 @@ module stdlib_linalg_lapack_s !> University, July 21, 1966 !> Note: the arguments are, in general, *not* checked for unreasonable !> values. - - pure subroutine stdlib_slaebz( ijob, nitmax, n, mmax, minp, nbmin, abstol,reltol, pivmin, d, & e, e2, nval, ab, c, mout,nab, work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2119,6 +2119,8 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaebz + + pure subroutine stdlib_slaed5( i, d, z, delta, rho, dlam ) !> 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) . @@ -2126,8 +2128,6 @@ module stdlib_linalg_lapack_s !> D(i) < D(j) for i < j . !> We also assume RHO > 0 and that the Euclidean norm of the vector !> Z is one. - - pure subroutine stdlib_slaed5( i, d, z, delta, rho, dlam ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2190,11 +2190,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed5 - !> SLAEDA: computes the Z vector corresponding to the merge step in the - !> CURLVLth step of the merge process with TLVLS steps for the CURPBMth - !> problem. pure subroutine stdlib_slaeda( n, tlvls, curlvl, curpbm, prmptr, perm, givptr,givcol, givnum,& + !> SLAEDA computes the Z vector corresponding to the merge step in the + !> CURLVLth step of the merge process with TLVLS steps for the CURPBMth + !> problem. q, qptr, z, ztemp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2295,7 +2295,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaeda - !> SLAEV2: computes the eigendecomposition of a 2-by-2 symmetric matrix + + pure subroutine stdlib_slaev2( a, b, c, rt1, rt2, cs1, sn1 ) + !> SLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix !> [ A B ] !> [ B C ]. !> On return, RT1 is the eigenvalue of larger absolute value, RT2 is the @@ -2303,8 +2305,6 @@ module stdlib_linalg_lapack_s !> eigenvector for RT1, giving the decomposition !> [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ] !> [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ]. - - pure subroutine stdlib_slaev2( a, b, c, rt1, rt2, cs1, sn1 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2394,14 +2394,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaev2 - !> SLAG2: computes the eigenvalues of a 2 x 2 generalized eigenvalue + + pure subroutine stdlib_slag2( a, lda, b, ldb, safmin, scale1, scale2, wr1,wr2, wi ) + !> SLAG2 computes the eigenvalues of a 2 x 2 generalized eigenvalue !> problem A - w B, with scaling as necessary to avoid over-/underflow. !> The scaling factor "s" results in a modified eigenvalue equation !> s A - w B !> where s is a non-negative scaling factor chosen so that w, w B, !> and s A do not overflow and, if possible, do not underflow, either. - - pure subroutine stdlib_slag2( a, lda, b, ldb, safmin, scale1, scale2, wr1,wr2, wi ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2578,14 +2578,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slag2 - !> SLAG2D: converts a SINGLE PRECISION matrix, SA, to a DOUBLE + + pure subroutine stdlib_slag2d( m, n, sa, ldsa, a, lda, info ) + !> SLAG2D converts a SINGLE PRECISION matrix, SA, to a DOUBLE !> PRECISION matrix, A. !> Note that while it is possible to overflow while converting !> from double to single, it is not possible to overflow when !> converting from single to double. !> This is an auxiliary routine so there is no argument checking. - - pure subroutine stdlib_slag2d( m, n, sa, ldsa, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2608,13 +2608,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slag2d - !> SLAGTM: performs a matrix-vector product of the form + + pure subroutine stdlib_slagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) + !> SLAGTM 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. - - pure subroutine stdlib_slagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2710,9 +2710,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slagtm + + pure logical(lk) function stdlib_slaisnan( sin1, sin2 ) !> This routine is not for general use. It exists solely to avoid !> over-optimization in SISNAN. - !> SLAISNAN: checks for NaNs by comparing its two arguments for + !> SLAISNAN 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. @@ -2721,8 +2723,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure logical(lk) function stdlib_slaisnan( sin1, sin2 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2734,9 +2734,9 @@ module stdlib_linalg_lapack_s return end function stdlib_slaisnan - !> SLAMCH: determines single precision machine parameters. pure real(sp) function stdlib_slamch( cmach ) + !> SLAMCH determines single precision machine parameters. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2802,11 +2802,11 @@ module stdlib_linalg_lapack_s return end function stdlib_slamc3 - !> SLAMRG: 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. pure subroutine stdlib_slamrg( n1, n2, a, strd1, strd2, index ) + !> SLAMRG 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2866,7 +2866,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slamrg - !> SLAORHR_COL_GETRFNP2: computes the modified LU factorization without + + pure recursive subroutine stdlib_slaorhr_col_getrfnp2( m, n, a, lda, d, info ) + !> SLAORHR_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, @@ -2914,8 +2916,6 @@ module stdlib_linalg_lapack_s !> [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. - - pure recursive subroutine stdlib_slaorhr_col_getrfnp2( m, n, a, lda, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2996,14 +2996,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaorhr_col_getrfnp2 - !> SLAPMR: rearranges the rows of the M by N matrix X as specified + + pure subroutine stdlib_slapmr( forwrd, m, n, x, ldx, k ) + !> SLAPMR 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. - - pure subroutine stdlib_slapmr( forwrd, m, n, x, ldx, k ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3064,14 +3064,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slapmr - !> SLAPMT: rearranges the columns of the M by N matrix X as specified + + pure subroutine stdlib_slapmt( forwrd, m, n, x, ldx, k ) + !> SLAPMT 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. - - pure subroutine stdlib_slapmt( forwrd, m, n, x, ldx, k ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3132,10 +3132,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slapmt - !> SLAPY3: returns sqrt(x**2+y**2+z**2), taking care not to cause - !> unnecessary overflow and unnecessary underflow. pure real(sp) function stdlib_slapy3( x, y, z ) + !> SLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause + !> unnecessary overflow and unnecessary underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3164,11 +3164,11 @@ module stdlib_linalg_lapack_s return end function stdlib_slapy3 - !> SLAQGB: 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. pure subroutine stdlib_slaqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) + !> SLAQGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -3234,10 +3234,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaqgb - !> SLAQGE: equilibrates a general M by N matrix A using the row and - !> column scaling factors in the vectors R and C. pure subroutine stdlib_slaqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed ) + !> SLAQGE equilibrates a general M by N matrix A using the row and + !> column scaling factors in the vectors R and C. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3300,6 +3300,8 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaqge + + pure subroutine stdlib_slaqr1( n, h, ldh, sr1, si1, sr2, si2, v ) !> Given a 2-by-2 or 3-by-3 matrix H, SLAQR1: sets v to a !> scalar multiple of the first column of the product !> (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I) @@ -3310,8 +3312,6 @@ module stdlib_linalg_lapack_s !> 2) si1 = si2 = 0. !> This is useful for starting double implicit shift bulges !> in the QR algorithm. - - pure subroutine stdlib_slaqr1( n, h, ldh, sr1, si1, sr2, si2, v ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3360,10 +3360,10 @@ module stdlib_linalg_lapack_s end if end subroutine stdlib_slaqr1 - !> SLAQSB: equilibrates a symmetric band matrix A using the scaling - !> factors in the vector S. pure subroutine stdlib_slaqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) + !> SLAQSB equilibrates a symmetric band matrix A using the scaling + !> factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3420,10 +3420,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaqsb - !> SLAQSP: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_slaqsp( uplo, n, ap, s, scond, amax, equed ) + !> SLAQSP equilibrates a symmetric matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3482,10 +3482,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaqsp - !> SLAQSY: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_slaqsy( uplo, n, a, lda, s, scond, amax, equed ) + !> SLAQSY equilibrates a symmetric matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3540,13 +3540,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaqsy - !> SLAR2V: applies a vector of real plane rotations from both sides to + + pure subroutine stdlib_slar2v( n, x, y, z, incx, c, s, incc ) + !> SLAR2V applies a vector of real plane rotations from both sides to !> a sequence of 2-by-2 real symmetric matrices, defined by the elements !> of the vectors x, y and z. For i = 1,2,...,n !> ( x(i) z(i) ) := ( c(i) s(i) ) ( x(i) z(i) ) ( c(i) -s(i) ) !> ( z(i) y(i) ) ( -s(i) c(i) ) ( z(i) y(i) ) ( s(i) c(i) ) - - pure subroutine stdlib_slar2v( n, x, y, z, incx, c, s, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3583,13 +3583,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slar2v - !> SLARF: applies a real elementary reflector H to a real m by n matrix + + pure subroutine stdlib_slarf( side, m, n, v, incv, tau, c, ldc, work ) + !> SLARF applies a real elementary reflector H to a real m by n matrix !> C, from either the left or the right. H is represented in the form !> H = I - tau * v * v**T !> where tau is a real scalar and v is a real vector. !> If tau = 0, then H is taken to be the unit matrix. - - pure subroutine stdlib_slarf( side, m, n, v, incv, tau, c, ldc, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3660,10 +3660,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarf - !> SLARFB: applies a real block reflector H or its transpose H**T to a - !> real m by n matrix C, from either the left or the right. pure subroutine stdlib_slarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, ldc, & + !> SLARFB applies a real block reflector H or its transpose H**T to a + !> real m by n matrix C, from either the left or the right. work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -3982,15 +3982,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarfb - !> SLARFB_GETT: applies a real Householder block reflector H from the + + pure subroutine stdlib_slarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) + !> SLARFB_GETT applies a real Householder block reflector H from the !> left to a real (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. - - pure subroutine stdlib_slarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4119,7 +4119,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarfb_gett - !> SLARFT: forms the triangular factor T of a real block reflector H + + pure subroutine stdlib_slarft( direct, storev, n, k, v, ldv, tau, t, ldt ) + !> SLARFT forms the triangular factor T of a real 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. @@ -4129,8 +4131,6 @@ module stdlib_linalg_lapack_s !> 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**T * T * V - - pure subroutine stdlib_slarft( direct, storev, n, k, v, ldv, tau, t, ldt ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4246,15 +4246,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarft - !> SLARFX: applies a real elementary reflector H to a real m by n + + pure subroutine stdlib_slarfx( side, m, n, v, tau, c, ldc, work ) + !> SLARFX applies a real elementary reflector H to a real m by n !> matrix C, from either the left or the right. H is represented in the !> form !> H = I - tau * v * v**T !> where tau is a real scalar and v is a real vector. !> If tau = 0, then H is taken to be the unit matrix !> This version uses inline code if H has order < 11. - - pure subroutine stdlib_slarfx( side, m, n, v, tau, c, ldc, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4748,14 +4748,14 @@ module stdlib_linalg_lapack_s 410 return end subroutine stdlib_slarfx - !> SLARFY: applies an elementary reflector, or Householder matrix, H, + + pure subroutine stdlib_slarfy( uplo, n, v, incv, tau, c, ldc, work ) + !> SLARFY applies an elementary reflector, or Householder matrix, H, !> to an n x n symmetric 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. - - pure subroutine stdlib_slarfy( uplo, n, v, incv, tau, c, ldc, work ) ! -- lapack test routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4782,12 +4782,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarfy - !> SLARGV: generates a vector of real plane rotations, determined by + + pure subroutine stdlib_slargv( n, x, incx, y, incy, c, incc ) + !> SLARGV generates a vector of real plane rotations, determined by !> elements of the real vectors x and y. For i = 1,2,...,n !> ( c(i) s(i) ) ( x(i) ) = ( a(i) ) !> ( -s(i) c(i) ) ( y(i) ) = ( 0 ) - - pure subroutine stdlib_slargv( n, x, incx, y, incy, c, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4836,10 +4836,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slargv - !> Compute the splitting points with threshold SPLTOL. - !> SLARRA: sets any "small" off-diagonal elements to zero. pure subroutine stdlib_slarra( n, d, e, e2, spltol, tnrm,nsplit, isplit, info ) + !> Compute the splitting points with threshold SPLTOL. + !> SLARRA sets any "small" off-diagonal elements to zero. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4894,11 +4894,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarra + + pure subroutine stdlib_slarrc( jobt, n, vl, vu, d, e, pivmin,eigcnt, lcnt, rcnt, info ) !> 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'. - - pure subroutine stdlib_slarrc( jobt, n, vl, vu, d, e, pivmin,eigcnt, lcnt, rcnt, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4987,7 +4987,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarrc - !> SLARRD: computes the eigenvalues of a symmetric tridiagonal + + pure subroutine stdlib_slarrd( range, order, n, vl, vu, il, iu, gers,reltol, d, e, e2, & + !> SLARRD computes the eigenvalues of a symmetric tridiagonal !> matrix T to suitable accuracy. This is an auxiliary code to be !> called from SSTEMR. !> The user may ask for all eigenvalues, all eigenvalues @@ -4999,8 +5001,6 @@ module stdlib_linalg_lapack_s !> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal !> Matrix", Report CS41, Computer Science Dept., Stanford !> University, July 21, 1966. - - pure subroutine stdlib_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 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5458,6 +5458,8 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarrd + + pure subroutine stdlib_slarrj( n, d, e2, ifirst, ilast,rtol, offset, w, werr, work, iwork,& !> Given the initial eigenvalue approximations of T, SLARRJ: !> does bisection to refine the eigenvalues of T, !> W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial @@ -5465,8 +5467,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_slarrj( n, d, e2, ifirst, ilast,rtol, offset, w, werr, work, iwork,& pivmin, spdiam, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5636,7 +5636,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarrj - !> SLARRK: computes one eigenvalue of a symmetric tridiagonal + + pure subroutine stdlib_slarrk( n, iw, gl, gu,d, e2, pivmin, reltol, w, werr, info) + !> SLARRK computes one eigenvalue of a symmetric tridiagonal !> matrix T to suitable accuracy. This is an auxiliary code to be !> called from SSTEMR. !> To avoid overflow, the matrix must be scaled so that its @@ -5645,8 +5647,6 @@ module stdlib_linalg_lapack_s !> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal !> Matrix", Report CS41, Computer Science Dept., Stanford !> University, July 21, 1966. - - pure subroutine stdlib_slarrk( n, iw, gl, gu,d, e2, pivmin, reltol, w, werr, info) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5716,11 +5716,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarrk + + pure subroutine stdlib_slarrr( n, d, e, info ) !> Perform tests to decide whether the symmetric tridiagonal matrix T !> warrants expensive computations which guarantee high relative accuracy !> in the eigenvalues. - - pure subroutine stdlib_slarrr( n, d, e, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5798,9 +5798,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarrr + + pure subroutine stdlib_slartg( f, g, c, s, r ) !> ! !> - !> SLARTG: generates a plane rotation so that + !> SLARTG generates a plane rotation so that !> [ C S ] . [ F ] = [ R ] !> [ -S C ] [ G ] [ 0 ] !> where C**2 + S**2 = 1. @@ -5822,8 +5824,6 @@ module stdlib_linalg_lapack_s !> there are zeros on the diagonal). !> If F exceeds G in magnitude, C will be positive. !> Below, wp=>sp stands for single precision from LA_CONSTANTS module. - - pure subroutine stdlib_slartg( f, g, c, s, r ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5867,7 +5867,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slartg - !> SLARTGP: generates a plane rotation so that + + pure subroutine stdlib_slartgp( f, g, cs, sn, r ) + !> SLARTGP 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 SROTG, @@ -5876,8 +5878,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_slartgp( f, g, cs, sn, r ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5961,7 +5961,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slartgp - !> SLARTGS: generates a plane rotation designed to introduce a bulge in + + pure subroutine stdlib_slartgs( x, y, sigma, cs, sn ) + !> SLARTGS 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 @@ -5969,8 +5971,6 @@ module stdlib_linalg_lapack_s !> [ -SN CS ] [ X * Y ] [ 0 ] !> with R nonnegative. If X^2 - SIGMA and X * Y are 0, then the !> rotation is by PI/2. - - pure subroutine stdlib_slartgs( x, y, sigma, cs, sn ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6017,12 +6017,12 @@ module stdlib_linalg_lapack_s ! end stdlib_slartgs end subroutine stdlib_slartgs - !> SLARTV: applies a vector of real plane rotations to elements of the + + pure subroutine stdlib_slartv( n, x, incx, y, incy, c, s, incc ) + !> SLARTV applies a vector of real plane rotations to elements of the !> real vectors x and y. For i = 1,2,...,n !> ( x(i) ) := ( c(i) s(i) ) ( x(i) ) !> ( y(i) ) ( -s(i) c(i) ) ( y(i) ) - - pure subroutine stdlib_slartv( n, x, incx, y, incy, c, s, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6051,11 +6051,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slartv - !> SLARUV: returns a vector of n random real numbers from a uniform (0,1) - !> distribution (n <= 128). - !> This is an auxiliary routine called by SLARNV and CLARNV. pure subroutine stdlib_slaruv( iseed, n, x ) + !> SLARUV returns a vector of n random real numbers from a uniform (0,1) + !> distribution (n <= 128). + !> This is an auxiliary routine called by SLARNV and CLARNV. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6254,15 +6254,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaruv - !> SLARZ: applies a real elementary reflector H to a real M-by-N + + pure subroutine stdlib_slarz( side, m, n, l, v, incv, tau, c, ldc, work ) + !> SLARZ applies a real elementary reflector H to a real M-by-N !> matrix C, from either the left or the right. H is represented in the !> form !> H = I - tau * v * v**T !> where tau is a real scalar and v is a real vector. !> If tau = 0, then H is taken to be the unit matrix. !> H is a product of k elementary reflectors as returned by STZRZF. - - pure subroutine stdlib_slarz( side, m, n, l, v, incv, tau, c, ldc, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6309,11 +6309,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarz - !> SLARZB: applies a real block reflector H or its transpose H**T to - !> a real distributed M-by-N C from the left or the right. - !> Currently, only STOREV = 'R' and DIRECT = 'B' are supported. pure subroutine stdlib_slarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & + !> SLARZB applies a real block reflector H or its transpose H**T to + !> a real distributed M-by-N C from the left or the right. + !> Currently, only STOREV = 'R' and DIRECT = 'B' are supported. ldc, work, ldwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -6398,7 +6398,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarzb - !> SLARZT: forms the triangular factor T of a real block reflector + + pure subroutine stdlib_slarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) + !> SLARZT forms the triangular factor T of a real 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; @@ -6410,8 +6412,6 @@ module stdlib_linalg_lapack_s !> H(i) is stored in the i-th row of the array V, and !> H = I - V**T * T * V !> Currently, only STOREV = 'R' and DIRECT = 'B' are supported. - - pure subroutine stdlib_slarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6460,13 +6460,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarzt - !> SLAS2: computes the singular values of the 2-by-2 matrix + + pure subroutine stdlib_slas2( f, g, h, ssmin, ssmax ) + !> SLAS2 computes the singular values of the 2-by-2 matrix !> [ F G ] !> [ 0 H ]. !> On return, SSMIN is the smaller singular value and SSMAX is the !> larger singular value. - - pure subroutine stdlib_slas2( f, g, h, ssmin, ssmax ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6524,6 +6524,8 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slas2 + + pure subroutine stdlib_slasd5( i, d, z, delta, rho, dsigma, work ) !> 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 @@ -6532,8 +6534,6 @@ module stdlib_linalg_lapack_s !> 0 <= D(i) < D(j) for i < j . !> We also assume RHO > 0 and that the Euclidean norm of the vector !> Z is one. - - pure subroutine stdlib_slasd5( i, d, z, delta, rho, dsigma, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6619,10 +6619,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd5 - !> SLASDT: creates a tree of subproblems for bidiagonal divide and - !> conquer. pure subroutine stdlib_slasdt( n, lvl, nd, inode, ndiml, ndimr, msub ) + !> SLASDT creates a tree of subproblems for bidiagonal divide and + !> conquer. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6670,10 +6670,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasdt - !> SLASET: initializes an m-by-n matrix A to BETA on the diagonal and - !> ALPHA on the offdiagonals. pure subroutine stdlib_slaset( uplo, m, n, alpha, beta, a, lda ) + !> SLASET initializes an m-by-n matrix A to BETA on the diagonal and + !> ALPHA on the offdiagonals. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6720,10 +6720,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaset - !> SLASQ4: computes an approximation TAU to the smallest eigenvalue - !> using values of d from the previous transform. pure subroutine stdlib_slasq4( i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn,dn1, dn2, tau, & + !> SLASQ4 computes an approximation TAU to the smallest eigenvalue + !> using values of d from the previous transform. ttype, g ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -6928,10 +6928,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasq4 - !> SLASQ5: computes one dqds transform in ping-pong form, one - !> version for IEEE machines another for non IEEE machines. pure subroutine stdlib_slasq5( i0, n0, z, pp, tau, sigma, dmin, dmin1, dmin2,dn, dnm1, dnm2, & + !> SLASQ5 computes one dqds transform in ping-pong form, one + !> version for IEEE machines another for non IEEE machines. ieee, eps ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7156,10 +7156,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasq5 - !> SLASQ6: computes one dqd (shift equal to zero) transform in - !> ping-pong form, with protection against underflow and overflow. pure subroutine stdlib_slasq6( i0, n0, z, pp, dmin, dmin1, dmin2, dn,dnm1, dnm2 ) + !> SLASQ6 computes one dqd (shift equal to zero) transform in + !> ping-pong form, with protection against underflow and overflow. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7266,7 +7266,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasq6 - !> SLASR: applies a sequence of plane rotations to a real matrix A, + + pure subroutine stdlib_slasr( side, pivot, direct, m, n, c, s, a, lda ) + !> SLASR applies a sequence of plane rotations to a real matrix A, !> from either the left or the right. !> When SIDE = 'L', the transformation takes the form !> A := P*A @@ -7317,8 +7319,6 @@ module stdlib_linalg_lapack_s !> ( -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. - - pure subroutine stdlib_slasr( side, pivot, direct, m, n, c, s, a, lda ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7525,12 +7525,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasr + + pure subroutine stdlib_slasrt( id, n, d, info ) !> 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. - - pure subroutine stdlib_slasrt( id, n, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7699,9 +7699,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasrt + + pure subroutine stdlib_slassq( n, x, incx, scl, sumsq ) !> ! !> - !> SLASSQ: returns the values scl and smsq such that + !> SLASSQ 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. @@ -7719,8 +7721,6 @@ module stdlib_linalg_lapack_s !> and !> TINY*EPS -- tiniest representable number; !> HUGE -- biggest representable number. - - pure subroutine stdlib_slassq( n, x, incx, scl, sumsq ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7816,7 +7816,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slassq - !> SLASV2: computes the singular value decomposition of a 2-by-2 + + pure subroutine stdlib_slasv2( f, g, h, ssmin, ssmax, snr, csr, snl, csl ) + !> SLASV2 computes the singular value decomposition of a 2-by-2 !> triangular matrix !> [ F G ] !> [ 0 H ]. @@ -7825,8 +7827,6 @@ module stdlib_linalg_lapack_s !> right singular vectors for abs(SSMAX), giving the decomposition !> [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ] !> [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ]. - - pure subroutine stdlib_slasv2( f, g, h, ssmin, ssmax, snr, csr, snl, csl ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7961,10 +7961,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasv2 - !> SLASWP: performs a series of row interchanges on the matrix A. - !> One row interchange is initiated for each of rows K1 through K2 of A. pure subroutine stdlib_slaswp( n, a, lda, k1, k2, ipiv, incx ) + !> SLASWP performs a series of row interchanges on the matrix A. + !> One row interchange is initiated for each of rows K1 through K2 of A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8028,12 +8028,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaswp - !> SLASY2: solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in + + pure subroutine stdlib_slasy2( ltranl, ltranr, isgn, n1, n2, tl, ldtl, tr,ldtr, b, ldb, & + !> SLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in !> op(TL)*X + ISGN*X*op(TR) = SCALE*B, !> where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or !> -1. op(T) = T or T**T, where T**T denotes the transpose of T. - - pure subroutine stdlib_slasy2( ltranl, ltranr, isgn, n1, n2, tl, ldtl, tr,ldtr, b, ldb, & scale, x, ldx, xnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8288,7 +8288,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasy2 - !> SLASYF: computes a partial factorization of a real symmetric matrix A + + pure subroutine stdlib_slasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) + !> SLASYF computes a partial factorization of a real 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: @@ -8300,8 +8302,6 @@ module stdlib_linalg_lapack_s !> SLASYF is an auxiliary routine called by SSYTRF. It uses blocked code !> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or !> A22 (if UPLO = 'L'). - - pure subroutine stdlib_slasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8725,7 +8725,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasyf - !> SLASYF_RK: computes a partial factorization of a real symmetric + + pure subroutine stdlib_slasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) + !> SLASYF_RK computes a partial factorization of a real 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: @@ -8737,8 +8739,6 @@ module stdlib_linalg_lapack_s !> SLASYF_RK is an auxiliary routine called by SSYTRF_RK. It uses !> blocked code (calling Level 3 BLAS) to update the submatrix !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). - - pure subroutine stdlib_slasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9166,7 +9166,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasyf_rk - !> SLASYF_ROOK: computes a partial factorization of a real symmetric + + pure subroutine stdlib_slasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) + !> SLASYF_ROOK computes a partial factorization of a real 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: @@ -9178,8 +9180,6 @@ module stdlib_linalg_lapack_s !> SLASYF_ROOK is an auxiliary routine called by SSYTRF_ROOK. It uses !> blocked code (calling Level 3 BLAS) to update the submatrix !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). - - pure subroutine stdlib_slasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9627,7 +9627,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasyf_rook - !> SLATBS: solves one of the triangular systems + + pure subroutine stdlib_slatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & + !> SLATBS solves one of the triangular systems !> A *x = s*b or A**T*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 @@ -9637,8 +9639,6 @@ module stdlib_linalg_lapack_s !> overflow, the Level 2 BLAS routine STBSV 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. - - pure subroutine stdlib_slatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10047,7 +10047,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slatbs - !> SLATPS: solves one of the triangular systems + + pure subroutine stdlib_slatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) + !> SLATPS solves one of the triangular systems !> A *x = s*b or A**T*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 @@ -10057,8 +10059,6 @@ module stdlib_linalg_lapack_s !> unscaled problem will not cause overflow, the Level 2 BLAS routine !> STPSV 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. - - pure subroutine stdlib_slatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10465,7 +10465,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slatps - !> SLATRS: solves one of the triangular systems + + pure subroutine stdlib_slatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) + !> SLATRS solves one of the triangular systems !> A *x = s*b or A**T*x = s*b !> with scaling to prevent overflow. Here A is an upper or lower !> triangular matrix, A**T denotes the transpose of A, x and b are @@ -10475,8 +10477,6 @@ module stdlib_linalg_lapack_s !> overflow, the Level 2 BLAS routine STRSV 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. - - pure subroutine stdlib_slatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10866,7 +10866,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slatrs - !> SLAUU2: computes the product U * U**T or L**T * L, where the triangular + + pure subroutine stdlib_slauu2( uplo, n, a, lda, info ) + !> SLAUU2 computes the product U * U**T or L**T * L, where the triangular !> factor U or L is stored in the upper or lower triangular part of !> the array A. !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, @@ -10874,8 +10876,6 @@ module stdlib_linalg_lapack_s !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, !> overwriting the factor L in A. !> This is the unblocked form of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_slauu2( uplo, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10938,7 +10938,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slauu2 - !> SLAUUM: computes the product U * U**T or L**T * L, where the triangular + + pure subroutine stdlib_slauum( uplo, n, a, lda, info ) + !> SLAUUM computes the product U * U**T or L**T * L, where the triangular !> factor U or L is stored in the upper or lower triangular part of !> the array A. !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, @@ -10946,8 +10948,6 @@ module stdlib_linalg_lapack_s !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, !> overwriting the factor L in A. !> This is the blocked form of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_slauum( uplo, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11021,7 +11021,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slauum - !> SORBDB6: orthogonalizes the column vector + + pure subroutine stdlib_sorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & + !> SORBDB6 orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] !> with respect to the columns of @@ -11030,8 +11032,6 @@ module stdlib_linalg_lapack_s !> The columns of Q must be orthonormal. !> If the projection is zero according to Kahan's "twice is enough" !> criterion, then the zero vector is returned. - - pure subroutine stdlib_sorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -11149,13 +11149,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorbdb6 - !> SORG2L: generates an m by n real matrix Q with orthonormal columns, + + pure subroutine stdlib_sorg2l( m, n, k, a, lda, tau, work, info ) + !> SORG2L generates an m by n real matrix Q with orthonormal columns, !> which is defined as the last n columns of a product of k elementary !> reflectors of order m !> Q = H(k) . . . H(2) H(1) !> as returned by SGEQLF. - - pure subroutine stdlib_sorg2l( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11213,13 +11213,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorg2l - !> SORG2R: generates an m by n real matrix Q with orthonormal columns, + + pure subroutine stdlib_sorg2r( m, n, k, a, lda, tau, work, info ) + !> SORG2R generates an m by n real matrix Q with orthonormal columns, !> which is defined as the first n columns of a product of k elementary !> reflectors of order m !> Q = H(1) H(2) . . . H(k) !> as returned by SGEQRF. - - pure subroutine stdlib_sorg2r( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11278,13 +11278,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorg2r - !> SORGL2: generates an m by n real matrix Q with orthonormal rows, + + pure subroutine stdlib_sorgl2( m, n, k, a, lda, tau, work, info ) + !> SORGL2 generates an m by n real matrix Q with orthonormal rows, !> which is defined as the first m rows of a product of k elementary !> reflectors of order n !> Q = H(k) . . . H(2) H(1) !> as returned by SGELQF. - - pure subroutine stdlib_sorgl2( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11347,13 +11347,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgl2 - !> SORGLQ: generates an M-by-N real matrix Q with orthonormal rows, + + pure subroutine stdlib_sorglq( m, n, k, a, lda, tau, work, lwork, info ) + !> SORGLQ generates an M-by-N real matrix Q with orthonormal rows, !> which is defined as the first M rows of a product of K elementary !> reflectors of order N !> Q = H(k) . . . H(2) H(1) !> as returned by SGELQF. - - pure subroutine stdlib_sorglq( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11463,13 +11463,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorglq - !> SORGQL: generates an M-by-N real matrix Q with orthonormal columns, + + pure subroutine stdlib_sorgql( m, n, k, a, lda, tau, work, lwork, info ) + !> SORGQL generates an M-by-N real matrix Q with orthonormal columns, !> which is defined as the last N columns of a product of K elementary !> reflectors of order M !> Q = H(k) . . . H(2) H(1) !> as returned by SGEQLF. - - pure subroutine stdlib_sorgql( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11584,13 +11584,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgql - !> SORGQR: generates an M-by-N real matrix Q with orthonormal columns, + + pure subroutine stdlib_sorgqr( m, n, k, a, lda, tau, work, lwork, info ) + !> SORGQR generates an M-by-N real matrix Q with orthonormal columns, !> which is defined as the first N columns of a product of K elementary !> reflectors of order M !> Q = H(1) H(2) . . . H(k) !> as returned by SGEQRF. - - pure subroutine stdlib_sorgqr( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11700,13 +11700,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgqr - !> SORGR2: generates an m by n real matrix Q with orthonormal rows, + + pure subroutine stdlib_sorgr2( m, n, k, a, lda, tau, work, info ) + !> SORGR2 generates an m by n real matrix Q with orthonormal rows, !> which is defined as the last m rows of a product of k elementary !> reflectors of order n !> Q = H(1) H(2) . . . H(k) !> as returned by SGERQF. - - pure subroutine stdlib_sorgr2( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11766,13 +11766,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgr2 - !> SORGRQ: generates an M-by-N real matrix Q with orthonormal rows, + + pure subroutine stdlib_sorgrq( m, n, k, a, lda, tau, work, lwork, info ) + !> SORGRQ generates an M-by-N real matrix Q with orthonormal rows, !> which is defined as the last M rows of a product of K elementary !> reflectors of order N !> Q = H(1) H(2) . . . H(k) !> as returned by SGERQF. - - pure subroutine stdlib_sorgrq( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11887,7 +11887,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgrq - !> SORGTSQR_ROW: generates an M-by-N real matrix Q_out with + + pure subroutine stdlib_sorgtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) + !> SORGTSQR_ROW generates an M-by-N real matrix Q_out with !> orthonormal columns from the output of SLATSQR. These N orthonormal !> columns are the first N columns of a product of complex unitary !> matrices Q(k)_in of order M, which are returned by SLATSQR in @@ -11902,8 +11904,6 @@ module stdlib_linalg_lapack_s !> starting in the bottom row block and continues to the top row block !> (hence _ROW in the routine name). This sweep is in reverse order of !> the order in which SLATSQR generates the output blocks. - - pure subroutine stdlib_sorgtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12212,7 +12212,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorm22 - !> SORM2L: overwrites the general real m by n matrix C with + + pure subroutine stdlib_sorm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> SORM2L overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T * C if SIDE = 'L' and TRANS = 'T', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -12222,8 +12224,6 @@ module stdlib_linalg_lapack_s !> Q = H(k) . . . H(2) H(1) !> as returned by SGEQLF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_sorm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12306,7 +12306,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorm2l - !> SORM2R: overwrites the general real m by n matrix C with + + pure subroutine stdlib_sorm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> SORM2R overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T* C if SIDE = 'L' and TRANS = 'T', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -12316,8 +12318,6 @@ module stdlib_linalg_lapack_s !> Q = H(1) H(2) . . . H(k) !> as returned by SGEQRF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_sorm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12405,7 +12405,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorm2r - !> SORML2: overwrites the general real m by n matrix C with + + pure subroutine stdlib_sorml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> SORML2 overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T* C if SIDE = 'L' and TRANS = 'T', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -12415,8 +12417,6 @@ module stdlib_linalg_lapack_s !> Q = H(k) . . . H(2) H(1) !> as returned by SGELQF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_sorml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12504,7 +12504,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorml2 - !> SORMLQ: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_sormlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> SORMLQ overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -12513,8 +12515,6 @@ module stdlib_linalg_lapack_s !> Q = H(k) . . . H(2) H(1) !> as returned by SGELQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_sormlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12647,7 +12647,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormlq - !> SORMQL: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_sormql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> SORMQL overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -12656,8 +12658,6 @@ module stdlib_linalg_lapack_s !> Q = H(k) . . . H(2) H(1) !> as returned by SGEQLF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_sormql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12784,7 +12784,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormql - !> SORMQR: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_sormqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> SORMQR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -12793,8 +12795,6 @@ module stdlib_linalg_lapack_s !> Q = H(1) H(2) . . . H(k) !> as returned by SGEQRF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_sormqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12921,7 +12921,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormqr - !> SORMR2: overwrites the general real m by n matrix C with + + pure subroutine stdlib_sormr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> SORMR2 overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T* C if SIDE = 'L' and TRANS = 'T', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -12931,8 +12933,6 @@ module stdlib_linalg_lapack_s !> Q = H(1) H(2) . . . H(k) !> as returned by SGERQF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_sormr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13015,7 +13015,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormr2 - !> SORMR3: overwrites the general real m by n matrix C with + + pure subroutine stdlib_sormr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) + !> SORMR3 overwrites the general real m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**T* C if SIDE = 'L' and TRANS = 'C', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -13025,8 +13027,6 @@ module stdlib_linalg_lapack_s !> Q = H(1) H(2) . . . H(k) !> as returned by STZRZF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_sormr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13114,7 +13114,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormr3 - !> SORMRQ: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_sormrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> SORMRQ overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -13123,8 +13125,6 @@ module stdlib_linalg_lapack_s !> Q = H(1) H(2) . . . H(k) !> as returned by SGERQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_sormrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13257,7 +13257,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormrq - !> SORMRZ: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_sormrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & + !> SORMRZ overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -13266,8 +13268,6 @@ module stdlib_linalg_lapack_s !> Q = H(1) H(2) . . . H(k) !> as returned by STZRZF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_sormrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13409,7 +13409,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormrz - !> SPBEQU: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_spbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) + !> SPBEQU computes row and column scalings intended to equilibrate a !> symmetric positive definite band matrix A and reduce its condition !> number (with respect to the two-norm). S contains the scale factors, !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with @@ -13417,8 +13419,6 @@ module stdlib_linalg_lapack_s !> choice of S puts the condition number of B within a factor N of the !> smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_spbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13496,7 +13496,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spbequ - !> SPBSTF: computes a split Cholesky factorization of a real + + pure subroutine stdlib_spbstf( uplo, n, kd, ab, ldab, info ) + !> SPBSTF computes a split Cholesky factorization of a real !> symmetric positive definite band matrix A. !> This routine is designed to be used in conjunction with SSBGST. !> The factorization has the form A = S**T*S where S is a band matrix @@ -13505,8 +13507,6 @@ module stdlib_linalg_lapack_s !> ( M L ) !> where U is upper triangular of order m = (n+kd)/2, and L is lower !> triangular of order n-m. - - pure subroutine stdlib_spbstf( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13614,7 +13614,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spbstf - !> SPBTF2: computes the Cholesky factorization of a real symmetric + + pure subroutine stdlib_spbtf2( uplo, n, kd, ab, ldab, info ) + !> SPBTF2 computes the Cholesky factorization of a real symmetric !> positive definite band matrix A. !> The factorization has the form !> A = U**T * U , if UPLO = 'U', or @@ -13622,8 +13624,6 @@ module stdlib_linalg_lapack_s !> where U is an upper triangular matrix, U**T is the transpose of U, and !> L is lower triangular. !> This is the unblocked version of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_spbtf2( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13701,11 +13701,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spbtf2 - !> SPBTRS: solves a system of linear equations A*X = B with a symmetric - !> positive definite band matrix A using the Cholesky factorization - !> A = U**T*U or A = L*L**T computed by SPBTRF. pure subroutine stdlib_spbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) + !> SPBTRS solves a system of linear equations A*X = B with a symmetric + !> positive definite band matrix A using the Cholesky factorization + !> A = U**T*U or A = L*L**T computed by SPBTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13769,7 +13769,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spbtrs - !> SPOEQU: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_spoequ( n, a, lda, s, scond, amax, info ) + !> SPOEQU computes row and column scalings intended to equilibrate a !> symmetric positive definite matrix A and reduce its condition number !> (with respect to the two-norm). S contains the scale factors, !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with @@ -13777,8 +13779,6 @@ module stdlib_linalg_lapack_s !> choice of S puts the condition number of B within a factor N of the !> smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_spoequ( n, a, lda, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13843,7 +13843,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spoequ - !> SPOEQUB: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_spoequb( n, a, lda, s, scond, amax, info ) + !> SPOEQUB computes row and column scalings intended to equilibrate a !> symmetric positive definite matrix A and reduce its condition number !> (with respect to the two-norm). S contains the scale factors, !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with @@ -13856,8 +13858,6 @@ module stdlib_linalg_lapack_s !> these factors introduces no additional rounding errors. However, the !> scaled diagonal entries are no longer approximately 1 but lie !> between sqrt(radix) and 1/sqrt(radix). - - pure subroutine stdlib_spoequb( n, a, lda, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13925,11 +13925,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spoequb - !> SPOTRS: solves a system of linear equations A*X = B with a symmetric - !> positive definite matrix A using the Cholesky factorization - !> A = U**T*U or A = L*L**T computed by SPOTRF. pure subroutine stdlib_spotrs( uplo, n, nrhs, a, lda, b, ldb, info ) + !> SPOTRS solves a system of linear equations A*X = B with a symmetric + !> positive definite matrix A using the Cholesky factorization + !> A = U**T*U or A = L*L**T computed by SPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13987,7 +13987,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spotrs - !> SPPEQU: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_sppequ( uplo, n, ap, s, scond, amax, info ) + !> SPPEQU computes row and column scalings intended to equilibrate a !> symmetric positive definite matrix A in packed storage and reduce !> its condition number (with respect to the two-norm). S contains the !> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix @@ -13995,8 +13997,6 @@ module stdlib_linalg_lapack_s !> This choice of S puts the condition number of B within a factor N of !> the smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_sppequ( uplo, n, ap, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14080,14 +14080,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sppequ - !> SPPTRF: computes the Cholesky factorization of a real symmetric + + pure subroutine stdlib_spptrf( uplo, n, ap, info ) + !> SPPTRF computes the Cholesky factorization of a real symmetric !> positive definite matrix A stored in packed format. !> The factorization has the form !> A = U**T * U, if UPLO = 'U', or !> A = L * L**T, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. - - pure subroutine stdlib_spptrf( uplo, n, ap, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14165,11 +14165,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spptrf - !> SPPTRS: solves a system of linear equations A*X = B with a symmetric - !> positive definite matrix A in packed storage using the Cholesky - !> factorization A = U**T*U or A = L*L**T computed by SPPTRF. pure subroutine stdlib_spptrs( uplo, n, nrhs, ap, b, ldb, info ) + !> SPPTRS solves a system of linear equations A*X = B with a symmetric + !> positive definite matrix A in packed storage using the Cholesky + !> factorization A = U**T*U or A = L*L**T computed by SPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14227,15 +14227,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spptrs - !> SPTCON: computes the reciprocal of the condition number (in the + + pure subroutine stdlib_sptcon( n, d, e, anorm, rcond, work, info ) + !> SPTCON computes the reciprocal of the condition number (in the !> 1-norm) of a real symmetric positive definite tridiagonal matrix !> using the factorization A = L*D*L**T or A = U**T*D*U computed by !> SPTTRF. !> Norm(inv(A)) is computed by a direct method, and the reciprocal of !> the condition number is computed as !> RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_sptcon( n, d, e, anorm, rcond, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14300,11 +14300,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sptcon - !> SPTTRF: computes the L*D*L**T factorization of a real symmetric - !> positive definite tridiagonal matrix A. The factorization may also - !> be regarded as having the form A = U**T*D*U. pure subroutine stdlib_spttrf( n, d, e, info ) + !> SPTTRF computes the L*D*L**T factorization of a real symmetric + !> positive definite tridiagonal matrix A. The factorization may also + !> be regarded as having the form A = U**T*D*U. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14383,14 +14383,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spttrf - !> SPTTS2: solves a tridiagonal system of the form + + pure subroutine stdlib_sptts2( n, nrhs, d, e, b, ldb ) + !> SPTTS2 solves a tridiagonal system of the form !> A * X = B !> using the L*D*L**T factorization of A computed by SPTTRF. D is a !> diagonal matrix specified in the vector D, L is a unit bidiagonal !> matrix whose subdiagonal is specified in the vector E, and X and B !> are N by NRHS matrices. - - pure subroutine stdlib_sptts2( n, nrhs, d, e, b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14424,11 +14424,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sptts2 - !> SRSCL: multiplies an n-element real vector x by the real scalar 1/a. - !> This is done without overflow or underflow as long as - !> the final result x/a does not overflow or underflow. pure subroutine stdlib_srscl( n, sa, sx, incx ) + !> SRSCL multiplies an n-element real vector x by the real scalar 1/a. + !> This is done without overflow or underflow as long as + !> the final result x/a does not overflow or underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14478,15 +14478,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_srscl - !> SSBGST: reduces a real symmetric-definite banded generalized + + pure subroutine stdlib_ssbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, info ) + !> SSBGST reduces a real symmetric-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**T*S by SPBSTF, using a !> split Cholesky factorization. A is overwritten by C = X**T*A*X, where !> X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the !> bandwidth of A. - - pure subroutine stdlib_ssbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15391,11 +15391,11 @@ module stdlib_linalg_lapack_s go to 490 end subroutine stdlib_ssbgst - !> SSBTRD: reduces a real symmetric band matrix A to symmetric - !> tridiagonal form T by an orthogonal similarity transformation: - !> Q**T * A * Q = T. pure subroutine stdlib_ssbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) + !> SSBTRD reduces a real symmetric band matrix A to symmetric + !> tridiagonal form T by an orthogonal similarity transformation: + !> Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15722,16 +15722,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssbtrd + + pure subroutine stdlib_ssfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) !> Level 3 BLAS like routine for C in RFP Format. - !> SSFRK: performs one of the symmetric rank--k operations + !> SSFRK performs one of the symmetric rank--k operations !> C := alpha*A*A**T + beta*C, !> or !> C := alpha*A**T*A + beta*C, !> where alpha and beta are real scalars, C is an n--by--n symmetric !> matrix and A is an n--by--k matrix in the first case and a k--by--n !> matrix in the second case. - - pure subroutine stdlib_ssfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15978,15 +15978,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssfrk - !> SSPGST: reduces a real symmetric-definite generalized eigenproblem + + pure subroutine stdlib_sspgst( itype, uplo, n, ap, bp, info ) + !> SSPGST reduces a real symmetric-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**T)*A*inv(U) or inv(L)*A*inv(L**T) !> 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**T or L**T*A*L. !> B must have been previously factorized as U**T*U or L*L**T by SPPTRF. - - pure subroutine stdlib_sspgst( itype, uplo, n, ap, bp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16100,14 +16100,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspgst - !> SSPTRF: computes the factorization of a real symmetric matrix A stored + + pure subroutine stdlib_ssptrf( uplo, n, ap, ipiv, info ) + !> SSPTRF computes the factorization of a real symmetric matrix A stored !> in packed format using the Bunch-Kaufman diagonal pivoting method: !> 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 symmetric and block diagonal with !> 1-by-1 and 2-by-2 diagonal blocks. - - pure subroutine stdlib_ssptrf( uplo, n, ap, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16423,11 +16423,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssptrf - !> SSPTRI: computes the inverse of a real symmetric indefinite matrix - !> A in packed storage using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by SSPTRF. pure subroutine stdlib_ssptri( uplo, n, ap, ipiv, work, info ) + !> SSPTRI computes the inverse of a real symmetric indefinite matrix + !> A in packed storage using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by SSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16634,11 +16634,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssptri - !> SSPTRS: solves a system of linear equations A*X = B with a real - !> symmetric matrix A stored in packed format using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by SSPTRF. pure subroutine stdlib_ssptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) + !> SSPTRS solves a system of linear equations A*X = B with a real + !> symmetric matrix A stored in packed format using the factorization + !> A = U*D*U**T or A = L*D*L**T computed by SSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16854,7 +16854,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssptrs - !> SSTEBZ: computes the eigenvalues of a symmetric tridiagonal + + pure subroutine stdlib_sstebz( range, order, n, vl, vu, il, iu, abstol, d, e,m, nsplit, w, & + !> SSTEBZ computes the eigenvalues of a symmetric tridiagonal !> matrix T. The user may ask for all eigenvalues, all eigenvalues !> in the half-open interval (VL, VU], or the IL-th through IU-th !> eigenvalues. @@ -16864,8 +16866,6 @@ module stdlib_linalg_lapack_s !> See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal !> Matrix", Report CS41, Computer Science Dept., Stanford !> University, July 21, 1966. - - pure subroutine stdlib_sstebz( range, order, n, vl, vu, il, iu, abstol, d, e,m, nsplit, w, & iblock, isplit, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17247,11 +17247,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sstebz - !> SSYCONV: convert A given by TRF into L and D and vice-versa. - !> Get Non-diag elements of D (returned in workspace) and - !> apply or reverse permutation done in TRF. pure subroutine stdlib_ssyconv( uplo, way, n, a, lda, ipiv, e, info ) + !> SSYCONV convert A given by TRF into L and D and vice-versa. + !> Get Non-diag elements of D (returned in workspace) and + !> apply or reverse permutation done in TRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17452,8 +17452,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyconv + + pure subroutine stdlib_ssyconvf( uplo, way, n, a, lda, e, ipiv, info ) !> If parameter WAY = 'C': - !> SSYCONVF: converts the factorization output format used in + !> SSYCONVF converts the factorization output format used in !> SSYTRF provided on entry in parameter A into the factorization !> output format used in SSYTRF_RK (or SSYTRF_BK) that is stored !> on exit in parameters A and E. It also converts in place details of @@ -17467,8 +17469,6 @@ module stdlib_linalg_lapack_s !> on exit in parameter A. It also converts in place details of !> the intechanges stored in IPIV from the format used in SSYTRF_RK !> (or SSYTRF_BK) into the format used in SSYTRF. - - pure subroutine stdlib_ssyconvf( uplo, way, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17707,8 +17707,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyconvf + + pure subroutine stdlib_ssyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) !> If parameter WAY = 'C': - !> SSYCONVF_ROOK: converts the factorization output format used in + !> SSYCONVF_ROOK converts the factorization output format used in !> SSYTRF_ROOK provided on entry in parameter A into the factorization !> output format used in SSYTRF_RK (or SSYTRF_BK) that is stored !> on exit in parameters A and E. IPIV format for SSYTRF_ROOK and @@ -17720,8 +17722,6 @@ module stdlib_linalg_lapack_s !> the factorization output format used in SSYTRF_ROOK that is stored !> on exit in parameter A. IPIV format for SSYTRF_ROOK and !> SSYTRF_RK (or SSYTRF_BK) is the same and is not converted. - - pure subroutine stdlib_ssyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17960,15 +17960,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyconvf_rook - !> SSYEQUB: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_ssyequb( uplo, n, a, lda, s, scond, amax, work, info ) + !> SSYEQUB computes row and column scalings intended to equilibrate a !> symmetric 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. - - pure subroutine stdlib_ssyequb( uplo, n, a, lda, s, scond, amax, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18136,15 +18136,15 @@ module stdlib_linalg_lapack_s scond = max( smin, smlnum ) / min( smax, bignum ) end subroutine stdlib_ssyequb - !> SSYGS2: reduces a real symmetric-definite generalized eigenproblem + + pure subroutine stdlib_ssygs2( itype, uplo, n, a, lda, b, ldb, info ) + !> SSYGS2 reduces a real symmetric-definite generalized eigenproblem !> to standard form. !> If ITYPE = 1, the problem is A*x = lambda*B*x, !> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) !> 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**T or L**T *A*L. !> B must have been previously factorized as U**T *U or L*L**T by SPOTRF. - - pure subroutine stdlib_ssygs2( itype, uplo, n, a, lda, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18259,15 +18259,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssygs2 - !> SSYGST: reduces a real symmetric-definite generalized eigenproblem + + pure subroutine stdlib_ssygst( itype, uplo, n, a, lda, b, ldb, info ) + !> SSYGST reduces a real symmetric-definite generalized eigenproblem !> to standard form. !> If ITYPE = 1, the problem is A*x = lambda*B*x, !> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) !> 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**T or L**T*A*L. !> B must have been previously factorized as U**T*U or L*L**T by SPOTRF. - - pure subroutine stdlib_ssygst( itype, uplo, n, a, lda, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18398,10 +18398,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssygst - !> SSYSWAPR: applies an elementary permutation on the rows and the columns of - !> a symmetric matrix. pure subroutine stdlib_ssyswapr( uplo, n, a, lda, i1, i2) + !> SSYSWAPR applies an elementary permutation on the rows and the columns of + !> a symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18466,7 +18466,9 @@ module stdlib_linalg_lapack_s endif end subroutine stdlib_ssyswapr - !> SSYTF2_RK: computes the factorization of a real symmetric matrix A + + pure subroutine stdlib_ssytf2_rk( uplo, n, a, lda, e, ipiv, info ) + !> SSYTF2_RK computes the factorization of a real symmetric matrix A !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), !> where U (or L) is unit upper (or lower) triangular matrix, @@ -18475,8 +18477,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_ssytf2_rk( uplo, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18918,15 +18918,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytf2_rk - !> SSYTF2_ROOK: computes the factorization of a real symmetric matrix A + + pure subroutine stdlib_ssytf2_rook( uplo, n, a, lda, ipiv, info ) + !> SSYTF2_ROOK computes the factorization of a real symmetric matrix A !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: !> 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, U**T is the transpose of U, and D is symmetric 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. - - pure subroutine stdlib_ssytf2_rook( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19329,7 +19329,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytf2_rook - !> SSYTRF_RK: computes the factorization of a real symmetric matrix A + + pure subroutine stdlib_ssytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) + !> SSYTRF_RK computes the factorization of a real symmetric matrix A !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), !> where U (or L) is unit upper (or lower) triangular matrix, @@ -19338,8 +19340,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_ssytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19495,7 +19495,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrf_rk - !> SSYTRF_ROOK: computes the factorization of a real symmetric matrix A + + pure subroutine stdlib_ssytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) + !> SSYTRF_ROOK computes the factorization of a real symmetric 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 @@ -19503,8 +19505,6 @@ module stdlib_linalg_lapack_s !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_ssytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19623,11 +19623,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrf_rook - !> SSYTRI: computes the inverse of a real symmetric indefinite matrix - !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by - !> SSYTRF. pure subroutine stdlib_ssytri( uplo, n, a, lda, ipiv, work, info ) + !> SSYTRI computes the inverse of a real symmetric indefinite matrix + !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by + !> SSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19811,11 +19811,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytri - !> SSYTRI_ROOK: computes the inverse of a real symmetric - !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T - !> computed by SSYTRF_ROOK. pure subroutine stdlib_ssytri_rook( uplo, n, a, lda, ipiv, work, info ) + !> SSYTRI_ROOK computes the inverse of a real symmetric + !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T + !> computed by SSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20039,11 +20039,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytri_rook - !> SSYTRS: solves a system of linear equations A*X = B with a real - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by SSYTRF. pure subroutine stdlib_ssytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) + !> SSYTRS solves a system of linear equations A*X = B with a real + !> symmetric matrix A using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by SSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20249,11 +20249,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrs - !> SSYTRS2: solves a system of linear equations A*X = B with a real - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by SSYTRF and converted by SSYCONV. pure subroutine stdlib_ssytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) + !> SSYTRS2 solves a system of linear equations A*X = B with a real + !> symmetric matrix A using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by SSYTRF and converted by SSYCONV. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20427,7 +20427,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrs2 - !> SSYTRS_3: solves a system of linear equations A * X = B with a real + + pure subroutine stdlib_ssytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) + !> SSYTRS_3 solves a system of linear equations A * X = B with a real !> symmetric matrix A using the factorization computed !> by SSYTRF_RK or SSYTRF_BK: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), @@ -20436,8 +20438,6 @@ module stdlib_linalg_lapack_s !> matrix, P**T is the transpose of P, and D is symmetric and block !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. !> This algorithm is using Level 3 BLAS. - - pure subroutine stdlib_ssytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20584,11 +20584,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrs_3 - !> SSYTRS_AA: solves a system of linear equations A*X = B with a real - !> symmetric matrix A using the factorization A = U**T*T*U or - !> A = L*T*L**T computed by SSYTRF_AA. pure subroutine stdlib_ssytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) + !> SSYTRS_AA solves a system of linear equations A*X = B with a real + !> symmetric matrix A using the factorization A = U**T*T*U or + !> A = L*T*L**T computed by SSYTRF_AA. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20711,11 +20711,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrs_aa - !> SSYTRS_ROOK: solves a system of linear equations A*X = B with - !> a real symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by SSYTRF_ROOK. pure subroutine stdlib_ssytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) + !> SSYTRS_ROOK solves a system of linear equations A*X = B with + !> a real symmetric matrix A using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by SSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20933,14 +20933,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrs_rook - !> STBRFS: provides error bounds and backward error estimates for the + + pure subroutine stdlib_stbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& + !> STBRFS provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular band !> coefficient matrix. !> The solution matrix X must be computed by STBTRS or some other !> means before entering this routine. STBRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_stbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21171,12 +21171,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stbrfs - !> STBTRS: solves a triangular system of the form + + pure subroutine stdlib_stbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) + !> STBTRS solves a triangular system of the form !> A * X = B or A**T * X = B, !> where A is a triangular band matrix of order N, and B is an !> N-by NRHS matrix. A check is made to verify that A is nonsingular. - - pure subroutine stdlib_stbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21244,16 +21244,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stbtrs + + pure subroutine stdlib_stfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) !> Level 3 BLAS like routine for A in RFP Format. - !> STFSM: solves the matrix equation + !> STFSM solves the matrix equation !> op( A )*X = alpha*B or X*op( A ) = alpha*B !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**T. !> A is in Rectangular Full Packed (RFP) Format. !> The matrix X is overwritten on B. - - pure subroutine stdlib_stfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21746,10 +21746,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stfsm - !> STFTTP: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard packed format (TP). pure subroutine stdlib_stfttp( transr, uplo, n, arf, ap, info ) + !> STFTTP copies a triangular matrix A from rectangular full packed + !> format (TF) to standard packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22002,10 +22002,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stfttp - !> STFTTR: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard full format (TR). pure subroutine stdlib_stfttr( transr, uplo, n, arf, a, lda, info ) + !> STFTTR copies a triangular matrix A from rectangular full packed + !> format (TF) to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22231,11 +22231,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stfttr - !> STPRFB: applies a real "triangular-pentagonal" block reflector H or its - !> conjugate transpose H^H to a real matrix C, which is composed of two - !> blocks A and B, either from the left or right. pure subroutine stdlib_stprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & + !> STPRFB applies a real "triangular-pentagonal" block reflector H or its + !> conjugate transpose H^H to a real matrix C, which is composed of two + !> blocks A and B, either from the left or right. lda, b, ldb, work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22649,14 +22649,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stprfb - !> STPRFS: provides error bounds and backward error estimates for the + + pure subroutine stdlib_stprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & + !> STPRFS provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular packed !> coefficient matrix. !> The solution matrix X must be computed by STPTRS or some other !> means before entering this routine. STPRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_stprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22894,10 +22894,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stprfs - !> STPTRI: computes the inverse of a real upper or lower triangular - !> matrix A stored in packed format. pure subroutine stdlib_stptri( uplo, diag, n, ap, info ) + !> STPTRI computes the inverse of a real upper or lower triangular + !> matrix A stored in packed format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22984,13 +22984,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stptri - !> STPTRS: solves a triangular system of the form + + pure subroutine stdlib_stptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) + !> STPTRS solves a triangular system of the form !> A * X = B or A**T * X = B, !> where A is a triangular matrix of order N stored in packed format, !> and B is an N-by-NRHS matrix. A check is made to verify that A is !> nonsingular. - - pure subroutine stdlib_stptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23057,10 +23057,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stptrs - !> STPTTF: copies a triangular matrix A from standard packed format (TP) - !> to rectangular full packed format (TF). pure subroutine stdlib_stpttf( transr, uplo, n, ap, arf, info ) + !> STPTTF copies a triangular matrix A from standard packed format (TP) + !> to rectangular full packed format (TF). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23299,10 +23299,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stpttf - !> STPTTR: copies a triangular matrix A from standard packed format (TP) - !> to standard full format (TR). pure subroutine stdlib_stpttr( uplo, n, ap, a, lda, info ) + !> STPTTR copies a triangular matrix A from standard packed format (TP) + !> to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23353,14 +23353,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stpttr - !> STRRFS: provides error bounds and backward error estimates for the + + pure subroutine stdlib_strrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& + !> STRRFS provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular !> coefficient matrix. !> The solution matrix X must be computed by STRTRS or some other !> means before entering this routine. STRRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_strrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23588,11 +23588,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strrfs - !> STRTI2: computes the inverse of a real upper or lower triangular - !> matrix. - !> This is the Level 2 BLAS version of the algorithm. pure subroutine stdlib_strti2( uplo, diag, n, a, lda, info ) + !> STRTI2 computes the inverse of a real upper or lower triangular + !> matrix. + !> This is the Level 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23662,11 +23662,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strti2 - !> STRTRI: computes the inverse of a real upper or lower triangular - !> matrix A. - !> This is the Level 3 BLAS version of the algorithm. pure subroutine stdlib_strtri( uplo, diag, n, a, lda, info ) + !> STRTRI computes the inverse of a real upper or lower triangular + !> matrix A. + !> This is the Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23749,12 +23749,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strtri - !> STRTRS: solves a triangular system of the form + + pure subroutine stdlib_strtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) + !> STRTRS solves a triangular system of the form !> A * X = B or A**T * X = B, !> where A is a triangular matrix of order N, and B is an N-by-NRHS !> matrix. A check is made to verify that A is nonsingular. - - pure subroutine stdlib_strtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23809,10 +23809,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strtrs - !> STRTTF: copies a triangular matrix A from standard full format (TR) - !> to rectangular full packed format (TF) . pure subroutine stdlib_strttf( transr, uplo, n, a, lda, arf, info ) + !> STRTTF copies a triangular matrix A from standard full format (TR) + !> to rectangular full packed format (TF) . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24037,10 +24037,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strttf - !> STRTTP: copies a triangular matrix A from full format (TR) to standard - !> packed format (TP). pure subroutine stdlib_strttp( uplo, n, a, lda, ap, info ) + !> STRTTP copies a triangular matrix A from full format (TR) to standard + !> packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24091,7 +24091,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strttp - !> SBBCSD: computes the CS decomposition of an orthogonal matrix in + + pure subroutine stdlib_sbbcsd( jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q,theta, phi, u1, & + !> SBBCSD computes the CS decomposition of an orthogonal matrix in !> bidiagonal-block form, !> [ B11 | B12 0 0 ] !> [ 0 | 0 -I 0 ] @@ -24112,8 +24114,6 @@ module stdlib_linalg_lapack_s !> The orthogonal matrices U1, U2, V1T, and V2T are input/output. !> The input matrices are pre- or post-multiplied by the appropriate !> singular vector matrices. - - pure subroutine stdlib_sbbcsd( 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, work, & lwork, info ) ! -- lapack computational routine -- @@ -24699,7 +24699,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sbbcsd - !> SDISNA: computes the reciprocal condition numbers for the eigenvectors + + pure subroutine stdlib_sdisna( job, m, n, d, sep, info ) + !> SDISNA 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 @@ -24712,8 +24714,6 @@ module stdlib_linalg_lapack_s !> the error bound. !> SDISNA may also be used to compute error bounds for eigenvectors of !> the generalized symmetric definite eigenproblem. - - pure subroutine stdlib_sdisna( job, m, n, d, sep, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24804,12 +24804,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sdisna - !> SGBBRD: reduces a real general m-by-n band matrix A to upper + + pure subroutine stdlib_sgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & + !> SGBBRD reduces a real general m-by-n band matrix A to upper !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. !> The routine computes B, and optionally forms Q or P**T, or computes !> Q**T*C for a given matrix C. - - pure subroutine stdlib_sgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25061,14 +25061,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbbrd - !> SGBCON: estimates the reciprocal of the condition number of a real + + pure subroutine stdlib_sgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, iwork, & + !> SGBCON estimates the reciprocal of the condition number of a real !> general band matrix A, in either the 1-norm or the infinity-norm, !> using the LU factorization computed by SGBTRF. !> 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)) ). - - pure subroutine stdlib_sgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, iwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25190,7 +25190,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbcon - !> SGBEQU: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_sgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) + !> SGBEQU 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 @@ -25199,8 +25201,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_sgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25320,7 +25320,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbequ - !> SGBEQUB: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_sgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) + !> SGBEQUB 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 @@ -25335,8 +25337,6 @@ module stdlib_linalg_lapack_s !> 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). - - pure subroutine stdlib_sgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25465,11 +25465,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbequb - !> SGBRFS: 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. pure subroutine stdlib_sgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, x, & + !> SGBRFS 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. ldx, ferr, berr, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25666,11 +25666,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbrfs - !> SGBTRF: computes an LU factorization of a real m-by-n band matrix A - !> using partial pivoting with row interchanges. - !> This is the blocked version of the algorithm, calling Level 3 BLAS. pure subroutine stdlib_sgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) + !> SGBTRF computes an LU factorization of a real m-by-n band matrix A + !> using partial pivoting with row interchanges. + !> This is the blocked version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25916,14 +25916,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbtrf - !> SGECON: estimates the reciprocal of the condition number of a general + + pure subroutine stdlib_sgecon( norm, n, a, lda, anorm, rcond, work, iwork,info ) + !> SGECON estimates the reciprocal of the condition number of a general !> real matrix A, in either the 1-norm or the infinity-norm, using !> the LU factorization computed by SGETRF. !> 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)) ). - - pure subroutine stdlib_sgecon( norm, n, a, lda, anorm, rcond, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26017,7 +26017,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgecon - !> SGEEQU: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_sgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) + !> SGEEQU 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 @@ -26026,8 +26028,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_sgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26140,7 +26140,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeequ - !> SGEEQUB: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_sgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) + !> SGEEQUB 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 @@ -26155,8 +26157,6 @@ module stdlib_linalg_lapack_s !> 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). - - pure subroutine stdlib_sgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26279,6 +26279,8 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeequb + + pure subroutine stdlib_sgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) !> DGEMLQT overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q C C Q @@ -26288,8 +26290,6 @@ module stdlib_linalg_lapack_s !> Q = H(1) H(2) . . . H(K) = I - V T V**T !> generated using the compact WY representation as returned by SGELQT. !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. - - pure subroutine stdlib_sgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26377,7 +26377,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgemlqt - !> SGEMQRT: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_sgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) + !> SGEMQRT overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q C C Q !> TRANS = 'T': Q**T C C Q**T @@ -26386,8 +26388,6 @@ module stdlib_linalg_lapack_s !> Q = H(1) H(2) . . . H(K) = I - V T V**T !> generated using the compact WY representation as returned by SGEQRT. !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. - - pure subroutine stdlib_sgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26475,12 +26475,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgemqrt - !> SGESC2: solves a system of linear equations + + pure subroutine stdlib_sgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) + !> SGESC2 solves a system of linear equations !> A * X = scale* RHS !> with a general N-by-N matrix A using the LU factorization with !> complete pivoting computed by SGETC2. - - pure subroutine stdlib_sgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26533,13 +26533,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgesc2 - !> SGETC2: computes an LU factorization with complete pivoting of the + + pure subroutine stdlib_sgetc2( n, a, lda, ipiv, jpiv, info ) + !> SGETC2 computes an LU factorization with complete pivoting of the !> n-by-n matrix A. The factorization has the form A = P * L * U * Q, !> where P and Q are permutation matrices, L is lower triangular with !> unit diagonal elements and U is upper triangular. !> This is the Level 2 BLAS algorithm. - - pure subroutine stdlib_sgetc2( n, a, lda, ipiv, jpiv, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26617,7 +26617,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetc2 - !> SGETF2: computes an LU factorization of a general m-by-n matrix A + + pure subroutine stdlib_sgetf2( m, n, a, lda, ipiv, info ) + !> SGETF2 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 @@ -26625,8 +26627,6 @@ module stdlib_linalg_lapack_s !> diagonal elements (lower trapezoidal if m > n), and U is upper !> triangular (upper trapezoidal if m < n). !> This is the right-looking Level 2 BLAS version of the algorithm. - - pure subroutine stdlib_sgetf2( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26690,7 +26690,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetf2 - !> SGETRF2: computes an LU factorization of a general M-by-N matrix A + + pure recursive subroutine stdlib_sgetrf2( m, n, a, lda, ipiv, info ) + !> SGETRF2 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 @@ -26709,8 +26711,6 @@ module stdlib_linalg_lapack_s !> do the swaps on [ --- ], solve A12, update A22, !> [ A22 ] !> then calls itself to factor A22 and do the swaps on A21. - - pure recursive subroutine stdlib_sgetrf2( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26805,12 +26805,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetrf2 - !> SGETRI: computes the inverse of a matrix using the LU factorization + + pure subroutine stdlib_sgetri( n, a, lda, ipiv, work, lwork, info ) + !> SGETRI computes the inverse of a matrix using the LU factorization !> computed by SGETRF. !> This method inverts U and then computes inv(A) by solving the system !> inv(A)*L = inv(U) for inv(A). - - pure subroutine stdlib_sgetri( n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26907,12 +26907,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetri - !> SGETRS: solves a system of linear equations + + pure subroutine stdlib_sgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) + !> SGETRS solves a system of linear equations !> A * X = B or A**T * X = B !> with a general N-by-N matrix A using the LU factorization computed !> by SGETRF. - - pure subroutine stdlib_sgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26976,7 +26976,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetrs - !> SGGBAL: balances a pair of general real matrices (A,B). This + + pure subroutine stdlib_sggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) + !> SGGBAL balances a pair of general real 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 @@ -26985,8 +26987,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_sggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27270,7 +27270,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggbal - !> SGGHRD: reduces a pair of real matrices (A,B) to generalized upper + + pure subroutine stdlib_sgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & + !> SGGHRD reduces a pair of real matrices (A,B) to generalized upper !> Hessenberg form using orthogonal transformations, where A is a !> general matrix and B is upper triangular. The form of the !> generalized eigenvalue problem is @@ -27293,8 +27295,6 @@ module stdlib_linalg_lapack_s !> If Q1 is the orthogonal matrix from the QR factorization of B in the !> original equation A*x = lambda*B*x, then SGGHRD reduces the original !> problem to generalized Hessenberg form. - - pure subroutine stdlib_sgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27400,12 +27400,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgghrd - !> SGTTRS: solves one of the systems of equations + + pure subroutine stdlib_sgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) + !> SGTTRS solves one of the systems of equations !> A*X = B or A**T*X = B, !> with a tridiagonal matrix A using the LU factorization computed !> by SGTTRF. - - pure subroutine stdlib_sgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27464,11 +27464,11 @@ module stdlib_linalg_lapack_s end if end subroutine stdlib_sgttrs - !> SISNAN: returns .TRUE. if its argument is NaN, and .FALSE. - !> otherwise. To be replaced by the Fortran 2003 intrinsic in the - !> future. pure logical(lk) function stdlib_sisnan( sin ) + !> SISNAN returns .TRUE. if its argument is NaN, and .FALSE. + !> otherwise. To be replaced by the Fortran 2003 intrinsic in the + !> future. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27480,7 +27480,9 @@ module stdlib_linalg_lapack_s return end function stdlib_sisnan - !> SLA_GBAMV: performs one of the matrix-vector operations + + subroutine stdlib_sla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) + !> SLA_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 @@ -27493,8 +27495,6 @@ module stdlib_linalg_lapack_s !> "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. - - subroutine stdlib_sla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27666,7 +27666,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sla_gbamv - !> SLA_GBRCOND: Estimates the Skeel condition number of op(A) * op2(C) + + real(sp) function stdlib_sla_gbrcond( trans, n, kl, ku, ab, ldab, afb, ldafb,ipiv, cmode, c, & + !> SLA_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 @@ -27675,8 +27677,6 @@ module stdlib_linalg_lapack_s !> 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. - - real(sp) function stdlib_sla_gbrcond( trans, n, kl, ku, ab, ldab, afb, ldafb,ipiv, cmode, c, & info, work, iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27824,7 +27824,9 @@ module stdlib_linalg_lapack_s return end function stdlib_sla_gbrcond - !> SLA_GEAMV: performs one of the matrix-vector operations + + subroutine stdlib_sla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) + !> SLA_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 @@ -27837,8 +27839,6 @@ module stdlib_linalg_lapack_s !> "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. - - subroutine stdlib_sla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28003,7 +28003,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sla_geamv - !> SLA_GERCOND: estimates the Skeel condition number of op(A) * op2(C) + + real(sp) function stdlib_sla_gercond( trans, n, a, lda, af, ldaf, ipiv,cmode, c, info, work, & + !> SLA_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 @@ -28012,8 +28014,6 @@ module stdlib_linalg_lapack_s !> 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. - - real(sp) function stdlib_sla_gercond( trans, n, a, lda, af, ldaf, ipiv,cmode, c, info, work, & iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28153,13 +28153,13 @@ module stdlib_linalg_lapack_s return end function stdlib_sla_gercond - !> SLA_LIN_BERR: computes componentwise relative backward error from + + pure subroutine stdlib_sla_lin_berr( n, nz, nrhs, res, ayb, berr ) + !> SLA_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. - - pure subroutine stdlib_sla_lin_berr( n, nz, nrhs, res, ayb, berr ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28194,7 +28194,9 @@ module stdlib_linalg_lapack_s end do end subroutine stdlib_sla_lin_berr - !> SLA_PORCOND: Estimates the Skeel condition number of op(A) * op2(C) + + real(sp) function stdlib_sla_porcond( uplo, n, a, lda, af, ldaf, cmode, c,info, work, iwork ) + !> SLA_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 @@ -28203,8 +28205,6 @@ module stdlib_linalg_lapack_s !> 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. - - real(sp) function stdlib_sla_porcond( uplo, n, a, lda, af, ldaf, cmode, c,info, work, iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28353,7 +28353,9 @@ module stdlib_linalg_lapack_s return end function stdlib_sla_porcond - !> SLA_SYAMV: performs the matrix-vector operation + + subroutine stdlib_sla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) + !> SLA_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. @@ -28365,8 +28367,6 @@ module stdlib_linalg_lapack_s !> "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. - - subroutine stdlib_sla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28542,7 +28542,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sla_syamv - !> SLA_SYRCOND: estimates the Skeel condition number of op(A) * op2(C) + + real(sp) function stdlib_sla_syrcond( uplo, n, a, lda, af, ldaf, ipiv, cmode,c, info, work, & + !> SLA_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 @@ -28551,8 +28553,6 @@ module stdlib_linalg_lapack_s !> 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. - - real(sp) function stdlib_sla_syrcond( uplo, n, a, lda, af, ldaf, ipiv, cmode,c, info, work, & iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28709,14 +28709,14 @@ module stdlib_linalg_lapack_s return end function stdlib_sla_syrcond - !> SLA_SYRPVGRW: computes the reciprocal pivot growth factor + + real(sp) function stdlib_sla_syrpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work ) + !> SLA_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. - - real(sp) function stdlib_sla_syrpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28915,7 +28915,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sladiv1 - !> SLAED6: computes the positive or negative root (closest to the origin) + + pure subroutine stdlib_slaed6( kniter, orgati, rho, d, z, finit, tau, info ) + !> SLAED6 computes the positive or negative root (closest to the origin) !> of !> z(1) z(2) z(3) !> f(x) = rho + --------- + ---------- + --------- @@ -28926,8 +28928,6 @@ module stdlib_linalg_lapack_s !> This routine will be called by SLAED4 when necessary. In most cases, !> the root sought is the smallest in magnitude, though it might not be !> in some extremely rare situations. - - pure subroutine stdlib_slaed6( kniter, orgati, rho, d, z, finit, tau, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29141,7 +29141,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed6 - !> SLAGS2: computes 2-by-2 orthogonal matrices U, V and Q, such + + pure subroutine stdlib_slags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) + !> SLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such !> that if ( UPPER ) then !> U**T *A*Q = U**T *( A1 A2 )*Q = ( x 0 ) !> ( 0 A3 ) ( x x ) @@ -29158,8 +29160,6 @@ module stdlib_linalg_lapack_s !> U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ ) !> ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ ) !> Z**T denotes the transpose of Z. - - pure subroutine stdlib_slags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29301,7 +29301,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slags2 - !> SLAGTF: factorizes the matrix (T - lambda*I), where T is an n by n + + pure subroutine stdlib_slagtf( n, a, lambda, b, c, tol, d, in, info ) + !> SLAGTF 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 @@ -29313,8 +29315,6 @@ module stdlib_linalg_lapack_s !> The parameter LAMBDA is included in the routine so that SLAGTF may !> be used, in conjunction with SLAGTS, to obtain eigenvectors of T by !> inverse iteration. - - pure subroutine stdlib_slagtf( n, a, lambda, b, c, tol, d, in, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29392,7 +29392,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slagtf - !> SLAGTS: may be used to solve one of the systems of equations + + pure subroutine stdlib_slagts( job, n, a, b, c, d, in, y, tol, info ) + !> SLAGTS 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 @@ -29401,8 +29403,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_slagts( job, n, a, b, c, d, in, y, tol, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29589,7 +29589,9 @@ module stdlib_linalg_lapack_s end if end subroutine stdlib_slagts - !> SLAIC1: applies one step of incremental condition estimation in + + pure subroutine stdlib_slaic1( job, j, x, sest, w, gamma, sestpr, s, c ) + !> SLAIC1 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 @@ -29609,8 +29611,6 @@ module stdlib_linalg_lapack_s !> diag(sest*sest, 0) + [alpha gamma] * [ alpha ] !> [ gamma ] !> where alpha = x**T*w. - - pure subroutine stdlib_slaic1( job, j, x, sest, w, gamma, sestpr, s, c ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29801,7 +29801,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaic1 - !> SLANEG: computes the Sturm count, the number of negative pivots + + pure integer(ilp) function stdlib_slaneg( n, d, lld, sigma, pivmin, r ) + !> SLANEG 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 @@ -29816,8 +29818,6 @@ module stdlib_linalg_lapack_s !> 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.) - - pure integer(ilp) function stdlib_slaneg( n, d, lld, sigma, pivmin, r ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29906,11 +29906,11 @@ module stdlib_linalg_lapack_s stdlib_slaneg = negcnt end function stdlib_slaneg - !> SLANGB: 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. real(sp) function stdlib_slangb( norm, n, kl, ku, ab, ldab,work ) + !> SLANGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29981,11 +29981,11 @@ module stdlib_linalg_lapack_s return end function stdlib_slangb - !> SLANGE: 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 matrix A. real(sp) function stdlib_slange( norm, m, n, a, lda, work ) + !> SLANGE 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 matrix A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30053,11 +30053,11 @@ module stdlib_linalg_lapack_s return end function stdlib_slange - !> SLANGT: 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 tridiagonal matrix A. pure real(sp) function stdlib_slangt( norm, n, dl, d, du ) + !> SLANGT 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 tridiagonal matrix A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30129,11 +30129,11 @@ module stdlib_linalg_lapack_s return end function stdlib_slangt - !> SLANHS: 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. real(sp) function stdlib_slanhs( norm, n, a, lda, work ) + !> SLANHS 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30201,11 +30201,11 @@ module stdlib_linalg_lapack_s return end function stdlib_slanhs - !> SLANSB: 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. real(sp) function stdlib_slansb( norm, uplo, n, k, ab, ldab,work ) + !> SLANSB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30306,11 +30306,11 @@ module stdlib_linalg_lapack_s return end function stdlib_slansb - !> SLANSF: 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. real(sp) function stdlib_slansf( norm, transr, uplo, n, a, work ) + !> SLANSF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31010,11 +31010,11 @@ module stdlib_linalg_lapack_s return end function stdlib_slansf - !> SLANSP: 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, supplied in packed form. real(sp) function stdlib_slansp( norm, uplo, n, ap, work ) + !> SLANSP 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, supplied in packed form. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31134,11 +31134,11 @@ module stdlib_linalg_lapack_s return end function stdlib_slansp - !> SLANST: 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. pure real(sp) function stdlib_slanst( norm, n, d, e ) + !> SLANST 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31196,11 +31196,11 @@ module stdlib_linalg_lapack_s return end function stdlib_slanst - !> SLANSY: 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. real(sp) function stdlib_slansy( norm, uplo, n, a, lda, work ) + !> SLANSY 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31292,11 +31292,11 @@ module stdlib_linalg_lapack_s return end function stdlib_slansy - !> SLANTB: 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. real(sp) function stdlib_slantb( norm, uplo, diag, n, k, ab,ldab, work ) + !> SLANTB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31485,11 +31485,11 @@ module stdlib_linalg_lapack_s return end function stdlib_slantb - !> SLANTP: 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. real(sp) function stdlib_slantp( norm, uplo, diag, n, ap, work ) + !> SLANTP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31691,11 +31691,11 @@ module stdlib_linalg_lapack_s return end function stdlib_slantp - !> SLANTR: 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. real(sp) function stdlib_slantr( norm, uplo, diag, m, n, a, lda,work ) + !> SLANTR 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31877,7 +31877,9 @@ module stdlib_linalg_lapack_s return end function stdlib_slantr - !> SLAORHR_COL_GETRFNP: computes the modified LU factorization without + + pure subroutine stdlib_slaorhr_col_getrfnp( m, n, a, lda, d, info ) + !> SLAORHR_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, @@ -31910,8 +31912,6 @@ module stdlib_linalg_lapack_s !> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, !> E. Solomonik, J. Parallel Distrib. Comput., !> vol. 85, pp. 3-31, 2015. - - pure subroutine stdlib_slaorhr_col_getrfnp( m, n, a, lda, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31971,10 +31971,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaorhr_col_getrfnp - !> SLAPY2: returns sqrt(x**2+y**2), taking care not to cause unnecessary - !> overflow and unnecessary underflow. pure real(sp) function stdlib_slapy2( x, y ) + !> SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary + !> overflow and unnecessary underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32008,6 +32008,8 @@ module stdlib_linalg_lapack_s return end function stdlib_slapy2 + + pure subroutine stdlib_slaqz1( a, lda, b, ldb, sr1, sr2, si, beta1, beta2,v ) !> Given a 3-by-3 matrix pencil (A,B), SLAQZ1: sets v to a !> scalar multiple of the first column of the product !> (*) K = (A - (beta2*sr2 - i*si)*B)*B^(-1)*(beta1*A - (sr2 + i*si2)*B)*B^(-1). @@ -32017,8 +32019,6 @@ module stdlib_linalg_lapack_s !> 2) si = 0. !> This is useful for starting double implicit shift bulges !> in the QZ algorithm. - - pure subroutine stdlib_slaqz1( a, lda, b, ldb, sr1, sr2, si, beta1, beta2,v ) ! arguments integer(ilp), intent( in ) :: lda, ldb real(sp), intent( in ) :: a( lda, * ), b( ldb, * ), sr1, sr2, si,beta1, beta2 @@ -32063,9 +32063,9 @@ module stdlib_linalg_lapack_s end if end subroutine stdlib_slaqz1 - !> SLAQZ2: chases a 2x2 shift bulge in a matrix pencil down a single position pure subroutine stdlib_slaqz2( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, qstart, & + !> SLAQZ2 chases a 2x2 shift bulge in a matrix pencil down a single position q, ldq, nz, zstart, z, ldz ) ! arguments logical(lk), intent( in ) :: ilq, ilz @@ -32174,9 +32174,9 @@ module stdlib_linalg_lapack_s end if end subroutine stdlib_slaqz2 - !> SLAQZ4: Executes a single multishift QZ sweep pure subroutine stdlib_slaqz4( ilschur, ilq, ilz, n, ilo, ihi, nshifts,nblock_desired, sr, & + !> SLAQZ4 Executes a single multishift QZ sweep si, ss, a, lda, b, ldb, q,ldq, z, ldz, qc, ldqc, zc, ldzc, work, lwork,info ) ! function arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -32431,7 +32431,9 @@ module stdlib_linalg_lapack_s end if end subroutine stdlib_slaqz4 - !> SLAR1V: computes the (scaled) r-th column of the inverse of + + pure subroutine stdlib_slar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & + !> SLAR1V 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 @@ -32446,8 +32448,6 @@ module stdlib_linalg_lapack_s !> (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. - - pure subroutine stdlib_slar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32653,7 +32653,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slar1v - !> SLARFG: generates a real elementary reflector H of order n, such + + pure subroutine stdlib_slarfg( n, alpha, x, incx, tau ) + !> SLARFG generates a real elementary reflector H of order n, such !> that !> H * ( alpha ) = ( beta ), H**T * H = I. !> ( x ) ( 0 ) @@ -32666,8 +32668,6 @@ module stdlib_linalg_lapack_s !> If the elements of x are all zero, then tau = 0 and H is taken to be !> the unit matrix. !> Otherwise 1 <= tau <= 2. - - pure subroutine stdlib_slarfg( n, alpha, x, incx, tau ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32722,7 +32722,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarfg - !> SLARFGP: generates a real elementary reflector H of order n, such + + subroutine stdlib_slarfgp( n, alpha, x, incx, tau ) + !> SLARFGP generates a real elementary reflector H of order n, such !> that !> H * ( alpha ) = ( beta ), H**T * H = I. !> ( x ) ( 0 ) @@ -32734,8 +32736,6 @@ module stdlib_linalg_lapack_s !> vector. !> If the elements of x are all zero, then tau = 0 and H is taken to be !> the unit matrix. - - subroutine stdlib_slarfgp( n, alpha, x, incx, tau ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32830,10 +32830,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarfgp - !> SLARNV: returns a vector of n random real numbers from a uniform or - !> normal distribution. pure subroutine stdlib_slarnv( idist, iseed, n, x ) + !> SLARNV returns a vector of n random real numbers from a uniform or + !> normal distribution. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32886,6 +32886,8 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarnv + + pure subroutine stdlib_slarrb( n, d, lld, ifirst, ilast, rtol1,rtol2, offset, w, wgap, werr, & !> Given the relatively robust representation(RRR) L D L^T, SLARRB: !> does "limited" bisection to refine the eigenvalues of L D L^T, !> W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial @@ -32894,8 +32896,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_slarrb( n, d, lld, ifirst, ilast, rtol1,rtol2, offset, w, wgap, werr, & work, iwork,pivmin, spdiam, twist, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33059,13 +33059,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarrb + + pure subroutine stdlib_slarrf( n, d, l, ld, clstrt, clend,w, wgap, werr,spdiam, clgapl, & !> 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 ), SLARRF: 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. - - pure subroutine stdlib_slarrf( n, d, l, ld, clstrt, clend,w, wgap, werr,spdiam, clgapl, & clgapr, pivmin, sigma,dplus, lplus, work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33318,11 +33318,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarrf - !> SLARRV: 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. pure subroutine stdlib_slarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, & + !> SLARRV 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. rtol2, w, werr, wgap,iblock, indexw, gers, z, ldz, isuppz,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33949,13 +33949,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarrv - !> SLASCL: multiplies the M by N real matrix A by the real scalar + + pure subroutine stdlib_slascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) + !> SLASCL multiplies the M by N real 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. - - pure subroutine stdlib_slascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34119,6 +34119,8 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slascl + + pure subroutine stdlib_slasd4( n, i, d, z, delta, rho, sigma, work, info ) !> 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 @@ -34130,8 +34132,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_slasd4( n, i, d, z, delta, rho, sigma, work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34847,15 +34847,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd4 - !> SLASD7: merges the two sets of singular values together into a single + + pure subroutine stdlib_slasd7( icompq, nl, nr, sqre, k, d, z, zw, vf, vfw, vl,vlw, alpha, & + !> SLASD7 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. !> SLASD7 is called from SLASD6. - - pure subroutine stdlib_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 ) ! -- lapack auxiliary routine -- @@ -35086,15 +35086,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd7 - !> SLASD8: finds the square roots of the roots of the secular equation, + + pure subroutine stdlib_slasd8( icompq, k, d, z, vf, vl, difl, difr, lddifr,dsigma, work, & + !> SLASD8 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 SLASD4, 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. !> SLASD8 is called from SLASD6. - - pure subroutine stdlib_slasd8( icompq, k, d, z, vf, vl, difl, difr, lddifr,dsigma, work, & info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35222,11 +35222,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd8 - !> SLASQ3: checks for deflation, computes a shift (TAU) and calls dqds. - !> In case of failure it changes shifts, and tries again until output - !> is positive. pure subroutine stdlib_slasq3( i0, n0, z, pp, dmin, sigma, desig, qmax, nfail,iter, ndiv, & + !> SLASQ3 checks for deflation, computes a shift (TAU) and calls dqds. + !> In case of failure it changes shifts, and tries again until output + !> is positive. ieee, ttype, dmin1, dmin2, dn, dn1,dn2, g, tau ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35392,7 +35392,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasq3 - !> SLATDF: uses the LU factorization of the n-by-n matrix Z computed by + + pure subroutine stdlib_slatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) + !> SLATDF uses the LU factorization of the n-by-n matrix Z computed by !> SGETC2 and computes a contribution to the reciprocal Dif-estimate !> by solving Z * x = b for x, and choosing the r.h.s. b such that !> the norm of x is as large as possible. On entry RHS = b holds the @@ -35400,8 +35402,6 @@ module stdlib_linalg_lapack_s !> The factorization of Z returned by SGETC2 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. - - pure subroutine stdlib_slatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35502,7 +35502,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slatdf - !> SLATRD: reduces NB rows and columns of a real symmetric matrix A to + + pure subroutine stdlib_slatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) + !> SLATRD reduces NB rows and columns of a real symmetric matrix A to !> symmetric tridiagonal form by an orthogonal similarity !> transformation Q**T * A * Q, and returns the matrices V and W which are !> needed to apply the transformation to the unreduced part of A. @@ -35511,8 +35513,6 @@ module stdlib_linalg_lapack_s !> if UPLO = 'L', SLATRD reduces the first NB rows and columns of a !> matrix, of which the lower triangle is supplied. !> This is an auxiliary routine called by SSYTRD. - - pure subroutine stdlib_slatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35604,12 +35604,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slatrd - !> SLATRZ: factors the M-by-(M+L) real upper trapezoidal matrix + + pure subroutine stdlib_slatrz( m, n, l, a, lda, tau, work ) + !> SLATRZ factors the M-by-(M+L) real upper trapezoidal matrix !> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z, by means !> of orthogonal transformations. Z is an (M+L)-by-(M+L) orthogonal !> matrix and, R and A1 are M-by-M upper triangular matrices. - - pure subroutine stdlib_slatrz( m, n, l, a, lda, tau, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35644,7 +35644,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slatrz - !> SORBDB: simultaneously bidiagonalizes the blocks of an M-by-M + + subroutine stdlib_sorbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & + !> SORBDB simultaneously bidiagonalizes the blocks of an M-by-M !> partitioned orthogonal matrix X: !> [ B11 | B12 0 0 ] !> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**T @@ -35660,8 +35662,6 @@ module stdlib_linalg_lapack_s !> represented implicitly by Householder vectors. !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_sorbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35973,7 +35973,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorbdb - !> SORBDB5: orthogonalizes the column vector + + pure subroutine stdlib_sorbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & + !> SORBDB5 orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] !> with respect to the columns of @@ -35984,8 +35986,6 @@ module stdlib_linalg_lapack_s !> criterion, then some other vector from the orthogonal complement !> is returned. This vector is chosen in an arbitrary but deterministic !> way. - - pure subroutine stdlib_sorbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36072,7 +36072,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorbdb5 - !> SORCSD: computes the CS decomposition of an M-by-M partitioned + + recursive subroutine stdlib_sorcsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & + !> SORCSD computes the CS decomposition of an M-by-M partitioned !> orthogonal matrix X: !> [ I 0 0 | 0 0 0 ] !> [ 0 C 0 | 0 -S 0 ] @@ -36085,8 +36087,6 @@ module stdlib_linalg_lapack_s !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in !> which R = MIN(P,M-P,Q,M-Q). - - recursive subroutine stdlib_sorcsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, ldv1t, v2t,ldv2t, & work, lwork, iwork, info ) ! -- lapack computational routine -- @@ -36347,12 +36347,12 @@ module stdlib_linalg_lapack_s ! end stdlib_sorcsd end subroutine stdlib_sorcsd - !> SORGHR: generates a real orthogonal matrix Q which is defined as the + + pure subroutine stdlib_sorghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) + !> SORGHR generates a real orthogonal matrix Q which is defined as the !> product of IHI-ILO elementary reflectors of order N, as returned by !> SGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - - pure subroutine stdlib_sorghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36437,7 +36437,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorghr - !> SORHR_COL: takes an M-by-N real matrix Q_in with orthonormal columns + + pure subroutine stdlib_sorhr_col( m, n, nb, a, lda, t, ldt, d, info ) + !> SORHR_COL takes an M-by-N real matrix Q_in with orthonormal columns !> as input, stored in A, and performs Householder Reconstruction (HR), !> i.e. reconstructs Householder vectors V(i) implicitly representing !> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, @@ -36446,8 +36448,6 @@ module stdlib_linalg_lapack_s !> stored in A on output, and the diagonal entries of S are stored in D. !> Block reflectors are also returned in T !> (same output format as SGEQRT). - - pure subroutine stdlib_sorhr_col( m, n, nb, a, lda, t, ldt, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36574,7 +36574,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorhr_col - !> SORMHR: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_sormhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & + !> SORMHR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -36582,8 +36584,6 @@ module stdlib_linalg_lapack_s !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of !> IHI-ILO elementary reflectors, as returned by SGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - - pure subroutine stdlib_sormhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36673,13 +36673,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormhr - !> SPBCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_spbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,iwork, info ) + !> SPBCON estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric positive definite band matrix using the !> Cholesky factorization A = U**T*U or A = L*L**T computed by SPBTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_spbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36771,12 +36771,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spbcon - !> SPBRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_spbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & + !> SPBRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric positive definite !> and banded, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_spbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36965,11 +36965,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spbrfs - !> SPFTRS: solves a system of linear equations A*X = B with a symmetric - !> positive definite matrix A using the Cholesky factorization - !> A = U**T*U or A = L*L**T computed by SPFTRF. pure subroutine stdlib_spftrs( transr, uplo, n, nrhs, a, b, ldb, info ) + !> SPFTRS solves a system of linear equations A*X = B with a symmetric + !> positive definite matrix A using the Cholesky factorization + !> A = U**T*U or A = L*L**T computed by SPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37019,13 +37019,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spftrs - !> SPOCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_spocon( uplo, n, a, lda, anorm, rcond, work, iwork,info ) + !> SPOCON estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric positive definite matrix using the !> Cholesky factorization A = U**T*U or A = L*L**T computed by SPOTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_spocon( uplo, n, a, lda, anorm, rcond, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37114,12 +37114,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spocon - !> SPORFS: improves the computed solution to a system of linear + + pure subroutine stdlib_sporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & + !> SPORFS improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric positive definite, !> and provides error bounds and backward error estimates for the !> solution. - - pure subroutine stdlib_sporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37303,15 +37303,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sporfs - !> SPOTF2: computes the Cholesky factorization of a real symmetric + + pure subroutine stdlib_spotf2( uplo, n, a, lda, info ) + !> SPOTF2 computes the Cholesky factorization of a real symmetric !> positive definite matrix A. !> The factorization has the form !> A = U**T * U , if UPLO = 'U', or !> A = L * L**T, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the unblocked version of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_spotf2( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37390,7 +37390,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spotf2 - !> SPOTRF2: computes the Cholesky factorization of a real symmetric + + pure recursive subroutine stdlib_spotrf2( uplo, n, a, lda, info ) + !> SPOTRF2 computes the Cholesky factorization of a real symmetric !> positive definite matrix A using the recursive algorithm. !> The factorization has the form !> A = U**T * U, if UPLO = 'U', or @@ -37403,8 +37405,6 @@ module stdlib_linalg_lapack_s !> [ A21 | A22 ] n2 = n-n1 !> The subroutine calls itself to factor A11. Update and scale A21 !> or A12, update A22 then call itself to factor A22. - - pure recursive subroutine stdlib_spotrf2( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37488,11 +37488,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spotrf2 - !> SPOTRI: computes the inverse of a real symmetric positive definite - !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T - !> computed by SPOTRF. pure subroutine stdlib_spotri( uplo, n, a, lda, info ) + !> SPOTRI computes the inverse of a real symmetric positive definite + !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T + !> computed by SPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37529,14 +37529,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spotri - !> SPPCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_sppcon( uplo, n, ap, anorm, rcond, work, iwork, info ) + !> SPPCON estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric positive definite packed matrix using !> the Cholesky factorization A = U**T*U or A = L*L**T computed by !> SPPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_sppcon( uplo, n, ap, anorm, rcond, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37623,12 +37623,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sppcon - !> SPPRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_spprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & + !> SPPRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric positive definite !> and packed, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_spprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37815,7 +37815,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spprfs - !> SPPSV: computes the solution to a real system of linear equations + + pure subroutine stdlib_sppsv( uplo, n, nrhs, ap, b, ldb, info ) + !> SPPSV computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite matrix stored in !> packed format and X and B are N-by-NRHS matrices. @@ -37825,8 +37827,6 @@ module stdlib_linalg_lapack_s !> where U is an upper triangular matrix and L is a lower triangular !> matrix. The factored form of A is then used to solve the system of !> equations A * X = B. - - pure subroutine stdlib_sppsv( uplo, n, nrhs, ap, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37864,15 +37864,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sppsv - !> SPPSVX: uses the Cholesky factorization A = U**T*U or A = L*L**T to + + subroutine stdlib_sppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& + !> SPPSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to !> compute the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite matrix stored in !> packed format and X and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_sppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38003,11 +38003,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sppsvx - !> SPPTRI: computes the inverse of a real symmetric positive definite - !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T - !> computed by SPPTRF. pure subroutine stdlib_spptri( uplo, n, ap, info ) + !> SPPTRI computes the inverse of a real symmetric positive definite + !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T + !> computed by SPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38065,7 +38065,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spptri - !> SPSTF2: computes the Cholesky factorization with complete + + pure subroutine stdlib_spstf2( uplo, n, a, lda, piv, rank, tol, work, info ) + !> SPSTF2 computes the Cholesky factorization with complete !> pivoting of a real symmetric positive semidefinite matrix A. !> The factorization has the form !> P**T * A * P = U**T * U , if UPLO = 'U', @@ -38074,8 +38076,6 @@ module stdlib_linalg_lapack_s !> P is stored as vector PIV. !> This algorithm does not attempt to check that A is positive !> semidefinite. This version of the algorithm calls level 2 BLAS. - - pure subroutine stdlib_spstf2( uplo, n, a, lda, piv, rank, tol, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38244,7 +38244,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spstf2 - !> SPSTRF: computes the Cholesky factorization with complete + + pure subroutine stdlib_spstrf( uplo, n, a, lda, piv, rank, tol, work, info ) + !> SPSTRF computes the Cholesky factorization with complete !> pivoting of a real symmetric positive semidefinite matrix A. !> The factorization has the form !> P**T * A * P = U**T * U , if UPLO = 'U', @@ -38253,8 +38255,6 @@ module stdlib_linalg_lapack_s !> P is stored as vector PIV. !> This algorithm does not attempt to check that A is positive !> semidefinite. This version of the algorithm calls level 3 BLAS. - - pure subroutine stdlib_spstrf( uplo, n, a, lda, piv, rank, tol, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38455,14 +38455,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spstrf - !> SPTTRS: solves a tridiagonal system of the form + + pure subroutine stdlib_spttrs( n, nrhs, d, e, b, ldb, info ) + !> SPTTRS solves a tridiagonal system of the form !> A * X = B !> using the L*D*L**T factorization of A computed by SPTTRF. D is a !> diagonal matrix specified in the vector D, L is a unit bidiagonal !> matrix whose subdiagonal is specified in the vector E, and X and B !> are N by NRHS matrices. - - pure subroutine stdlib_spttrs( n, nrhs, d, e, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38510,10 +38510,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spttrs - !> SSB2ST_KERNELS: is an internal routine used by the SSYTRD_SB2ST - !> subroutine. pure subroutine stdlib_ssb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, lda, & + !> SSB2ST_KERNELS is an internal routine used by the SSYTRD_SB2ST + !> subroutine. v, tau, ldvt, work) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38655,13 +38655,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssb2st_kernels - !> SSPCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_sspcon( uplo, n, ap, ipiv, anorm, rcond, work, iwork,info ) + !> SSPCON estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric packed matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by SSPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_sspcon( uplo, n, ap, ipiv, anorm, rcond, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38737,12 +38737,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspcon - !> SSPRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_ssprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& + !> SSPRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric indefinite !> and packed, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_ssprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38930,7 +38930,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssprfs - !> SSPSV: computes the solution to a real system of linear equations + + pure subroutine stdlib_sspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) + !> SSPSV computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix stored in packed format and X !> and B are N-by-NRHS matrices. @@ -38941,8 +38943,6 @@ module stdlib_linalg_lapack_s !> triangular matrices, D is symmetric 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. - - pure subroutine stdlib_sspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38981,14 +38981,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspsv - !> SSPSVX: uses the diagonal pivoting factorization A = U*D*U**T or + + subroutine stdlib_sspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & + !> SSPSVX uses the diagonal pivoting factorization A = U*D*U**T or !> A = L*D*L**T to compute the solution to a real system of linear !> equations A * X = B, where A is an N-by-N symmetric matrix stored !> in packed format and X and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_sspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39059,11 +39059,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspsvx - !> SSPTRD: reduces a real symmetric matrix A stored in packed form to - !> symmetric tridiagonal form T by an orthogonal similarity - !> transformation: Q**T * A * Q = T. pure subroutine stdlib_ssptrd( uplo, n, ap, d, e, tau, info ) + !> SSPTRD reduces a real symmetric matrix A stored in packed form to + !> symmetric tridiagonal form T by an orthogonal similarity + !> transformation: Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39156,13 +39156,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssptrd - !> SSTEIN: computes the eigenvectors of a real symmetric tridiagonal + + pure subroutine stdlib_sstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & + !> SSTEIN computes the eigenvectors of a real symmetric tridiagonal !> matrix T corresponding to specified eigenvalues, using inverse !> iteration. !> The maximum number of iterations allowed for each eigenvector is !> specified by an internal parameter MAXITS (currently set to 5). - - pure subroutine stdlib_sstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39354,13 +39354,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sstein - !> SSTEQR: computes all eigenvalues and, optionally, eigenvectors of a + + pure subroutine stdlib_ssteqr( compz, n, d, e, z, ldz, work, info ) + !> SSTEQR computes all eigenvalues and, optionally, eigenvectors of a !> symmetric tridiagonal matrix using the implicit QL or QR method. !> The eigenvectors of a full or band symmetric matrix can also be found !> if SSYTRD or SSPTRD or SSBTRD has been used to reduce this matrix to !> tridiagonal form. - - pure subroutine stdlib_ssteqr( compz, n, d, e, z, ldz, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39671,10 +39671,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssteqr - !> SSTERF: computes all eigenvalues of a symmetric tridiagonal matrix - !> using the Pal-Walker-Kahan variant of the QL or QR algorithm. pure subroutine stdlib_ssterf( n, d, e, info ) + !> SSTERF computes all eigenvalues of a symmetric tridiagonal matrix + !> using the Pal-Walker-Kahan variant of the QL or QR algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39905,10 +39905,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssterf - !> SSTEV: computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric tridiagonal matrix A. pure subroutine stdlib_sstev( jobz, n, d, e, z, ldz, work, info ) + !> SSTEV computes all eigenvalues and, optionally, eigenvectors of a + !> real symmetric tridiagonal matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39988,12 +39988,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sstev - !> SSTEVX: computes selected eigenvalues and, optionally, eigenvectors + + pure subroutine stdlib_sstevx( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & + !> SSTEVX computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix A. Eigenvalues and !> eigenvectors can be selected by specifying either a range of values !> or a range of indices for the desired eigenvalues. - - pure subroutine stdlib_sstevx( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & work, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40182,13 +40182,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sstevx - !> SSYCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_ssycon( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) + !> SSYCON estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by SSYTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_ssycon( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40265,13 +40265,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssycon - !> SSYCON_ROOK: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_ssycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) + !> SSYCON_ROOK estimates the reciprocal of the condition number (in the !> 1-norm) of a real symmetric matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by SSYTRF_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))). - - pure subroutine stdlib_ssycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40348,11 +40348,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssycon_rook - !> SSYRFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite, and - !> provides error bounds and backward error estimates for the solution. pure subroutine stdlib_ssyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & + !> SSYRFS improves the computed solution to a system of linear + !> equations when the coefficient matrix is symmetric indefinite, and + !> provides error bounds and backward error estimates for the solution. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40537,7 +40537,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyrfs - !> SSYSV_RK: computes the solution to a real system of linear + + pure subroutine stdlib_ssysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,work, lwork, info ) + !> SSYSV_RK computes the solution to a real system of linear !> equations A * X = B, where A is an N-by-N symmetric matrix !> and X and B are N-by-NRHS matrices. !> The bounded Bunch-Kaufman (rook) diagonal pivoting method is used @@ -40551,8 +40553,6 @@ module stdlib_linalg_lapack_s !> SSYTRF_RK is called to compute the factorization of a real !> symmetric matrix. The factored form of A is then used to solve !> the system of equations A * X = B by calling BLAS3 routine SSYTRS_3. - - pure subroutine stdlib_ssysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40614,7 +40614,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssysv_rk - !> SSYSV_ROOK: computes the solution to a real system of linear + + pure subroutine stdlib_ssysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) + !> SSYSV_ROOK computes the solution to a real system of linear !> equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS @@ -40630,8 +40632,6 @@ module stdlib_linalg_lapack_s !> pivoting method. !> The factored form of A is then used to solve the system !> of equations A * X = B by calling SSYTRS_ROOK. - - pure subroutine stdlib_ssysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40693,10 +40693,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssysv_rook - !> SSYTD2: reduces a real symmetric matrix A to symmetric tridiagonal - !> form T by an orthogonal similarity transformation: Q**T * A * Q = T. pure subroutine stdlib_ssytd2( uplo, n, a, lda, d, e, tau, info ) + !> SSYTD2 reduces a real symmetric matrix A to symmetric tridiagonal + !> form T by an orthogonal similarity transformation: Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -40787,15 +40787,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytd2 - !> SSYTF2: computes the factorization of a real symmetric matrix A using + + pure subroutine stdlib_ssytf2( uplo, n, a, lda, ipiv, info ) + !> SSYTF2 computes the factorization of a real symmetric matrix A using !> the Bunch-Kaufman diagonal pivoting method: !> 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, U**T is the transpose of U, and D is symmetric 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. - - pure subroutine stdlib_ssytf2( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41072,11 +41072,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytf2 - !> SSYTRD: reduces a real symmetric matrix A to real symmetric - !> tridiagonal form T by an orthogonal similarity transformation: - !> Q**T * A * Q = T. pure subroutine stdlib_ssytrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) + !> SSYTRD reduces a real symmetric matrix A to real symmetric + !> tridiagonal form T by an orthogonal similarity transformation: + !> Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41198,11 +41198,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrd - !> SSYTRD_SB2ST: reduces a real symmetric band matrix A to real symmetric - !> tridiagonal form T by a orthogonal similarity transformation: - !> Q**T * A * Q = T. pure subroutine stdlib_ssytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & + !> SSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric + !> tridiagonal form T by a orthogonal similarity transformation: + !> Q**T * A * Q = T. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41444,7 +41444,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrd_sb2st - !> SSYTRF: computes the factorization of a real symmetric matrix A using + + pure subroutine stdlib_ssytrf( uplo, n, a, lda, ipiv, work, lwork, info ) + !> SSYTRF computes the factorization of a real symmetric matrix A using !> the Bunch-Kaufman diagonal pivoting method. The form of the !> factorization is !> A = U**T*D*U or A = L*D*L**T @@ -41452,8 +41454,6 @@ module stdlib_linalg_lapack_s !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_ssytrf( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41570,14 +41570,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrf - !> STBCON: estimates the reciprocal of the condition number of a + + subroutine stdlib_stbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,iwork, info ) + !> STBCON estimates the reciprocal of the condition number of a !> triangular band matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_stbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41674,11 +41674,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stbcon - !> STFTRI: computes the inverse of a triangular matrix A stored in RFP - !> format. - !> This is a Level 3 BLAS version of the algorithm. pure subroutine stdlib_stftri( transr, uplo, diag, n, a, info ) + !> STFTRI computes the inverse of a triangular matrix A stored in RFP + !> format. + !> This is a Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41857,7 +41857,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stftri - !> STGSY2: solves the generalized Sylvester equation: + + pure subroutine stdlib_stgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & + !> STGSY2 solves the generalized Sylvester equation: !> A * R - L * B = scale * C (1) !> D * R - L * E = scale * F, !> using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices, @@ -41885,8 +41887,6 @@ module stdlib_linalg_lapack_s !> of an upper bound on the separation between to matrix pairs. Then !> the input (A, D), (B, E) are sub-pencils of the matrix pair in !> STGSYL. See STGSYL for details. - - pure subroutine stdlib_stgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & ldf, scale, rdsum, rdscal,iwork, pq, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42497,7 +42497,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgsy2 - !> STGSYL: solves the generalized Sylvester equation: + + pure subroutine stdlib_stgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & + !> STGSYL solves the generalized Sylvester equation: !> A * R - L * B = scale * C (1) !> D * R - L * E = scale * F !> where R and L are unknown m-by-n matrices, (A, D), (B, E) and @@ -42525,8 +42527,6 @@ module stdlib_linalg_lapack_s !> reciprocal of the smallest singular value of Z. See [1-2] for more !> information. !> This is a level 3 BLAS algorithm. - - pure subroutine stdlib_stgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42826,14 +42826,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgsyl - !> STPCON: estimates the reciprocal of the condition number of a packed + + subroutine stdlib_stpcon( norm, uplo, diag, n, ap, rcond, work, iwork,info ) + !> STPCON estimates the reciprocal of the condition number of a packed !> triangular matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_stpcon( norm, uplo, diag, n, ap, rcond, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42925,11 +42925,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stpcon - !> STPLQT2: computes a LQ a factorization of a real "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. pure subroutine stdlib_stplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) + !> STPLQT2 computes a LQ a factorization of a real "triangular-pentagonal" + !> matrix C, which is composed of a triangular block A and pentagonal block B, + !> using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43022,11 +43022,11 @@ module stdlib_linalg_lapack_s end do end subroutine stdlib_stplqt2 - !> STPMLQT: applies a real orthogonal matrix Q obtained from a - !> "triangular-pentagonal" real block reflector H to a general - !> real matrix C, which consists of two blocks A and B. pure subroutine stdlib_stpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, ldb, & + !> STPMLQT applies a real orthogonal matrix Q obtained from a + !> "triangular-pentagonal" real block reflector H to a general + !> real matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43140,11 +43140,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stpmlqt - !> STPMQRT: applies a real orthogonal matrix Q obtained from a - !> "triangular-pentagonal" real block reflector H to a general - !> real matrix C, which consists of two blocks A and B. pure subroutine stdlib_stpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, ldb, & + !> STPMQRT applies a real orthogonal matrix Q obtained from a + !> "triangular-pentagonal" real block reflector H to a general + !> real matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43260,11 +43260,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stpmqrt - !> STPQRT2: computes a QR factorization of a real "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. pure subroutine stdlib_stpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) + !> STPQRT2 computes a QR factorization of a real "triangular-pentagonal" + !> matrix C, which is composed of a triangular block A and pentagonal block B, + !> using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43351,14 +43351,14 @@ module stdlib_linalg_lapack_s end do end subroutine stdlib_stpqrt2 - !> STRCON: estimates the reciprocal of the condition number of a + + subroutine stdlib_strcon( norm, uplo, diag, n, a, lda, rcond, work,iwork, info ) + !> STRCON estimates the reciprocal of the condition number of a !> triangular matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_strcon( norm, uplo, diag, n, a, lda, rcond, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43452,14 +43452,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strcon - !> STZRZF: reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A + + pure subroutine stdlib_stzrzf( m, n, a, lda, tau, work, lwork, info ) + !> STZRZF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A !> to upper triangular form by means of orthogonal transformations. !> The upper trapezoidal matrix A is factored as !> A = ( R 0 ) * Z, !> where Z is an N-by-N orthogonal matrix and R is an M-by-M upper !> triangular matrix. - - pure subroutine stdlib_stzrzf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43568,7 +43568,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stzrzf - !> SGBSV: computes the solution to a real system of linear equations + + pure subroutine stdlib_sgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) + !> SGBSV computes the solution to a real 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 @@ -43576,8 +43578,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_sgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43620,14 +43620,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbsv - !> SGBSVX: uses the LU factorization to compute the solution to a real + + subroutine stdlib_sgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & + !> SGBSVX uses the LU factorization to compute the solution to a real !> system of linear equations A * X = B, A**T * X = B, or A**H * 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. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_sgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & c, b, ldb, x, ldx,rcond, ferr, berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43846,7 +43846,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbsvx - !> SGEBAL: balances a general real matrix A. This involves, first, + + pure subroutine stdlib_sgebal( job, n, a, lda, ilo, ihi, scale, info ) + !> SGEBAL balances a general real 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 @@ -43854,8 +43856,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_sgebal( job, n, a, lda, ilo, ihi, scale, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44014,11 +44014,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgebal - !> SGEBD2: reduces a real general m by n matrix A to upper or lower - !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. - !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. pure subroutine stdlib_sgebd2( m, n, a, lda, d, e, tauq, taup, work, info ) + !> SGEBD2 reduces a real general m by n matrix A to upper or lower + !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. + !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44106,10 +44106,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgebd2 - !> SGEHD2: reduces a real general matrix A to upper Hessenberg form H by - !> an orthogonal similarity transformation: Q**T * A * Q = H . pure subroutine stdlib_sgehd2( n, ilo, ihi, a, lda, tau, work, info ) + !> SGEHD2 reduces a real general matrix A to upper Hessenberg form H by + !> an orthogonal similarity transformation: Q**T * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44158,14 +44158,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgehd2 - !> SGELQ2: computes an LQ factorization of a real m-by-n matrix A: + + pure subroutine stdlib_sgelq2( m, n, a, lda, tau, work, info ) + !> SGELQ2 computes an LQ factorization of a real 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. - - pure subroutine stdlib_sgelq2( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44212,14 +44212,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgelq2 - !> SGELQF: computes an LQ factorization of a real M-by-N matrix A: + + pure subroutine stdlib_sgelqf( m, n, a, lda, tau, work, lwork, info ) + !> SGELQF computes an LQ factorization of a real 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. - - pure subroutine stdlib_sgelqf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44309,12 +44309,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgelqf - !> SGELQT3: recursively computes a LQ factorization of a real M-by-N + + pure recursive subroutine stdlib_sgelqt3( m, n, a, lda, t, ldt, info ) + !> SGELQT3 recursively computes a LQ factorization of a real 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. - - pure recursive subroutine stdlib_sgelqt3( m, n, a, lda, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44396,10 +44396,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgelqt3 - !> SGEQL2: computes a QL factorization of a real m by n matrix A: - !> A = Q * L. pure subroutine stdlib_sgeql2( m, n, a, lda, tau, work, info ) + !> SGEQL2 computes a QL factorization of a real m by n matrix A: + !> A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44445,10 +44445,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeql2 - !> SGEQLF: computes a QL factorization of a real M-by-N matrix A: - !> A = Q * L. pure subroutine stdlib_sgeqlf( m, n, a, lda, tau, work, lwork, info ) + !> SGEQLF computes a QL factorization of a real M-by-N matrix A: + !> A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44551,15 +44551,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeqlf - !> SGEQR2: computes a QR factorization of a real m-by-n matrix A: + + pure subroutine stdlib_sgeqr2( m, n, a, lda, tau, work, info ) + !> SGEQR2 computes a QR factorization of a real 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. - - pure subroutine stdlib_sgeqr2( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44606,7 +44606,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeqr2 - !> SGEQR2P: computes a QR factorization of a real m-by-n matrix A: + + subroutine stdlib_sgeqr2p( m, n, a, lda, tau, work, info ) + !> SGEQR2P computes a QR factorization of a real m-by-n matrix A: !> A = Q * ( R ), !> ( 0 ) !> where: @@ -44614,8 +44616,6 @@ module stdlib_linalg_lapack_s !> 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. - - subroutine stdlib_sgeqr2p( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44662,15 +44662,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeqr2p - !> SGEQRF: computes a QR factorization of a real M-by-N matrix A: + + pure subroutine stdlib_sgeqrf( m, n, a, lda, tau, work, lwork, info ) + !> SGEQRF computes a QR factorization of a real 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. - - pure subroutine stdlib_sgeqrf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44764,6 +44764,8 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeqrf + + subroutine stdlib_sgeqrfp( m, n, a, lda, tau, work, lwork, info ) !> SGEQR2P computes a QR factorization of a real M-by-N matrix A: !> A = Q * ( R ), !> ( 0 ) @@ -44772,8 +44774,6 @@ module stdlib_linalg_lapack_s !> 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. - - subroutine stdlib_sgeqrfp( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44863,10 +44863,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeqrfp - !> SGEQRT2: computes a QR factorization of a real M-by-N matrix A, - !> using the compact WY representation of Q. pure subroutine stdlib_sgeqrt2( m, n, a, lda, t, ldt, info ) + !> SGEQRT2 computes a QR factorization of a real M-by-N matrix A, + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44931,12 +44931,12 @@ module stdlib_linalg_lapack_s end do end subroutine stdlib_sgeqrt2 - !> SGEQRT3: recursively computes a QR factorization of a real M-by-N + + pure recursive subroutine stdlib_sgeqrt3( m, n, a, lda, t, ldt, info ) + !> SGEQRT3 recursively computes a QR factorization of a real 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. - - pure recursive subroutine stdlib_sgeqrt3( m, n, a, lda, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45016,11 +45016,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeqrt3 - !> SGERFS: improves the computed solution to a system of linear - !> equations and provides error bounds and backward error estimates for - !> the solution. pure subroutine stdlib_sgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & + !> SGERFS improves the computed solution to a system of linear + !> equations and provides error bounds and backward error estimates for + !> the solution. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45209,10 +45209,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgerfs - !> SGERQ2: computes an RQ factorization of a real m by n matrix A: - !> A = R * Q. pure subroutine stdlib_sgerq2( m, n, a, lda, tau, work, info ) + !> SGERQ2 computes an RQ factorization of a real m by n matrix A: + !> A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45258,10 +45258,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgerq2 - !> SGERQF: computes an RQ factorization of a real M-by-N matrix A: - !> A = R * Q. pure subroutine stdlib_sgerqf( m, n, a, lda, tau, work, lwork, info ) + !> SGERQF computes an RQ factorization of a real M-by-N matrix A: + !> A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45364,7 +45364,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgerqf - !> SGETRF: computes an LU factorization of a general M-by-N matrix A + + pure subroutine stdlib_sgetrf( m, n, a, lda, ipiv, info ) + !> SGETRF 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 @@ -45372,8 +45374,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_sgetrf( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45442,7 +45442,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetrf - !> SGGHD3: reduces a pair of real matrices (A,B) to generalized upper + + pure subroutine stdlib_sgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & + !> SGGHD3 reduces a pair of real matrices (A,B) to generalized upper !> Hessenberg form using orthogonal transformations, where A is a !> general matrix and B is upper triangular. The form of the !> generalized eigenvalue problem is @@ -45467,8 +45469,6 @@ module stdlib_linalg_lapack_s !> problem to generalized Hessenberg form. !> This is a blocked variant of SGGHRD, using matrix-matrix !> multiplications for parts of the computation to enhance performance. - - pure subroutine stdlib_sgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45969,7 +45969,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgghd3 - !> SGGQRF: computes a generalized QR factorization of an N-by-M matrix A + + pure subroutine stdlib_sggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) + !> SGGQRF 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 orthogonal matrix, Z is a P-by-P orthogonal @@ -45987,8 +45989,6 @@ module stdlib_linalg_lapack_s !> inv(B)*A = Z**T*(inv(T)*R) !> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the !> transpose of the matrix Z. - - pure subroutine stdlib_sggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46047,7 +46047,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggqrf - !> SGGRQF: computes a generalized RQ factorization of an M-by-N matrix A + + pure subroutine stdlib_sggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) + !> SGGRQF 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 orthogonal matrix, Z is a P-by-P orthogonal @@ -46065,8 +46067,6 @@ module stdlib_linalg_lapack_s !> A*inv(B) = (R*inv(T))*Z**T !> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the !> transpose of the matrix Z. - - pure subroutine stdlib_sggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46125,13 +46125,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggrqf - !> SGTCON: estimates the reciprocal of the condition number of a real + + pure subroutine stdlib_sgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, iwork, info & + !> SGTCON estimates the reciprocal of the condition number of a real !> tridiagonal matrix A using the LU factorization as computed by !> SGTTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_sgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, iwork, info & ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46208,11 +46208,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgtcon - !> SGTRFS: 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. pure subroutine stdlib_sgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, x, & + !> SGTRFS 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. ldx, ferr, berr, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46410,14 +46410,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgtrfs - !> SGTSVX: uses the LU factorization to compute the solution to a real + + pure subroutine stdlib_sgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & + !> SGTSVX uses the LU factorization to compute the solution to a real !> system of linear equations A * X = B or A**T * X = B, !> where A is a tridiagonal matrix of order N and X and B are N-by-NRHS !> matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - pure subroutine stdlib_sgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & ldb, x, ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46499,7 +46499,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgtsvx - !> SHGEQZ: computes the eigenvalues of a real matrix pair (H,T), + + subroutine stdlib_shgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alphar, alphai, & + !> SHGEQZ computes the eigenvalues of a real 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 @@ -46542,8 +46544,6 @@ module stdlib_linalg_lapack_s !> Ref: C.B. Moler !> Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973), !> pp. 241--256. - - subroutine stdlib_shgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alphar, alphai, & beta, q, ldq, z, ldz, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47374,15 +47374,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_shgeqz - !> SLABRD: reduces the first NB rows and columns of a real general + + pure subroutine stdlib_slabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) + !> SLABRD reduces the first NB rows and columns of a real general !> m by n matrix A to upper or lower bidiagonal form by an orthogonal !> transformation Q**T * 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 SGEBRD - - pure subroutine stdlib_slabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47504,15 +47504,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slabrd - !> SLADIV: performs complex division in real arithmetic + + pure subroutine stdlib_sladiv( a, b, c, d, p, q ) + !> SLADIV 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" - - pure subroutine stdlib_sladiv( a, b, c, d, p, q ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47572,6 +47572,8 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sladiv + + pure subroutine stdlib_slaed4( n, i, d, z, delta, rho, dlam, info ) !> 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 @@ -47582,8 +47584,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_slaed4( n, i, d, z, delta, rho, dlam, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48177,14 +48177,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed4 - !> SLAED8: merges the two sets of eigenvalues together into a single + + pure subroutine stdlib_slaed8( icompq, k, n, qsiz, d, q, ldq, indxq, rho,cutpnt, z, dlamda, & + !> SLAED8 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. - - pure subroutine stdlib_slaed8( icompq, k, n, qsiz, d, q, ldq, indxq, rho,cutpnt, z, dlamda, & q2, ldq2, w, perm, givptr,givcol, givnum, indxp, indx, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48400,12 +48400,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed8 - !> SLAED9: finds the roots of the secular equation, as defined by the + + pure subroutine stdlib_slaed9( k, kstart, kstop, n, d, q, ldq, rho, dlamda, w,s, lds, info ) + !> SLAED9 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 SLAED4 and then stores the new matrix of !> eigenvectors for use in calculating the next level of Z vectors. - - pure subroutine stdlib_slaed9( k, kstart, kstop, n, d, q, ldq, rho, dlamda, w,s, lds, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48506,11 +48506,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed9 - !> SLAEIN: uses inverse iteration to find a right or left eigenvector - !> corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg - !> matrix H. pure subroutine stdlib_slaein( rightv, noinit, n, h, ldh, wr, wi, vr, vi, b,ldb, work, eps3, & + !> SLAEIN uses inverse iteration to find a right or left eigenvector + !> corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg + !> matrix H. smlnum, bignum, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48852,7 +48852,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaein - !> SLAGV2: computes the Generalized Schur factorization of a real 2-by-2 + + pure subroutine stdlib_slagv2( a, lda, b, ldb, alphar, alphai, beta, csl, snl,csr, snr ) + !> SLAGV2 computes the Generalized Schur factorization of a real 2-by-2 !> matrix pencil (A,B) where B is upper triangular. This routine !> computes orthogonal (rotation) matrices given by CSL, SNL and CSR, !> SNR such that @@ -48869,8 +48871,6 @@ module stdlib_linalg_lapack_s !> [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] !> [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ] !> where b11 >= b22 > 0. - - pure subroutine stdlib_slagv2( a, lda, b, ldb, alphar, alphai, beta, csl, snl,csr, snr ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49016,14 +49016,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slagv2 - !> SLAHR2: reduces the first NB columns of A real general n-BY-(n-k+1) + + pure subroutine stdlib_slahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) + !> SLAHR2 reduces the first NB columns of A real general n-BY-(n-k+1) !> matrix A so that elements below the k-th subdiagonal are zero. The !> reduction is performed by an orthogonal similarity transformation !> Q**T * A * Q. The routine returns the matrices V and T which determine !> Q as a block reflector I - V*T*V**T, and also the matrix Y = A * V * T. !> This is an auxiliary routine called by SGEHRD. - - pure subroutine stdlib_slahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49104,7 +49104,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slahr2 - !> SLALN2: solves a system of the form (ca A - w D ) X = s B + + pure subroutine stdlib_slaln2( ltrans, na, nw, smin, ca, a, lda, d1, d2, b,ldb, wr, wi, x, & + !> SLALN2 solves a system of the form (ca A - w D ) X = s B !> or (ca A**T - w D) X = s B with possible scaling ("s") and !> perturbation of A. (A**T means A-transpose.) !> A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA @@ -49129,8 +49131,6 @@ module stdlib_linalg_lapack_s !> correct to a factor of 2 or so. !> Note: all input quantities are assumed to be smaller than overflow !> by a reasonable factor. (See BIGNUM.) - - pure subroutine stdlib_slaln2( ltrans, na, nw, smin, ca, a, lda, d1, d2, b,ldb, wr, wi, x, & ldx, scale, xnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49429,7 +49429,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaln2 - !> SLALS0: applies back the multiplying factors of either the left or the + + pure subroutine stdlib_slals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, & + !> SLALS0 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. @@ -49449,8 +49451,6 @@ module stdlib_linalg_lapack_s !> null space. !> (3R) The inverse transformation of (2L). !> (4R) The inverse transformation of (1L). - - pure subroutine stdlib_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 ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49626,15 +49626,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slals0 - !> SLAMSWLQ: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_slamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & + !> SLAMSWLQ overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T !> where Q is a real orthogonal matrix defined as the product of blocked !> elementary reflectors computed by short wide LQ !> factorization (SLASWLQ) - - pure subroutine stdlib_slamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49784,15 +49784,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slamswlq - !> SLAMTSQR: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_slamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & + !> SLAMTSQR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T !> where Q is a real orthogonal matrix defined as the product !> of blocked elementary reflectors computed by tall skinny !> QR factorization (SLATSQR) - - pure subroutine stdlib_slamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49946,7 +49946,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slamtsqr - !> SLANV2: computes the Schur factorization of a real 2-by-2 nonsymmetric + + pure subroutine stdlib_slanv2( a, b, c, d, rt1r, rt1i, rt2r, rt2i, cs, sn ) + !> SLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric !> matrix in standard form: !> [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ] !> [ C D ] [ SN CS ] [ CC DD ] [-SN CS ] @@ -49954,8 +49956,6 @@ module stdlib_linalg_lapack_s !> 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or !> 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex !> conjugate eigenvalues. - - pure subroutine stdlib_slanv2( a, b, c, d, rt1r, rt1i, rt2r, rt2i, cs, sn ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50092,14 +50092,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slanv2 + + pure subroutine stdlib_slapll( n, x, incx, y, incy, ssmin ) !> 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. - - pure subroutine stdlib_slapll( n, x, incx, y, incy, ssmin ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50132,11 +50132,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slapll - !> SLAQP2: computes a QR factorization with column pivoting of - !> the block A(OFFSET+1:M,1:N). - !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. pure subroutine stdlib_slaqp2( m, n, offset, a, lda, jpvt, tau, vn1, vn2,work ) + !> SLAQP2 computes a QR factorization with column pivoting of + !> the block A(OFFSET+1:M,1:N). + !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50209,7 +50209,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaqp2 - !> SLAQPS: computes a step of QR factorization with column pivoting + + pure subroutine stdlib_slaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & + !> SLAQPS computes a step of QR factorization with column pivoting !> of a real 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. @@ -50217,8 +50219,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_slaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50343,10 +50343,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaqps - !> SLAQR5:, called by SLAQR0, performs a - !> single small-bulge multi-shift QR sweep. pure subroutine stdlib_slaqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts,sr, si, h, ldh, & + !> SLAQR5 , called by SLAQR0, performs a + !> single small-bulge multi-shift QR sweep. iloz, ihiz, z, ldz, v, ldv, u,ldu, nv, wv, ldwv, nh, wh, ldwh ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50750,7 +50750,9 @@ module stdlib_linalg_lapack_s end do loop_180 end subroutine stdlib_slaqr5 - !> SLAQTR: solves the real quasi-triangular system + + subroutine stdlib_slaqtr( ltran, lreal, n, t, ldt, b, w, scale, x, work,info ) + !> SLAQTR 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. @@ -50768,8 +50770,6 @@ module stdlib_linalg_lapack_s !> [ d ] [ q ] !> This subroutine is designed for the condition number estimation !> in routine STRSNA. - - subroutine stdlib_slaqtr( ltran, lreal, n, t, ldt, b, w, scale, x, work,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51196,7 +51196,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaqtr - !> SLASD3: finds all the square roots of the roots of the secular + + pure subroutine stdlib_slasd3( nl, nr, sqre, k, d, q, ldq, dsigma, u, ldu, u2,ldu2, vt, ldvt,& + !> SLASD3 finds all the square roots of the roots of the secular !> equation, as defined by the values in D and Z. It makes the !> appropriate calls to SLASD4 and then updates the singular !> vectors by matrix multiplication. @@ -51207,8 +51209,6 @@ module stdlib_linalg_lapack_s !> It could conceivably fail on hexadecimal or decimal machines !> without guard digits, but we know of none. !> SLASD3 is called from SLASD1. - - pure subroutine stdlib_slasd3( nl, nr, sqre, k, d, q, ldq, dsigma, u, ldu, u2,ldu2, vt, ldvt,& vt2, ldvt2, idxc, ctot, z,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51398,7 +51398,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd3 - !> SLASD6: computes the SVD of an updated upper bidiagonal matrix B + + pure subroutine stdlib_slasd6( icompq, nl, nr, sqre, d, vf, vl, alpha, beta,idxq, perm, & + !> SLASD6 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. @@ -51433,8 +51435,6 @@ module stdlib_linalg_lapack_s !> between the updated singular values and the old singular !> values. !> SLASD6 is called from SLASDA. - - pure subroutine stdlib_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 ) ! -- lapack auxiliary routine -- @@ -51526,13 +51526,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd6 - !> SOPGTR: generates a real orthogonal matrix Q which is defined as the + + pure subroutine stdlib_sopgtr( uplo, n, ap, tau, q, ldq, work, info ) + !> SOPGTR generates a real orthogonal matrix Q which is defined as the !> product of n-1 elementary reflectors H(i) of order n, as returned by !> SSPTRD using packed storage: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - - pure subroutine stdlib_sopgtr( uplo, n, ap, tau, q, ldq, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51613,7 +51613,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sopgtr - !> SOPMTR: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_sopmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) + !> SOPMTR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -51623,8 +51625,6 @@ module stdlib_linalg_lapack_s !> storage: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - - pure subroutine stdlib_sopmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51760,7 +51760,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sopmtr - !> SORBDB1: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_sorbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> SORBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -51775,8 +51777,6 @@ module stdlib_linalg_lapack_s !> Householder vectors. !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by !> angles THETA, PHI. - - subroutine stdlib_sorbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51863,7 +51863,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorbdb1 - !> SORBDB2: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_sorbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> SORBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -51878,8 +51880,6 @@ module stdlib_linalg_lapack_s !> Householder vectors. !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by !> angles THETA, PHI. - - subroutine stdlib_sorbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51976,7 +51976,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorbdb2 - !> SORBDB3: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_sorbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> SORBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -51991,8 +51993,6 @@ module stdlib_linalg_lapack_s !> Householder vectors. !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_sorbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52088,7 +52088,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorbdb3 - !> SORBDB4: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_sorbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> SORBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -52103,8 +52105,6 @@ module stdlib_linalg_lapack_s !> Householder vectors. !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_sorbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52230,7 +52230,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorbdb4 - !> SORCSD2BY1: computes the CS decomposition of an M-by-Q matrix X with + + subroutine stdlib_sorcsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & + !> SORCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with !> orthonormal columns that has been partitioned into a 2-by-1 block !> structure: !> [ I1 0 0 ] @@ -52245,8 +52247,6 @@ module stdlib_linalg_lapack_s !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). - - subroutine stdlib_sorcsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52645,13 +52645,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorcsd2by1 - !> SORGTR: generates a real orthogonal matrix Q which is defined as the + + pure subroutine stdlib_sorgtr( uplo, n, a, lda, tau, work, lwork, info ) + !> SORGTR generates a real orthogonal matrix Q which is defined as the !> product of n-1 elementary reflectors of order N, as returned by !> SSYTRD: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - - pure subroutine stdlib_sorgtr( uplo, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52746,13 +52746,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgtr - !> SORGTSQR: generates an M-by-N real matrix Q_out with orthonormal columns, + + pure subroutine stdlib_sorgtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) + !> SORGTSQR generates an M-by-N real matrix Q_out with orthonormal columns, !> which are the first N columns of a product of real orthogonal !> matrices of order M which are returned by SLATSQR !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). !> See the documentation for SLATSQR. - - pure subroutine stdlib_sorgtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52844,7 +52844,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgtsqr - !> SORMTR: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_sormtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & + !> SORMTR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T @@ -52853,8 +52855,6 @@ module stdlib_linalg_lapack_s !> nq-1 elementary reflectors, as returned by SSYTRD: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - - pure subroutine stdlib_sormtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52960,14 +52960,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormtr - !> SPBTRF: computes the Cholesky factorization of a real symmetric + + pure subroutine stdlib_spbtrf( uplo, n, kd, ab, ldab, info ) + !> SPBTRF computes the Cholesky factorization of a real symmetric !> positive definite band matrix A. !> The factorization has the form !> A = U**T * U, if UPLO = 'U', or !> A = L * L**T, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. - - pure subroutine stdlib_spbtrf( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53159,11 +53159,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spbtrf - !> SPFTRI: computes the inverse of a real (symmetric) positive definite - !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T - !> computed by SPFTRF. pure subroutine stdlib_spftri( transr, uplo, n, a, info ) + !> SPFTRI computes the inverse of a real (symmetric) positive definite + !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T + !> computed by SPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53317,15 +53317,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spftri - !> SPOTRF: computes the Cholesky factorization of a real symmetric + + pure subroutine stdlib_spotrf( uplo, n, a, lda, info ) + !> SPOTRF computes the Cholesky factorization of a real symmetric !> positive definite matrix A. !> The factorization has the form !> A = U**T * U, if UPLO = 'U', or !> A = L * L**T, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the block version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_spotrf( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53411,12 +53411,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spotrf - !> SPTRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_sptrfs( n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr,berr, work, info ) + !> SPTRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric positive definite !> and tridiagonal, and provides error bounds and backward error !> estimates for the solution. - - pure subroutine stdlib_sptrfs( n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr,berr, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53583,13 +53583,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sptrfs - !> SPTSV: computes the solution to a real system of linear equations + + pure subroutine stdlib_sptsv( n, nrhs, d, e, b, ldb, info ) + !> SPTSV computes the solution to a real system of linear equations !> A*X = B, where A is an N-by-N symmetric positive definite tridiagonal !> matrix, and X and B are N-by-NRHS matrices. !> A is factored as A = L*D*L**T, and the factored form of A is then !> used to solve the system of equations. - - pure subroutine stdlib_sptsv( n, nrhs, d, e, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53624,14 +53624,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sptsv - !> SPTSVX: uses the factorization A = L*D*L**T to compute the solution + + pure subroutine stdlib_sptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& + !> SPTSVX uses the factorization A = L*D*L**T to compute the solution !> to a real system of linear equations A*X = B, where A is an N-by-N !> symmetric positive definite tridiagonal matrix and X and B are !> N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - pure subroutine stdlib_sptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& work, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53698,10 +53698,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sptsvx - !> SSBEV: computes all the eigenvalues and, optionally, eigenvectors of - !> a real symmetric band matrix A. subroutine stdlib_ssbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,info ) + !> SSBEV computes all the eigenvalues and, optionally, eigenvectors of + !> a real symmetric band matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53800,12 +53800,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssbev - !> SSBEVX: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_ssbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & + !> SSBEVX computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric band matrix A. Eigenvalues and eigenvectors can !> be selected by specifying either a range of values or a range of !> indices for the desired eigenvalues. - - subroutine stdlib_ssbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & m, w, z, ldz, work, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54026,12 +54026,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssbevx - !> SSBGV: computes all the eigenvalues, and optionally, the eigenvectors + + pure subroutine stdlib_ssbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & + !> SSBGV computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-definite banded eigenproblem, of !> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric !> and banded, and B is also positive definite. - - pure subroutine stdlib_ssbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54104,14 +54104,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssbgv - !> SSBGVX: computes selected eigenvalues, and optionally, eigenvectors + + pure subroutine stdlib_ssbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & + !> SSBGVX computes selected eigenvalues, and optionally, eigenvectors !> of a real generalized symmetric-definite banded eigenproblem, of !> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric !> and banded, and B is also positive definite. Eigenvalues and !> eigenvectors can be selected by specifying either all eigenvalues, !> a range of values or a range of indices for the desired eigenvalues. - - pure subroutine stdlib_ssbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & vu, il, iu, abstol, m, w, z,ldz, work, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54289,10 +54289,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssbgvx - !> SSPEV: computes all the eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A in packed storage. subroutine stdlib_sspev( jobz, uplo, n, ap, w, z, ldz, work, info ) + !> SSPEV computes all the eigenvalues and, optionally, eigenvectors of a + !> real symmetric matrix A in packed storage. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54382,12 +54382,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspev - !> SSPEVX: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_sspevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> SSPEVX computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric matrix A in packed storage. Eigenvalues/vectors !> can be selected by specifying either a range of values or a range of !> indices for the desired eigenvalues. - - subroutine stdlib_sspevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & work, iwork, ifail,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54595,13 +54595,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspevx - !> SSPGV: computes all the eigenvalues and, optionally, the eigenvectors + + subroutine stdlib_sspgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,info ) + !> SSPGV computes all the eigenvalues and, optionally, the eigenvectors !> of a real generalized symmetric-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 symmetric, stored in packed format, !> and B is also positive definite. - - subroutine stdlib_sspgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54679,15 +54679,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspgv - !> SSPGVX: computes selected eigenvalues, and optionally, eigenvectors + + subroutine stdlib_sspgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & + !> SSPGVX computes selected eigenvalues, and optionally, eigenvectors !> of a real generalized symmetric-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 symmetric, stored in packed storage, and B !> is also positive definite. Eigenvalues and eigenvectors can be !> selected by specifying either a range of values or a range of indices !> for the desired eigenvalues. - - subroutine stdlib_sspgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & z, ldz, work, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54791,10 +54791,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspgvx - !> SSYEV: computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A. subroutine stdlib_ssyev( jobz, uplo, n, a, lda, w, work, lwork, info ) + !> SSYEV computes all eigenvalues and, optionally, eigenvectors of a + !> real symmetric matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54898,12 +54898,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyev - !> SSYEVX: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_ssyevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> SSYEVX computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric matrix A. Eigenvalues and eigenvectors can be !> selected by specifying either a range of values or a range of indices !> for the desired eigenvalues. - - subroutine stdlib_ssyevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & work, lwork, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55145,13 +55145,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyevx - !> SSYGV: computes all the eigenvalues, and optionally, the eigenvectors + + subroutine stdlib_ssygv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, info ) + !> SSYGV computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-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 symmetric and B is also !> positive definite. - - subroutine stdlib_ssygv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55245,14 +55245,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssygv - !> SSYGVX: computes selected eigenvalues, and optionally, eigenvectors + + subroutine stdlib_ssygvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& + !> SSYGVX computes selected eigenvalues, and optionally, eigenvectors !> of a real generalized symmetric-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 symmetric and B is also positive definite. !> Eigenvalues and eigenvectors can be selected by specifying either a !> range of values or a range of indices for the desired eigenvalues. - - subroutine stdlib_ssygvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& m, w, z, ldz, work,lwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55373,7 +55373,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssygvx - !> SSYSV: computes the solution to a real system of linear equations + + pure subroutine stdlib_ssysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) + !> SSYSV computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS !> matrices. @@ -55384,8 +55386,6 @@ module stdlib_linalg_lapack_s !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_ssysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55451,14 +55451,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssysv - !> SSYSVX: uses the diagonal pivoting factorization to compute the + + subroutine stdlib_ssysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & + !> SSYSVX uses the diagonal pivoting factorization to compute the !> solution to a real system of linear equations A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS !> matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_ssysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & ferr, berr, work, lwork,iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55548,11 +55548,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssysvx - !> SSYTRD_SY2SB: reduces a real symmetric matrix A to real symmetric - !> band-diagonal form AB by a orthogonal similarity transformation: - !> Q**T * A * Q = AB. pure subroutine stdlib_ssytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) + !> SSYTRD_SY2SB reduces a real symmetric matrix A to real symmetric + !> band-diagonal form AB by a orthogonal similarity transformation: + !> Q**T * A * Q = AB. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55724,7 +55724,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrd_sy2sb - !> STGEVC: computes some or all of the right and/or left eigenvectors of + + pure subroutine stdlib_stgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & + !> STGEVC computes some or all of the right and/or left eigenvectors of !> a pair of real matrices (S,P), where S is a quasi-triangular matrix !> and P is upper triangular. Matrix pairs of this type are produced by !> the generalized Schur factorization of a matrix pair (A,B): @@ -55742,8 +55744,6 @@ module stdlib_linalg_lapack_s !> If Q and Z are the orthogonal factors from the generalized Schur !> factorization of a matrix pair (A,B), then Z*X and Q*Y !> are the matrices of right and left eigenvectors of (A,B). - - pure subroutine stdlib_stgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & mm, m, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56454,7 +56454,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgevc - !> STGEX2: swaps adjacent diagonal blocks (A11, B11) and (A22, B22) + + pure subroutine stdlib_stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, n1, n2, & + !> STGEX2 swaps adjacent diagonal blocks (A11, B11) and (A22, B22) !> of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair !> (A, B) by an orthogonal equivalence transformation. !> (A, B) must be in generalized real Schur canonical form (as returned @@ -56464,8 +56466,6 @@ module stdlib_linalg_lapack_s !> updated. !> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T !> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T - - pure subroutine stdlib_stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, n1, n2, & work, lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56819,7 +56819,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgex2 - !> STGEXC: reorders the generalized real Schur decomposition of a real + + pure subroutine stdlib_stgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & + !> STGEXC reorders the generalized real Schur decomposition of a real !> matrix pair (A,B) using an orthogonal equivalence transformation !> (A, B) = Q * (A, B) * Z**T, !> so that the diagonal block of (A, B) with row index IFST is moved @@ -56831,8 +56833,6 @@ module stdlib_linalg_lapack_s !> updated. !> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T !> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T - - pure subroutine stdlib_stgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57068,7 +57068,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgexc - !> STGSEN: reorders the generalized real Schur decomposition of a real + + pure subroutine stdlib_stgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alphar, alphai, & + !> STGSEN reorders the generalized real Schur decomposition of a real !> matrix pair (A, B) (in terms of an orthonormal equivalence trans- !> formation Q**T * (A, B) * Z), so that a selected cluster of eigenvalues !> appears in the leading diagonal blocks of the upper quasi-triangular @@ -57088,8 +57090,6 @@ module stdlib_linalg_lapack_s !> the selected cluster and the eigenvalues outside the cluster, resp., !> and norms of "projections" onto left and right eigenspaces w.r.t. !> the selected cluster in the (1,1)-block. - - pure subroutine stdlib_stgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alphar, alphai, & beta, q, ldq, z, ldz, m, pl,pr, dif, work, lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57394,7 +57394,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgsen - !> STGSJA: computes the generalized singular value decomposition (GSVD) + + pure subroutine stdlib_stgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & + !> STGSJA computes the generalized singular value decomposition (GSVD) !> of two real upper triangular (or trapezoidal) matrices A and B. !> On entry, it is assumed that matrices A and B have the following !> forms, which may be obtained by the preprocessing subroutine SGGSVP @@ -57455,8 +57457,6 @@ module stdlib_linalg_lapack_s !> The computation of the orthogonal transformation matrices U, V or Q !> is optional. These matrices may either be formed explicitly, or they !> may be postmultiplied into input matrices U1, V1, or Q1. - - pure subroutine stdlib_stgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & alpha, beta, u, ldu, v, ldv,q, ldq, work, ncycle, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57635,7 +57635,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgsja - !> STGSNA: estimates reciprocal condition numbers for specified + + pure subroutine stdlib_stgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & + !> STGSNA estimates reciprocal condition numbers for specified !> eigenvalues and/or eigenvectors of a matrix pair (A, B) in !> generalized real Schur canonical form (or of any matrix pair !> (Q*A*Z**T, Q*B*Z**T) with orthogonal matrices Q and Z, where @@ -57643,8 +57645,6 @@ module stdlib_linalg_lapack_s !> (A, B) must be in generalized real Schur form (as returned by SGGES), !> i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal !> blocks. B is upper triangular. - - pure subroutine stdlib_stgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & dif, mm, m, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57883,12 +57883,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgsna - !> STPLQT: computes a blocked LQ factorization of a real + + pure subroutine stdlib_stplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) + !> STPLQT computes a blocked LQ factorization of a real !> "triangular-pentagonal" matrix C, which is composed of a !> triangular block A and pentagonal block B, using the compact !> WY representation for Q. - - pure subroutine stdlib_stplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57945,12 +57945,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stplqt - !> STPQRT: computes a blocked QR factorization of a real + + pure subroutine stdlib_stpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) + !> STPQRT computes a blocked QR factorization of a real !> "triangular-pentagonal" matrix C, which is composed of a !> triangular block A and pentagonal block B, using the compact !> WY representation for Q. - - pure subroutine stdlib_stpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58007,7 +58007,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stpqrt - !> STREVC: computes some or all of the right and/or left eigenvectors of + + pure subroutine stdlib_strevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & + !> STREVC computes some or all of the right and/or left eigenvectors of !> a real upper quasi-triangular matrix T. !> Matrices of this type are produced by the Schur factorization of !> a real general matrix: A = Q*T*Q**T, as computed by SHSEQR. @@ -58022,8 +58024,6 @@ module stdlib_linalg_lapack_s !> input matrix. If Q is the orthogonal factor that reduces a matrix !> A to Schur form T, then Q*X and Q*Y are the matrices of right and !> left eigenvectors of A. - - pure subroutine stdlib_strevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58620,7 +58620,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strevc - !> STREVC3: computes some or all of the right and/or left eigenvectors of + + pure subroutine stdlib_strevc3( side, howmny, select, n, t, ldt, vl, ldvl,vr, ldvr, mm, m, & + !> STREVC3 computes some or all of the right and/or left eigenvectors of !> a real upper quasi-triangular matrix T. !> Matrices of this type are produced by the Schur factorization of !> a real general matrix: A = Q*T*Q**T, as computed by SHSEQR. @@ -58636,8 +58638,6 @@ module stdlib_linalg_lapack_s !> A to Schur form T, then Q*X and Q*Y are the matrices of right and !> left eigenvectors of A. !> This uses a Level 3 BLAS version of the back transformation. - - pure subroutine stdlib_strevc3( side, howmny, select, n, t, ldt, vl, ldvl,vr, ldvr, mm, m, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59442,7 +59442,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strevc3 - !> STRSYL: solves the real Sylvester matrix equation: + + subroutine stdlib_strsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) + !> STRSYL solves the real Sylvester matrix equation: !> op(A)*X + X*op(B) = scale*C or !> op(A)*X - X*op(B) = scale*C, !> where op(A) = A or A**T, and A and B are both upper quasi- @@ -59453,8 +59455,6 @@ module stdlib_linalg_lapack_s !> 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. - - subroutine stdlib_strsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60103,11 +60103,11 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strsyl - !> SGEBRD: reduces a general real M-by-N matrix A to upper or lower - !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. - !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. pure subroutine stdlib_sgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) + !> SGEBRD reduces a general real M-by-N matrix A to upper or lower + !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. + !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60208,10 +60208,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgebrd - !> SGEHRD: reduces a real general matrix A to upper Hessenberg form H by - !> an orthogonal similarity transformation: Q**T * A * Q = H . pure subroutine stdlib_sgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info ) + !> SGEHRD reduces a real general matrix A to upper Hessenberg form H by + !> an orthogonal similarity transformation: Q**T * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60337,10 +60337,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgehrd - !> DGELQT computes a blocked LQ factorization of a real M-by-N matrix A - !> using the compact WY representation of Q. pure subroutine stdlib_sgelqt( m, n, mb, a, lda, t, ldt, work, info ) + !> DGELQT computes a blocked LQ factorization of a real M-by-N matrix A + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60388,7 +60388,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgelqt - !> SGELS: solves overdetermined or underdetermined real linear systems + + subroutine stdlib_sgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) + !> SGELS solves overdetermined or underdetermined real linear systems !> involving an M-by-N matrix A, or its transpose, using a QR or LQ !> factorization of A. It is assumed that A has full rank. !> The following options are provided: @@ -60406,8 +60408,6 @@ module stdlib_linalg_lapack_s !> 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. - - subroutine stdlib_sgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60605,15 +60605,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgels - !> SGEMLQ: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_sgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & + !> SGEMLQ overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T !> where Q is a real orthogonal matrix defined as the product !> of blocked elementary reflectors computed by short wide LQ !> factorization (SGELQ) - - pure subroutine stdlib_sgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60702,15 +60702,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgemlq - !> SGEMQR: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_sgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & + !> SGEMQR overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q !> TRANS = 'T': Q**T * C C * Q**T !> where Q is a real orthogonal matrix defined as the product !> of blocked elementary reflectors computed by tall skinny !> QR factorization (SGEQR) - - pure subroutine stdlib_sgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60799,10 +60799,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgemqr - !> SGEQP3: computes a QR factorization with column pivoting of a - !> matrix A: A*P = Q*R using Level 3 BLAS. pure subroutine stdlib_sgeqp3( m, n, a, lda, jpvt, tau, work, lwork, info ) + !> SGEQP3 computes a QR factorization with column pivoting of a + !> matrix A: A*P = Q*R using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60948,10 +60948,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeqp3 - !> SGEQRT: computes a blocked QR factorization of a real M-by-N matrix A - !> using the compact WY representation of Q. pure subroutine stdlib_sgeqrt( m, n, nb, a, lda, t, ldt, work, info ) + !> SGEQRT computes a blocked QR factorization of a real M-by-N matrix A + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61005,7 +61005,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeqrt - !> SGESV: computes the solution to a real system of linear equations + + pure subroutine stdlib_sgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) + !> SGESV computes the solution to a real 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 @@ -61014,8 +61016,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_sgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61053,14 +61053,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgesv - !> SGESVX: uses the LU factorization to compute the solution to a real + + subroutine stdlib_sgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & + !> SGESVX uses the LU factorization to compute the solution to a real !> system of linear equations !> A * X = B, !> where A is an N-by-N matrix and X and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_sgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & x, ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61257,7 +61257,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgesvx - !> SGGES: computes for a pair of N-by-N real nonsymmetric matrices (A,B), + + subroutine stdlib_sgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alphar, & + !> SGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B), !> the generalized eigenvalues, the generalized real Schur form (S,T), !> optionally, the left and/or right matrices of Schur vectors (VSL and !> VSR). This gives the generalized Schur factorization @@ -61283,8 +61285,6 @@ module stdlib_linalg_lapack_s !> [ 0 b ] !> and the pair of corresponding 2-by-2 blocks in S and T will have a !> complex conjugate pair of generalized eigenvalues. - - subroutine stdlib_sgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alphar, & alphai, beta, vsl, ldvsl, vsr,ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61576,7 +61576,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgges - !> SGGESX: computes for a pair of N-by-N real nonsymmetric matrices + + subroutine stdlib_sggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, & + !> SGGESX computes for a pair of N-by-N real nonsymmetric matrices !> (A,B), the generalized eigenvalues, the real Schur form (S,T), and, !> optionally, the left and/or right matrices of Schur vectors (VSL and !> VSR). This gives the generalized Schur factorization @@ -61604,8 +61606,6 @@ module stdlib_linalg_lapack_s !> [ 0 b ] !> and the pair of corresponding 2-by-2 blocks in S and T will have a !> complex conjugate pair of generalized eigenvalues. - - subroutine stdlib_sggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, & alphar, alphai, beta, vsl, ldvsl,vsr, ldvsr, rconde, rcondv, work, lwork, iwork,liwork, & bwork, info ) ! -- lapack driver routine -- @@ -61946,7 +61946,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggesx - !> SGGEV: computes for a pair of N-by-N real nonsymmetric matrices (A,B) + + subroutine stdlib_sggev( jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai,beta, vl, ldvl, vr, & + !> SGGEV computes for a pair of N-by-N real 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 @@ -61961,8 +61963,6 @@ module stdlib_linalg_lapack_s !> 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). - - subroutine stdlib_sggev( jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai,beta, vl, ldvl, vr, & ldvr, work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62244,7 +62244,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggev - !> SGGEVX: computes for a pair of N-by-N real nonsymmetric matrices (A,B) + + subroutine stdlib_sggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alphar, alphai, & + !> SGGEVX computes for a pair of N-by-N real nonsymmetric matrices (A,B) !> the generalized eigenvalues, and optionally, the left and/or right !> generalized eigenvectors. !> Optionally also, it computes a balancing transformation to improve @@ -62264,8 +62266,6 @@ module stdlib_linalg_lapack_s !> 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). - - subroutine stdlib_sggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alphar, alphai, & beta, vl, ldvl, vr, ldvr, ilo,ihi, lscale, rscale, abnrm, bbnrm, rconde,rcondv, work, lwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -62638,7 +62638,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggevx - !> SGGGLM: solves a general Gauss-Markov linear model (GLM) problem: + + pure subroutine stdlib_sggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) + !> SGGGLM 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 @@ -62656,8 +62658,6 @@ module stdlib_linalg_lapack_s !> minimize || inv(B)*(d-A*x) ||_2 !> x !> where inv(B) denotes the inverse of B. - - pure subroutine stdlib_sggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62774,7 +62774,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggglm - !> SGGLSE: solves the linear equality-constrained least squares (LSE) + + pure subroutine stdlib_sgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) + !> SGGLSE 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 @@ -62786,8 +62788,6 @@ module stdlib_linalg_lapack_s !> which is obtained using a generalized RQ factorization of the !> matrices (B, A) given by !> B = (0 R)*Q, A = Z*T*Q. - - pure subroutine stdlib_sgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62906,14 +62906,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgglse - !> SHSEIN: uses inverse iteration to find specified right and/or left + + subroutine stdlib_shsein( side, eigsrc, initv, select, n, h, ldh, wr, wi,vl, ldvl, vr, ldvr, & + !> SHSEIN uses inverse iteration to find specified right and/or left !> eigenvectors of a real 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. - - subroutine stdlib_shsein( side, eigsrc, initv, select, n, h, ldh, wr, wi,vl, ldvl, vr, ldvr, & mm, m, work, ifaill,ifailr, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63121,14 +63121,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_shsein - !> SLA_PORPVGRW: computes the reciprocal pivot growth factor + + real(sp) function stdlib_sla_porpvgrw( uplo, ncols, a, lda, af, ldaf, work ) + !> SLA_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. - - real(sp) function stdlib_sla_porpvgrw( uplo, ncols, a, lda, af, ldaf, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63209,7 +63209,9 @@ module stdlib_linalg_lapack_s stdlib_sla_porpvgrw = rpvgrw end function stdlib_sla_porpvgrw - !> SLAED3: finds the roots of the secular equation, as defined by the + + pure subroutine stdlib_slaed3( k, n, n1, d, q, ldq, rho, dlamda, q2, indx,ctot, w, s, info ) + !> SLAED3 finds the roots of the secular equation, as defined by the !> values in D, W, and RHO, between 1 and K. It makes the !> appropriate calls to SLAED4 and then updates the eigenvectors by !> multiplying the matrix of eigenvectors of the pair of eigensystems @@ -63221,8 +63223,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_slaed3( k, n, n1, d, q, ldq, rho, dlamda, q2, indx,ctot, w, s, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63344,7 +63344,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed3 - !> SLAED7: computes the updated eigensystem of a diagonal + + pure subroutine stdlib_slaed7( icompq, n, qsiz, tlvls, curlvl, curpbm, d, q,ldq, indxq, rho, & + !> SLAED7 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 symmetric matrix @@ -63370,8 +63372,6 @@ module stdlib_linalg_lapack_s !> directly using the updated eigenvalues. The eigenvectors for !> the current problem are multiplied with the eigenvectors from !> the overall problem. - - pure subroutine stdlib_slaed7( icompq, n, qsiz, tlvls, curlvl, curpbm, d, q,ldq, indxq, rho, & cutpnt, qstore, qptr, prmptr,perm, givptr, givcol, givnum, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63478,15 +63478,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed7 - !> SLAEXC: swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in + + subroutine stdlib_slaexc( wantq, n, t, ldt, q, ldq, j1, n1, n2, work,info ) + !> SLAEXC 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. - - subroutine stdlib_slaexc( wantq, n, t, ldt, q, ldq, j1, n1, n2, work,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63675,12 +63675,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaexc - !> SLAHQR: is an auxiliary routine called by SHSEQR to update the + + pure subroutine stdlib_slahqr( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, & + !> SLAHQR is an auxiliary routine called by SHSEQR to update the !> eigenvalues and Schur decomposition already computed by SHSEQR, by !> dealing with the Hessenberg submatrix in rows and columns ILO to !> IHI. - - pure subroutine stdlib_slahqr( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, & info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63984,15 +63984,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slahqr - !> SLASD2: merges the two sets of singular values together into a single + + pure subroutine stdlib_slasd2( nl, nr, sqre, k, d, z, alpha, beta, u, ldu, vt,ldvt, dsigma, & + !> SLASD2 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. !> SLASD2 is called from SLASD1. - - pure subroutine stdlib_slasd2( nl, nr, sqre, k, d, z, alpha, beta, u, ldu, vt,ldvt, dsigma, & u2, ldu2, vt2, ldvt2, idxp, idx,idxc, idxq, coltyp, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64269,7 +64269,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd2 - !> SLASWLQ: computes a blocked Tall-Skinny LQ factorization of + + pure subroutine stdlib_slaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) + !> SLASWLQ computes a blocked Tall-Skinny LQ factorization of !> a real M-by-N matrix A for M <= N: !> A = ( L 0 ) * Q, !> where: @@ -64279,8 +64281,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_slaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -64353,7 +64353,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaswlq - !> SLATSQR: computes a blocked Tall-Skinny QR factorization of + + pure subroutine stdlib_slatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) + !> SLATSQR computes a blocked Tall-Skinny QR factorization of !> a real M-by-N matrix A for M >= N: !> A = Q * ( R ), !> ( 0 ) @@ -64364,8 +64366,6 @@ module stdlib_linalg_lapack_s !> R is an upper-triangular N-by-N matrix, stored on exit in !> the elements on and above the diagonal of the array A. !> 0 is a (M-N)-by-N zero matrix, and is not stored. - - pure subroutine stdlib_slatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -64438,7 +64438,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slatsqr - !> SORGBR: generates one of the real orthogonal matrices Q or P**T + + pure subroutine stdlib_sorgbr( vect, m, n, k, a, lda, tau, work, lwork, info ) + !> SORGBR generates one of the real orthogonal matrices Q or P**T !> determined by SGEBRD when reducing a real matrix A to bidiagonal !> form: A = Q * B * P**T. Q and P**T are defined as products of !> elementary reflectors H(i) or G(i) respectively. @@ -64454,8 +64456,6 @@ module stdlib_linalg_lapack_s !> rows of P**T, where n >= m >= k; !> if k >= n, P**T = G(n-1) . . . G(2) G(1) and SORGBR returns P**T as !> an N-by-N matrix. - - pure subroutine stdlib_sorgbr( vect, m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64587,6 +64587,8 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgbr + + pure subroutine stdlib_sormbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & !> If VECT = 'Q', SORMBR: overwrites the general real M-by-N matrix C !> with !> SIDE = 'L' SIDE = 'R' @@ -64609,8 +64611,6 @@ module stdlib_linalg_lapack_s !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: !> if k < nq, P = G(1) G(2) . . . G(k); !> if k >= nq, P = G(1) G(2) . . . G(nq-1). - - pure subroutine stdlib_sormbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64745,7 +64745,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormbr - !> SPBSV: computes the solution to a real system of linear equations + + pure subroutine stdlib_spbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) + !> SPBSV computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite band matrix and X !> and B are N-by-NRHS matrices. @@ -64756,8 +64758,6 @@ module stdlib_linalg_lapack_s !> triangular band matrix, with the same number of superdiagonals or !> subdiagonals as A. The factored form of A is then used to solve the !> system of equations A * X = B. - - pure subroutine stdlib_spbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64799,15 +64799,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spbsv - !> SPBSVX: uses the Cholesky factorization A = U**T*U or A = L*L**T to + + subroutine stdlib_spbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & + !> SPBSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to !> compute the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite band matrix and X !> and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_spbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64955,15 +64955,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spbsvx - !> SPFTRF: computes the Cholesky factorization of a real symmetric + + pure subroutine stdlib_spftrf( transr, uplo, n, a, info ) + !> SPFTRF computes the Cholesky factorization of a real symmetric !> positive definite matrix A. !> The factorization has the form !> A = U**T * U, if UPLO = 'U', or !> A = L * L**T, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the block version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_spftrf( transr, uplo, n, a, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65130,7 +65130,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spftrf - !> SPOSV: computes the solution to a real system of linear equations + + pure subroutine stdlib_sposv( uplo, n, nrhs, a, lda, b, ldb, info ) + !> SPOSV computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite matrix and X and B !> are N-by-NRHS matrices. @@ -65140,8 +65142,6 @@ module stdlib_linalg_lapack_s !> where U is an upper triangular matrix and L is a lower triangular !> matrix. The factored form of A is then used to solve the system of !> equations A * X = B. - - pure subroutine stdlib_sposv( uplo, n, nrhs, a, lda, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65181,15 +65181,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sposv - !> SPOSVX: uses the Cholesky factorization A = U**T*U or A = L*L**T to + + subroutine stdlib_sposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & + !> SPOSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to !> compute the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric positive definite matrix and X and B !> are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_sposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & rcond, ferr, berr, work,iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65324,7 +65324,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sposvx - !> STREXC: reorders the real Schur factorization of a real matrix + + subroutine stdlib_strexc( compq, n, t, ldt, q, ldq, ifst, ilst, work,info ) + !> STREXC reorders the real Schur factorization of a real matrix !> A = Q*T*Q**T, so that the diagonal block of T with row index IFST is !> moved to row ILST. !> The real Schur form T is reordered by an orthogonal similarity @@ -65334,8 +65336,6 @@ module stdlib_linalg_lapack_s !> 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. - - subroutine stdlib_strexc( compq, n, t, ldt, q, ldq, ifst, ilst, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65528,7 +65528,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strexc - !> STRSEN: reorders the real Schur factorization of a real matrix + + subroutine stdlib_strsen( job, compq, select, n, t, ldt, q, ldq, wr, wi,m, s, sep, work, & + !> STRSEN reorders the real Schur factorization of a real matrix !> A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in !> the leading diagonal blocks of the upper quasi-triangular matrix T, !> and the leading columns of Q form an orthonormal basis of the @@ -65539,8 +65541,6 @@ module stdlib_linalg_lapack_s !> 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. - - subroutine stdlib_strsen( job, compq, select, n, t, ldt, q, ldq, wr, wi,m, s, sep, work, & lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65723,7 +65723,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strsen - !> STRSNA: estimates reciprocal condition numbers for specified + + subroutine stdlib_strsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm, m, & + !> STRSNA estimates reciprocal condition numbers for specified !> eigenvalues and/or right eigenvectors of a real upper !> quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q !> orthogonal). @@ -65731,8 +65733,6 @@ module stdlib_linalg_lapack_s !> 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. - - subroutine stdlib_strsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm, m, & work, ldwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65968,14 +65968,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strsna - !> SGELQ: computes an LQ factorization of a real M-by-N matrix A: + + pure subroutine stdlib_sgelq( m, n, a, lda, t, tsize, work, lwork,info ) + !> SGELQ computes an LQ factorization of a real 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. - - pure subroutine stdlib_sgelq( m, n, a, lda, t, tsize, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -66093,7 +66093,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgelq - !> SGELSY: computes the minimum-norm solution to a real linear least + + subroutine stdlib_sgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, info ) + !> SGELSY computes the minimum-norm solution to a real linear least !> squares problem: !> minimize || A * X - B || !> using a complete orthogonal factorization of A. A is an M-by-N @@ -66125,8 +66127,6 @@ module stdlib_linalg_lapack_s !> o Matrix B (the right hand side) is updated with Blas-3. !> o The permutation of matrix B (the right hand side) is faster and !> more simple. - - subroutine stdlib_sgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66326,15 +66326,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgelsy - !> SGEQR: computes a QR factorization of a real M-by-N matrix A: + + pure subroutine stdlib_sgeqr( m, n, a, lda, t, tsize, work, lwork,info ) + !> SGEQR computes a QR factorization of a real 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. - - pure subroutine stdlib_sgeqr( m, n, a, lda, t, tsize, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -66441,7 +66441,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeqr - !> SGETSLS: solves overdetermined or underdetermined real linear systems + + subroutine stdlib_sgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) + !> SGETSLS solves overdetermined or underdetermined real 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: @@ -66459,8 +66461,6 @@ module stdlib_linalg_lapack_s !> 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. - - subroutine stdlib_sgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -66677,7 +66677,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetsls - !> SGETSQRHRT: computes a NB2-sized column blocked QR-factorization + + pure subroutine stdlib_sgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) + !> SGETSQRHRT 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 @@ -66689,8 +66691,6 @@ module stdlib_linalg_lapack_s !> The output Q and R factors are stored in the same format as in SGEQRT !> (Q is in blocked compact WY-representation). See the documentation !> of SGEQRT for more details on the format. - - pure subroutine stdlib_sgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66810,14 +66810,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetsqrhrt - !> SLAED2: merges the two sets of eigenvalues together into a single + + pure subroutine stdlib_slaed2( k, n, n1, d, q, ldq, indxq, rho, z, dlamda, w,q2, indx, indxc,& + !> SLAED2 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 entry in the !> Z vector. For each such occurrence the order of the related secular !> equation problem is reduced by one. - - pure subroutine stdlib_slaed2( k, n, n1, d, q, ldq, indxq, rho, z, dlamda, w,q2, indx, indxc,& indxp, coltyp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67067,7 +67067,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed2 - !> SLAQR2: is identical to SLAQR3 except that it avoids + + subroutine stdlib_slaqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& + !> SLAQR2 is identical to SLAQR3 except that it avoids !> recursion by calling SLAHQR instead of SLAQR4. !> Aggressive early deflation: !> This subroutine accepts as input an upper Hessenberg matrix @@ -67078,8 +67080,6 @@ module stdlib_linalg_lapack_s !> an orthogonal similarity transformation of H. It is to be !> hoped that the final version of H has many zero subdiagonal !> entries. - - subroutine stdlib_slaqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& sr, si, v, ldv, nh, t,ldt, nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67370,7 +67370,9 @@ module stdlib_linalg_lapack_s work( 1 ) = real( lwkopt,KIND=sp) end subroutine stdlib_slaqr2 - !> SLASD1: computes the SVD of an upper bidiagonal N-by-M matrix B, + + pure subroutine stdlib_slasd1( nl, nr, sqre, d, alpha, beta, u, ldu, vt, ldvt,idxq, iwork, & + !> SLASD1 computes the SVD of an upper bidiagonal N-by-M matrix B, !> where N = NL + NR + 1 and M = N + SQRE. SLASD1 is called from SLASD0. !> A related subroutine SLASD7 handles the case in which the singular !> values (and the singular vectors in factored form) are desired. @@ -67399,8 +67401,6 @@ module stdlib_linalg_lapack_s !> directly using the updated singular values. The singular vectors !> for the current problem are multiplied with the singular vectors !> from the overall problem. - - pure subroutine stdlib_slasd1( nl, nr, sqre, d, alpha, beta, u, ldu, vt, ldvt,idxq, iwork, & work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67485,7 +67485,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd1 - !> SLAED1: computes the updated eigensystem of a diagonal + + pure subroutine stdlib_slaed1( n, d, q, ldq, indxq, rho, cutpnt, work, iwork,info ) + !> SLAED1 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. SLAED7 handles @@ -67511,8 +67513,6 @@ module stdlib_linalg_lapack_s !> directly using the updated eigenvalues. The eigenvectors for !> the current problem are multiplied with the eigenvectors from !> the overall problem. - - pure subroutine stdlib_slaed1( n, d, q, ldq, indxq, rho, cutpnt, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67588,10 +67588,10 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed1 - !> SLAED0: computes all eigenvalues and corresponding eigenvectors of a - !> symmetric tridiagonal matrix using the divide and conquer method. pure subroutine stdlib_slaed0( icompq, qsiz, n, d, e, q, ldq, qstore, ldqs,work, iwork, info & + !> SLAED0 computes all eigenvalues and corresponding eigenvectors of a + !> symmetric tridiagonal matrix using the divide and conquer method. ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67792,7 +67792,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed0 - !> SSTEDC: computes all eigenvalues and, optionally, eigenvectors of a + + pure subroutine stdlib_sstedc( compz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) + !> SSTEDC computes all eigenvalues and, optionally, eigenvectors of a !> symmetric tridiagonal matrix using the divide and conquer method. !> The eigenvectors of a full or band real symmetric matrix can also be !> found if SSYTRD or SSPTRD or SSBTRD has been used to reduce this @@ -67803,8 +67805,6 @@ module stdlib_linalg_lapack_s !> 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 SLAED3 for details. - - pure subroutine stdlib_sstedc( compz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68018,7 +68018,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sstedc - !> SSTEVD: computes all eigenvalues and, optionally, eigenvectors of a + + pure subroutine stdlib_sstevd( jobz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) + !> SSTEVD computes all eigenvalues and, optionally, eigenvectors of a !> real symmetric tridiagonal matrix. If eigenvectors are desired, it !> uses a divide and conquer algorithm. !> The divide and conquer algorithm makes very mild assumptions about @@ -68027,8 +68029,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_sstevd( jobz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68123,7 +68123,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sstevd - !> SSYEVD: computes all eigenvalues and, optionally, eigenvectors of a + + subroutine stdlib_ssyevd( jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info ) + !> SSYEVD computes all eigenvalues and, optionally, eigenvectors of a !> real symmetric matrix A. If eigenvectors are desired, it uses a !> divide and conquer algorithm. !> The divide and conquer algorithm makes very mild assumptions about @@ -68134,8 +68136,6 @@ module stdlib_linalg_lapack_s !> without guard digits, but we know of none. !> Because of large use of BLAS of level 3, SSYEVD needs N**2 more !> workspace than SSYEVX. - - subroutine stdlib_ssyevd( jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -68257,7 +68257,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyevd - !> SSYGVD: computes all the eigenvalues, and optionally, the eigenvectors + + subroutine stdlib_ssygvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, iwork, liwork,& + !> SSYGVD computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-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 symmetric and B is also positive definite. @@ -68268,8 +68270,6 @@ module stdlib_linalg_lapack_s !> 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. - - subroutine stdlib_ssygvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, iwork, liwork,& info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68378,7 +68378,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssygvd - !> SSBEVD: computes all the eigenvalues and, optionally, eigenvectors of + + subroutine stdlib_ssbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, iwork, liwork, & + !> SSBEVD computes all the eigenvalues and, optionally, eigenvectors of !> a real symmetric band matrix A. If eigenvectors are desired, it uses !> a divide and conquer algorithm. !> The divide and conquer algorithm makes very mild assumptions about @@ -68387,8 +68389,6 @@ module stdlib_linalg_lapack_s !> 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. - - subroutine stdlib_ssbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, iwork, liwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68510,7 +68510,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssbevd - !> SSBGVD: computes all the eigenvalues, and optionally, the eigenvectors + + pure subroutine stdlib_ssbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & + !> SSBGVD computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-definite banded eigenproblem, of the !> form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric and !> banded, and B is also positive definite. If eigenvectors are @@ -68521,8 +68523,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_ssbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & lwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68627,7 +68627,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssbgvd - !> SSPEVD: computes all the eigenvalues and, optionally, eigenvectors + + subroutine stdlib_sspevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,iwork, liwork, info ) + !> SSPEVD computes all the eigenvalues and, optionally, eigenvectors !> of a real symmetric 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 @@ -68636,8 +68638,6 @@ module stdlib_linalg_lapack_s !> 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. - - subroutine stdlib_sspevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68752,7 +68752,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspevd - !> SSPGVD: computes all the eigenvalues, and optionally, the eigenvectors + + subroutine stdlib_sspgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, iwork, liwork,& + !> SSPGVD computes all the eigenvalues, and optionally, the eigenvectors !> of a real generalized symmetric-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 symmetric, stored in packed format, and B is also @@ -68764,8 +68766,6 @@ module stdlib_linalg_lapack_s !> 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. - - subroutine stdlib_sspgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, iwork, liwork,& info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68876,7 +68876,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspgvd - !> SBDSDC: computes the singular value decomposition (SVD) of a real + + pure subroutine stdlib_sbdsdc( uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq,work, iwork, & + !> SBDSDC 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 @@ -68892,8 +68894,6 @@ module stdlib_linalg_lapack_s !> The code currently calls SLASDQ if singular values only are desired. !> However, it can be slightly modified to compute singular values !> using the divide and conquer method. - - pure subroutine stdlib_sbdsdc( uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq,work, iwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69134,7 +69134,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sbdsdc - !> SBDSQR: computes the singular values and, optionally, the right and/or + + pure subroutine stdlib_sbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, work, & + !> SBDSQR 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 @@ -69158,8 +69160,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_sbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, work, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69600,7 +69600,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sbdsqr - !> SGEES: computes for an N-by-N real nonsymmetric matrix A, the + + subroutine stdlib_sgees( jobvs, sort, select, n, a, lda, sdim, wr, wi,vs, ldvs, work, lwork, & + !> SGEES computes for an N-by-N real nonsymmetric matrix A, the !> eigenvalues, the real Schur form T, and, optionally, the matrix of !> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). !> Optionally, it also orders the eigenvalues on the diagonal of the @@ -69613,8 +69615,6 @@ module stdlib_linalg_lapack_s !> [ a b ] !> [ c a ] !> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). - - subroutine stdlib_sgees( jobvs, sort, select, n, a, lda, sdim, wr, wi,vs, ldvs, work, lwork, & bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69846,7 +69846,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgees - !> SGEESX: computes for an N-by-N real nonsymmetric matrix A, the + + subroutine stdlib_sgeesx( jobvs, sort, select, sense, n, a, lda, sdim,wr, wi, vs, ldvs, & + !> SGEESX computes for an N-by-N real nonsymmetric matrix A, the !> eigenvalues, the real Schur form T, and, optionally, the matrix of !> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). !> Optionally, it also orders the eigenvalues on the diagonal of the @@ -69865,8 +69867,6 @@ module stdlib_linalg_lapack_s !> [ a b ] !> [ c a ] !> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). - - subroutine stdlib_sgeesx( jobvs, sort, select, sense, n, a, lda, sdim,wr, wi, vs, ldvs, & rconde, rcondv, work, lwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70140,7 +70140,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeesx - !> SGEEV: computes for an N-by-N real nonsymmetric matrix A, the + + subroutine stdlib_sgeev( jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr,ldvr, work, lwork, & + !> SGEEV computes for an N-by-N real 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) @@ -70150,8 +70152,6 @@ module stdlib_linalg_lapack_s !> 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. - - subroutine stdlib_sgeev( jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr,ldvr, work, lwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70399,7 +70399,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeev - !> SGEEVX: computes for an N-by-N real nonsymmetric matrix A, the + + subroutine stdlib_sgeevx( balanc, jobvl, jobvr, sense, n, a, lda, wr, wi,vl, ldvl, vr, ldvr, & + !> SGEEVX computes for an N-by-N real nonsymmetric matrix A, the !> eigenvalues and, optionally, the left and/or right eigenvectors. !> Optionally also, it computes a balancing transformation to improve !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, @@ -70424,8 +70426,6 @@ module stdlib_linalg_lapack_s !> (in exact arithmetic) but diagonal scaling will. For further !> explanation of balancing, see section 4.10.2_sp of the LAPACK !> Users' Guide. - - subroutine stdlib_sgeevx( balanc, jobvl, jobvr, sense, n, a, lda, wr, wi,vl, ldvl, vr, ldvr, & ilo, ihi, scale, abnrm,rconde, rcondv, work, lwork, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70711,7 +70711,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeevx - !> SGEJSV: computes the singular value decomposition (SVD) of a real M-by-N + + pure subroutine stdlib_sgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & + !> SGEJSV computes the singular value decomposition (SVD) of a real M-by-N !> matrix [A], where M >= N. The SVD of [A] is written as !> [A] = [U] * [SIGMA] * [V]^t, !> where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N @@ -70723,8 +70725,6 @@ module stdlib_linalg_lapack_s !> of [SIGMA] is computed and stored in the array SVA. !> SGEJSV can sometimes compute tiny singular values and their singular vectors much !> more accurately than other SVD routines, see below under Further Details. - - pure subroutine stdlib_sgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & v, ldv,work, lwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71801,7 +71801,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgejsv - !> SGELSD: computes the minimum-norm solution to a real linear least + + subroutine stdlib_sgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond,rank, work, lwork, iwork, & + !> SGELSD 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 @@ -71826,8 +71828,6 @@ module stdlib_linalg_lapack_s !> 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. - - subroutine stdlib_sgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond,rank, work, lwork, iwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72127,7 +72127,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgelsd - !> SGELSS: computes the minimum norm solution to a real linear least + + subroutine stdlib_sgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, info ) + !> SGELSS 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 @@ -72139,8 +72141,6 @@ module stdlib_linalg_lapack_s !> The effective rank of A is determined by treating as zero those !> singular values which are less than RCOND times the largest singular !> value. - - subroutine stdlib_sgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72566,7 +72566,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgelss - !> SGESDD: computes the singular value decomposition (SVD) of a real + + subroutine stdlib_sgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, iwork, info ) + !> SGESDD computes the singular value decomposition (SVD) of a real !> M-by-N matrix A, optionally computing the left and right singular !> vectors. If singular vectors are desired, it uses a !> divide-and-conquer algorithm. @@ -72585,8 +72587,6 @@ module stdlib_linalg_lapack_s !> 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. - - subroutine stdlib_sgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73537,7 +73537,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgesdd - !> SGESVD: computes the singular value decomposition (SVD) of a real + + subroutine stdlib_sgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, info ) + !> SGESVD computes the singular value decomposition (SVD) of a real !> M-by-N matrix A, optionally computing the left and/or right singular !> vectors. The SVD is written !> A = U * SIGMA * transpose(V) @@ -73548,8 +73550,6 @@ module stdlib_linalg_lapack_s !> 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**T, not V. - - subroutine stdlib_sgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75797,7 +75797,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgesvd - !> SGESVDQ: computes the singular value decomposition (SVD) of a real + + subroutine stdlib_sgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & + !> SGESVDQ computes the singular value decomposition (SVD) of a real !> 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] @@ -75806,8 +75808,6 @@ module stdlib_linalg_lapack_s !> matrix, and V is an N-by-N orthogonal 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. - - subroutine stdlib_sgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & numrank, iwork, liwork,work, lwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -76663,7 +76663,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgesvdq - !> SGESVJ: computes the singular value decomposition (SVD) of a real + + pure subroutine stdlib_sgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, work, lwork, & + !> SGESVJ computes the singular value decomposition (SVD) of a real !> M-by-N matrix A, where M >= N. The SVD of A is written as !> [++] [xx] [x0] [xx] !> A = U * SIGMA * V^t, [++] = [xx] * [ox] * [xx] @@ -76674,8 +76676,6 @@ module stdlib_linalg_lapack_s !> left and the right singular vectors of A, respectively. !> SGESVJ can sometimes compute tiny singular values and their singular vectors much !> more accurately than other SVD routines, see below under Further Details. - - pure subroutine stdlib_sgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77642,7 +77642,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgesvj - !> SGGES3: computes for a pair of N-by-N real nonsymmetric matrices (A,B), + + subroutine stdlib_sgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alphar, & + !> SGGES3 computes for a pair of N-by-N real nonsymmetric matrices (A,B), !> the generalized eigenvalues, the generalized real Schur form (S,T), !> optionally, the left and/or right matrices of Schur vectors (VSL and !> VSR). This gives the generalized Schur factorization @@ -77668,8 +77670,6 @@ module stdlib_linalg_lapack_s !> [ 0 b ] !> and the pair of corresponding 2-by-2 blocks in S and T will have a !> complex conjugate pair of generalized eigenvalues. - - subroutine stdlib_sgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alphar, & alphai, beta, vsl, ldvsl,vsr, ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77956,7 +77956,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgges3 - !> SGGEV3: computes for a pair of N-by-N real nonsymmetric matrices (A,B) + + subroutine stdlib_sggev3( jobvl, jobvr, n, a, lda, b, ldb, alphar,alphai, beta, vl, ldvl, vr,& + !> SGGEV3 computes for a pair of N-by-N real 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 @@ -77971,8 +77973,6 @@ module stdlib_linalg_lapack_s !> 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). - - subroutine stdlib_sggev3( jobvl, jobvr, n, a, lda, b, ldb, alphar,alphai, beta, vl, ldvl, vr,& ldvr, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78251,12 +78251,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggev3 - !> SGSVJ0: is called from SGESVJ as a pre-processor and that is its main + + pure subroutine stdlib_sgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & + !> SGSVJ0 is called from SGESVJ as a pre-processor and that is its main !> purpose. It applies Jacobi rotations in the same way as SGESVJ does, but !> it does not check convergence (stopping criterion). Few tuning !> parameters (marked by [TP]) are available for the implementer. - - pure subroutine stdlib_sgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78899,7 +78899,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgsvj0 - !> SGSVJ1: is called from SGESVJ as a pre-processor and that is its main + + pure subroutine stdlib_sgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & + !> SGSVJ1 is called from SGESVJ as a pre-processor and that is its main !> purpose. It applies Jacobi rotations in the same way as SGESVJ does, but !> it targets only particular pivots and it does not check convergence !> (stopping criterion). Few tuning parameters (marked by [TP]) are @@ -78923,8 +78925,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_sgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79330,7 +79330,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgsvj1 - !> SHSEQR: computes the eigenvalues of a Hessenberg matrix H + + subroutine stdlib_shseqr( job, compz, n, ilo, ihi, h, ldh, wr, wi, z,ldz, work, lwork, info ) + !> SHSEQR computes the eigenvalues of a Hessenberg matrix H !> and, optionally, the matrices T and Z from the Schur decomposition !> H = Z T Z**T, where T is an upper quasi-triangular matrix (the !> Schur form), and Z is the orthogonal matrix of Schur vectors. @@ -79338,8 +79340,6 @@ module stdlib_linalg_lapack_s !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. - - subroutine stdlib_shseqr( job, compz, n, ilo, ihi, h, ldh, wr, wi, z,ldz, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79477,7 +79477,9 @@ module stdlib_linalg_lapack_s end if end subroutine stdlib_shseqr - !> SLALSA: is an itermediate step in solving the least squares problem + + pure subroutine stdlib_slalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, difl,& + !> SLALSA 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.). @@ -79486,8 +79488,6 @@ module stdlib_linalg_lapack_s !> ICOMPQ = 1, SLALSA applies the right singular vector matrix to the !> right hand side. The singular vector matrices were generated in !> compact form by SLALSA. - - pure subroutine stdlib_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 ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79661,7 +79661,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slalsa - !> SLALSD: uses the singular value decomposition of A to solve the least + + pure subroutine stdlib_slalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, iwork, & + !> SLALSD 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. @@ -79675,8 +79677,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_slalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, iwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79934,7 +79934,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slalsd - !> SLAQR0: computes the eigenvalues of a Hessenberg matrix H + + subroutine stdlib_slaqr0( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& + !> SLAQR0 computes the eigenvalues of a Hessenberg matrix H !> and, optionally, the matrices T and Z from the Schur decomposition !> H = Z T Z**T, where T is an upper quasi-triangular matrix (the !> Schur form), and Z is the orthogonal matrix of Schur vectors. @@ -79942,8 +79944,6 @@ module stdlib_linalg_lapack_s !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. - - subroutine stdlib_slaqr0( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80304,8 +80304,10 @@ module stdlib_linalg_lapack_s work( 1 ) = real( lwkopt,KIND=sp) end subroutine stdlib_slaqr0 + + subroutine stdlib_slaqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& !> Aggressive early deflation: - !> SLAQR3: accepts as input an upper Hessenberg matrix + !> SLAQR3 accepts as input an upper Hessenberg matrix !> H and performs an orthogonal similarity transformation !> designed to detect and deflate fully converged eigenvalues from !> a trailing principal submatrix. On output H has been over- @@ -80313,8 +80315,6 @@ module stdlib_linalg_lapack_s !> an orthogonal similarity transformation of H. It is to be !> hoped that the final version of H has many zero subdiagonal !> entries. - - subroutine stdlib_slaqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& sr, si, v, ldv, nh, t,ldt, nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80615,7 +80615,9 @@ module stdlib_linalg_lapack_s work( 1 ) = real( lwkopt,KIND=sp) end subroutine stdlib_slaqr3 - !> SLAQR4: implements one level of recursion for SLAQR0. + + subroutine stdlib_slaqr4( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& + !> SLAQR4 implements one level of recursion for SLAQR0. !> It is a complete implementation of the small bulge multi-shift !> QR algorithm. It may be called by SLAQR0 and, for large enough !> deflation window size, it may be called by SLAQR3. This @@ -80629,8 +80631,6 @@ module stdlib_linalg_lapack_s !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. - - subroutine stdlib_slaqr4( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80986,7 +80986,9 @@ module stdlib_linalg_lapack_s work( 1 ) = real( lwkopt,KIND=sp) end subroutine stdlib_slaqr4 - !> SLAQZ0: computes the eigenvalues of a real matrix pair (H,T), + + recursive subroutine stdlib_slaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alphar, & + !> SLAQZ0 computes the eigenvalues of a real 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 @@ -81034,8 +81036,6 @@ module stdlib_linalg_lapack_s !> 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" - - recursive subroutine stdlib_slaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alphar, & alphai, beta,q, ldq, z, ldz, work, lwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -81378,9 +81378,9 @@ module stdlib_linalg_lapack_s info = norm_info end subroutine stdlib_slaqz0 - !> SLAQZ3: performs AED recursive subroutine stdlib_slaqz3( ilschur, ilq, ilz, n, ilo, ihi, nw,a, lda, b, ldb, q, & + !> SLAQZ3 performs AED ldq, z, ldz, ns,nd, alphar, alphai, beta, qc, ldqc,zc, ldzc, work, lwork, rec, info ) ! arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -81650,6 +81650,8 @@ module stdlib_linalg_lapack_s end if end subroutine stdlib_slaqz3 + + pure subroutine stdlib_slarre( range, n, vl, vu, il, iu, d, e, e2,rtol1, rtol2, spltol, & !> To find the desired eigenvalues of a given real symmetric !> tridiagonal matrix T, SLARRE: sets any "small" off-diagonal !> elements to zero, and for each unreduced block T_i, it finds @@ -81663,8 +81665,6 @@ module stdlib_linalg_lapack_s !> conpute all and then discard any unwanted one. !> As an added benefit, SLARRE also outputs the n !> Gerschgorin intervals for the matrices L_i D_i L_i^T. - - pure subroutine stdlib_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 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82179,6 +82179,8 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarre + + pure subroutine stdlib_slasd0( n, sqre, d, e, u, ldu, vt, ldvt, smlsiz, iwork,work, info ) !> Using a divide and conquer approach, SLASD0: 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. @@ -82186,8 +82188,6 @@ module stdlib_linalg_lapack_s !> B = U * S * VT. The singular values S are overwritten on D. !> A related subroutine, SLASDA, computes only the singular values, !> and optionally, the singular vectors in compact form. - - pure subroutine stdlib_slasd0( n, sqre, d, e, u, ldu, vt, ldvt, smlsiz, iwork,work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82318,6 +82318,8 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd0 + + pure subroutine stdlib_slasda( icompq, smlsiz, n, sqre, d, e, u, ldu, vt, k,difl, difr, z, & !> Using a divide and conquer approach, SLASDA: 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 @@ -82326,8 +82328,6 @@ module stdlib_linalg_lapack_s !> compact form. !> A related subroutine, SLASD0, computes the singular values and !> the singular vectors in explicit form. - - pure subroutine stdlib_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 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82520,7 +82520,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasda - !> SLASDQ: computes the singular value decomposition (SVD) of a real + + pure subroutine stdlib_slasdq( uplo, sqre, n, ncvt, nru, ncc, d, e, vt, ldvt,u, ldu, c, ldc, & + !> SLASDQ 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 @@ -82532,8 +82534,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_slasdq( uplo, sqre, n, ncvt, nru, ncc, d, e, vt, ldvt,u, ldu, c, ldc, & work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82685,7 +82685,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasdq - !> SLASQ1: computes the singular values of a real N-by-N bidiagonal + + pure subroutine stdlib_slasq1( n, d, e, work, info ) + !> SLASQ1 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 @@ -82695,8 +82697,6 @@ module stdlib_linalg_lapack_s !> 1994, !> and the present implementation is described in "An implementation of !> the dqds Algorithm (Positive Case)", LAPACK Working Note. - - pure subroutine stdlib_slasq1( n, d, e, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -82777,7 +82777,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasq1 - !> SLASQ2: computes all the eigenvalues of the symmetric positive + + pure subroutine stdlib_slasq2( n, z, info ) + !> SLASQ2 computes all the eigenvalues of the symmetric positive !> definite tridiagonal matrix associated with the qd array Z to high !> relative accuracy are computed to high relative accuracy, in the !> absence of denormalization, underflow and overflow. @@ -82790,8 +82792,6 @@ module stdlib_linalg_lapack_s !> on machines which follow ieee-754 floating-point standard in their !> handling of infinities and NaNs, and false otherwise. This variable !> is passed to SLASQ3. - - pure subroutine stdlib_slasq2( n, z, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83170,6 +83170,8 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasq2 + + pure subroutine stdlib_slasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) !> DLATRF_AA factorizes a panel of a real 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. @@ -83180,8 +83182,6 @@ module stdlib_linalg_lapack_s !> 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. - - pure subroutine stdlib_slasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83404,7 +83404,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasyf_aa - !> SPTEQR: computes all eigenvalues and, optionally, eigenvectors of a + + pure subroutine stdlib_spteqr( compz, n, d, e, z, ldz, work, info ) + !> SPTEQR computes all eigenvalues and, optionally, eigenvectors of a !> symmetric positive definite tridiagonal matrix by first factoring the !> matrix using SPTTRF, and then calling SBDSQR to compute the singular !> values of the bidiagonal factor. @@ -83419,8 +83421,6 @@ module stdlib_linalg_lapack_s !> form, however, may preclude the possibility of obtaining high !> relative accuracy in the small eigenvalues of the original matrix, if !> these eigenvalues range over many orders of magnitude.) - - pure subroutine stdlib_spteqr( compz, n, d, e, z, ldz, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83498,7 +83498,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spteqr - !> SSTEGR: computes selected eigenvalues and, optionally, eigenvectors + + pure subroutine stdlib_sstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> SSTEGR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has !> a well defined set of pairwise different real eigenvalues, the corresponding !> real eigenvectors are pairwise orthogonal. @@ -83514,8 +83516,6 @@ module stdlib_linalg_lapack_s !> NaNs. Normal execution may create these exceptiona values and hence !> may abort due to a floating point exception in environments which !> do not conform to the IEEE-754 standard. - - pure subroutine stdlib_sstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83540,7 +83540,9 @@ module stdlib_linalg_lapack_s tryrac, work, lwork,iwork, liwork, info ) end subroutine stdlib_sstegr - !> SSTEMR: computes selected eigenvalues and, optionally, eigenvectors + + pure subroutine stdlib_sstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & + !> SSTEMR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has !> a well defined set of pairwise different real eigenvalues, the corresponding !> real eigenvectors are pairwise orthogonal. @@ -83585,8 +83587,6 @@ module stdlib_linalg_lapack_s !> floating-point standard in their handling of infinities and NaNs. !> This permits the use of efficient inner loops avoiding a check for !> zero divisors. - - pure subroutine stdlib_sstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83960,7 +83960,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sstemr - !> SSTEVR: computes selected eigenvalues and, optionally, eigenvectors + + pure subroutine stdlib_sstevr( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & + !> SSTEVR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Eigenvalues and !> eigenvectors can be selected by specifying either a range of values !> or a range of indices for the desired eigenvalues. @@ -83995,8 +83997,6 @@ module stdlib_linalg_lapack_s !> hence may abort due to a floating point exception in environments !> which do not handle NaNs and infinities in the ieee standard default !> manner. - - pure subroutine stdlib_sstevr( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & isuppz, work, lwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84207,7 +84207,9 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sstevr - !> SSYEVR: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_ssyevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> SSYEVR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric matrix A. Eigenvalues and eigenvectors can be !> selected by specifying either a range of values or a range of !> indices for the desired eigenvalues. @@ -84257,8 +84259,6 @@ module stdlib_linalg_lapack_s !> hence may abort due to a floating point exception in environments !> which do not handle NaNs and infinities in the ieee standard default !> manner. - - subroutine stdlib_ssyevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & isuppz, work, lwork,iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84536,6 +84536,8 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyevr + + pure subroutine stdlib_ssysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) !> SSYSV computes the solution to a real system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS @@ -84546,8 +84548,6 @@ module stdlib_linalg_lapack_s !> where U (or L) is a product of permutation and unit upper (lower) !> triangular matrices, and T is symmetric tridiagonal. The factored !> form of A is then used to solve the system of equations A * X = B. - - pure subroutine stdlib_ssysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84608,14 +84608,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssysv_aa - !> SSYTRF_AA: computes the factorization of a real symmetric matrix A + + pure subroutine stdlib_ssytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) + !> SSYTRF_AA computes the factorization of a real symmetric matrix A !> using the Aasen's algorithm. The form of the factorization is !> A = U**T*T*U or A = L*T*L**T !> where U (or L) is a product of permutation and unit upper (lower) !> triangular matrices, and T is a symmetric tridiagonal matrix. !> This is the blocked version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_ssytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_lapack_w.fypp b/src/stdlib_linalg_lapack_w.fypp index a685fd87f..f5e1337a9 100644 --- a/src/stdlib_linalg_lapack_w.fypp +++ b/src/stdlib_linalg_lapack_w.fypp @@ -506,13 +506,13 @@ module stdlib_linalg_lapack_w contains + + pure subroutine stdlib_wlag2w( m, n, sa, ldsa, a, lda, info ) !> ZLAG2W: converts a COMPLEX matrix, SA, to a COMPLEX*16 matrix, A. !> Note that while it is possible to overflow while converting !> from double to single, it is not possible to overflow when !> converting from single to double. !> This is an auxiliary routine so there is no argument checking. - - pure subroutine stdlib_wlag2w( m, n, sa, ldsa, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -535,6 +535,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlag2w + + pure subroutine stdlib_wbbcsd( jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q,theta, phi, u1, & !> ZBBCSD: computes the CS decomposition of a unitary matrix in !> bidiagonal-block form, !> [ B11 | B12 0 0 ] @@ -556,8 +558,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wbbcsd( 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 ) ! -- lapack computational routine -- @@ -1148,6 +1148,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wbbcsd + + pure subroutine stdlib_wbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, rwork,& !> ZBDSQR: 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 @@ -1172,8 +1174,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, rwork,& info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1611,6 +1611,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wbdsqr + + subroutine stdlib_wcgesv( n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work,swork, rwork, iter, & !> ZCGESV: 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. @@ -1638,8 +1640,6 @@ module stdlib_linalg_lapack_w !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 !> respectively. - - subroutine stdlib_wcgesv( n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work,swork, rwork, iter, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1797,6 +1797,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wcgesv + + subroutine stdlib_wcposv( uplo, n, nrhs, a, lda, b, ldb, x, ldx, work,swork, rwork, iter, & !> ZCPOSV: computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite matrix and X and B @@ -1825,8 +1827,6 @@ module stdlib_linalg_lapack_w !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 !> respectively. - - subroutine stdlib_wcposv( uplo, n, nrhs, a, lda, b, ldb, x, ldx, work,swork, rwork, iter, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1984,11 +1984,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wcposv + + pure subroutine stdlib_wdrscl( n, sa, sx, incx ) !> ZDRSCL: multiplies an n-element complex vector x by the real scalar !> 1/a. This is done without overflow or underflow as long as !> the final result x/a does not overflow or underflow. - - pure subroutine stdlib_wdrscl( n, sa, sx, incx ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2038,12 +2038,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wdrscl + + pure subroutine stdlib_wgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & !> ZGBBRD: 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. - - pure subroutine stdlib_wgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & ldc, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2315,14 +2315,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbbrd + + pure subroutine stdlib_wgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, rwork, & !> ZGBCON: 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 ZGBTRF. !> 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)) ). - - pure subroutine stdlib_wgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, rwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2449,6 +2449,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbcon + + pure subroutine stdlib_wgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) !> ZGBEQU: 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 @@ -2458,8 +2460,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2584,6 +2584,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbequ + + pure subroutine stdlib_wgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) !> ZGBEQUB: 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 @@ -2599,8 +2601,6 @@ module stdlib_linalg_lapack_w !> 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). - - pure subroutine stdlib_wgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2734,11 +2734,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbequb + + pure subroutine stdlib_wgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, x, & !> ZGBRFS: 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. - - pure subroutine stdlib_wgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, x, & ldx, ferr, berr, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2940,6 +2940,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbrfs + + pure subroutine stdlib_wgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) !> ZGBSV: 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. @@ -2948,8 +2950,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2992,14 +2992,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbsv + + subroutine stdlib_wgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & !> ZGBSVX: uses the LU factorization to compute the solution to a complex !> system of linear equations A * X = B, A**T * X = B, or A**H * 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. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_wgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & c, b, ldb, x, ldx,rcond, ferr, berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -3219,11 +3219,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbsvx + + pure subroutine stdlib_wgbtf2( m, n, kl, ku, ab, ldab, ipiv, info ) !> ZGBTF2: computes an LU factorization of a complex m-by-n band matrix !> A using partial pivoting with row interchanges. !> This is the unblocked version of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_wgbtf2( m, n, kl, ku, ab, ldab, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3305,11 +3305,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbtf2 + + pure subroutine stdlib_wgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) !> ZGBTRF: 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. - - pure subroutine stdlib_wgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3555,12 +3555,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbtrf + + pure subroutine stdlib_wgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) !> ZGBTRS: 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 ZGBTRF. - - pure subroutine stdlib_wgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3668,11 +3668,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbtrs + + pure subroutine stdlib_wgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) !> ZGEBAK: forms the right or left eigenvectors of a complex general !> matrix by backward transformation on the computed eigenvectors of the !> balanced matrix output by ZGEBAL. - - pure subroutine stdlib_wgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3765,6 +3765,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgebak + + pure subroutine stdlib_wgebal( job, n, a, lda, ilo, ihi, scale, info ) !> ZGEBAL: 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 @@ -3773,8 +3775,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wgebal( job, n, a, lda, ilo, ihi, scale, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3935,11 +3935,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgebal + + pure subroutine stdlib_wgebd2( m, n, a, lda, d, e, tauq, taup, work, info ) !> ZGEBD2: reduces a complex general m by n matrix A to upper or lower !> real 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. - - pure subroutine stdlib_wgebd2( m, n, a, lda, d, e, tauq, taup, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4033,11 +4033,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgebd2 + + pure subroutine stdlib_wgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) !> ZGEBRD: 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. - - pure subroutine stdlib_wgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4140,14 +4140,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgebrd + + pure subroutine stdlib_wgecon( norm, n, a, lda, anorm, rcond, work, rwork,info ) !> ZGECON: 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 ZGETRF. !> 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)) ). - - pure subroutine stdlib_wgecon( norm, n, a, lda, anorm, rcond, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4246,6 +4246,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgecon + + pure subroutine stdlib_wgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) !> ZGEEQU: 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 @@ -4255,8 +4257,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4374,6 +4374,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeequ + + pure subroutine stdlib_wgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) !> ZGEEQUB: 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 @@ -4389,8 +4391,6 @@ module stdlib_linalg_lapack_w !> 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). - - pure subroutine stdlib_wgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4518,6 +4518,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeequb + + subroutine stdlib_wgees( jobvs, sort, select, n, a, lda, sdim, w, vs,ldvs, work, lwork, & !> ZGEES: 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). @@ -4526,8 +4528,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_wgees( jobvs, sort, select, n, a, lda, sdim, w, vs,ldvs, work, lwork, & rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4689,6 +4689,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgees + + subroutine stdlib_wgeesx( jobvs, sort, select, sense, n, a, lda, sdim, w,vs, ldvs, rconde, & !> ZGEESX: 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). @@ -4703,8 +4705,6 @@ module stdlib_linalg_lapack_w !> and RCONDV, see Section 4.10_qp of the LAPACK Users' Guide (where !> these quantities are called s and sep respectively). !> A complex matrix is in Schur form if it is upper triangular. - - subroutine stdlib_wgeesx( jobvs, sort, select, sense, n, a, lda, sdim, w,vs, ldvs, rconde, & rcondv, work, lwork, rwork,bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4891,6 +4891,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeesx + + subroutine stdlib_wgeev( jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr,work, lwork, rwork, & !> ZGEEV: 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 @@ -4901,8 +4903,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_wgeev( jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr,work, lwork, rwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5140,6 +5140,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeev + + subroutine stdlib_wgeevx( balanc, jobvl, jobvr, sense, n, a, lda, w, vl,ldvl, vr, ldvr, ilo, & !> ZGEEVX: computes for an N-by-N complex nonsymmetric matrix A, the !> eigenvalues and, optionally, the left and/or right eigenvectors. !> Optionally also, it computes a balancing transformation to improve @@ -5165,8 +5167,6 @@ module stdlib_linalg_lapack_w !> (in exact arithmetic) but diagonal scaling will. For further !> explanation of balancing, see section 4.10.2_qp of the LAPACK !> Users' Guide. - - subroutine stdlib_wgeevx( balanc, jobvl, jobvr, sense, n, a, lda, w, vl,ldvl, vr, ldvr, ilo, & ihi, scale, abnrm, rconde,rcondv, work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5442,10 +5442,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeevx - !> ZGEHD2: reduces a complex general matrix A to upper Hessenberg form H - !> by a unitary similarity transformation: Q**H * A * Q = H . pure subroutine stdlib_wgehd2( n, ilo, ihi, a, lda, tau, work, info ) + !> ZGEHD2: reduces a complex general matrix A to upper Hessenberg form H + !> by a unitary similarity transformation: Q**H * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5494,10 +5494,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgehd2 - !> ZGEHRD: reduces a complex general matrix A to upper Hessenberg form H by - !> an unitary similarity transformation: Q**H * A * Q = H . pure subroutine stdlib_wgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info ) + !> ZGEHRD: reduces a complex general matrix A to upper Hessenberg form H by + !> an unitary similarity transformation: Q**H * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5624,6 +5624,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgehrd + + pure subroutine stdlib_wgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & !> ZGEJSV: 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]^*, @@ -5634,8 +5636,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & v, ldv,cwork, lwork, rwork, lrwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7029,14 +7029,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgejsv + + pure subroutine stdlib_wgelq( m, n, a, lda, t, tsize, work, lwork,info ) !> ZGELQ: 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. - - pure subroutine stdlib_wgelq( m, n, a, lda, t, tsize, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -7154,14 +7154,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgelq + + pure subroutine stdlib_wgelq2( m, n, a, lda, tau, work, info ) !> ZGELQ2: 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. - - pure subroutine stdlib_wgelq2( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7210,14 +7210,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgelq2 + + pure subroutine stdlib_wgelqf( m, n, a, lda, tau, work, lwork, info ) !> ZGELQF: 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. - - pure subroutine stdlib_wgelqf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7307,10 +7307,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgelqf - !> ZGELQT: computes a blocked LQ factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. pure subroutine stdlib_wgelqt( m, n, mb, a, lda, t, ldt, work, info ) + !> ZGELQT: computes a blocked LQ factorization of a complex M-by-N matrix A + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7358,12 +7358,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgelqt + + pure recursive subroutine stdlib_wgelqt3( m, n, a, lda, t, ldt, info ) !> ZGELQT3: 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. - - pure recursive subroutine stdlib_wgelqt3( m, n, a, lda, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7448,6 +7448,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgelqt3 + + subroutine stdlib_wgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) !> ZGELS: 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. @@ -7466,8 +7468,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_wgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7666,6 +7666,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgels + + subroutine stdlib_wgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & !> ZGELSD: computes the minimum-norm solution to a real linear least !> squares problem: !> minimize 2-norm(| b - A*x |) @@ -7691,8 +7693,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_wgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8004,6 +8004,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgelsd + + subroutine stdlib_wgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & !> ZGELSS: computes the minimum norm solution to a complex linear !> least squares problem: !> Minimize 2-norm(| b - A*x |). @@ -8016,8 +8018,6 @@ module stdlib_linalg_lapack_w !> The effective rank of A is determined by treating as zero those !> singular values which are less than RCOND times the largest singular !> value. - - subroutine stdlib_wgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8462,6 +8462,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgelss + + subroutine stdlib_wgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, rwork, & !> ZGELSY: computes the minimum-norm solution to a complex linear least !> squares problem: !> minimize || A * X - B || @@ -8494,8 +8496,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_wgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, rwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8687,6 +8687,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgelsy + + pure subroutine stdlib_wgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & !> ZGEMLQ: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -8694,8 +8696,6 @@ module stdlib_linalg_lapack_w !> where Q is a complex unitary matrix defined as the product !> of blocked elementary reflectors computed by short wide !> LQ factorization (ZGELQ) - - pure subroutine stdlib_wgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8784,6 +8784,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgemlq + + pure subroutine stdlib_wgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) !> ZGEMLQT: overwrites the general complex M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q C C Q @@ -8793,8 +8795,6 @@ module stdlib_linalg_lapack_w !> Q = H(1) H(2) . . . H(K) = I - V T V**H !> generated using the compact WY representation as returned by ZGELQT. !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. - - pure subroutine stdlib_wgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8882,6 +8882,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgemlqt + + pure subroutine stdlib_wgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & !> ZGEMQR: overwrites the general real M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -8889,8 +8891,6 @@ module stdlib_linalg_lapack_w !> where Q is a complex unitary matrix defined as the product !> of blocked elementary reflectors computed by tall skinny !> QR factorization (ZGEQR) - - pure subroutine stdlib_wgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8979,6 +8979,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgemqr + + pure subroutine stdlib_wgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) !> ZGEMQRT: overwrites the general complex M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q C C Q @@ -8988,8 +8990,6 @@ module stdlib_linalg_lapack_w !> Q = H(1) H(2) . . . H(K) = I - V T V**H !> generated using the compact WY representation as returned by ZGEQRT. !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. - - pure subroutine stdlib_wgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -9077,10 +9077,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgemqrt - !> ZGEQL2: computes a QL factorization of a complex m by n matrix A: - !> A = Q * L. pure subroutine stdlib_wgeql2( m, n, a, lda, tau, work, info ) + !> ZGEQL2: computes a QL factorization of a complex m by n matrix A: + !> A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9126,10 +9126,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeql2 - !> ZGEQLF: computes a QL factorization of a complex M-by-N matrix A: - !> A = Q * L. pure subroutine stdlib_wgeqlf( m, n, a, lda, tau, work, lwork, info ) + !> ZGEQLF: computes a QL factorization of a complex M-by-N matrix A: + !> A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9232,10 +9232,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeqlf - !> ZGEQP3: computes a QR factorization with column pivoting of a - !> matrix A: A*P = Q*R using Level 3 BLAS. pure subroutine stdlib_wgeqp3( m, n, a, lda, jpvt, tau, work, lwork, rwork,info ) + !> ZGEQP3: computes a QR factorization with column pivoting of a + !> matrix A: A*P = Q*R using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9384,6 +9384,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeqp3 + + pure subroutine stdlib_wgeqr( m, n, a, lda, t, tsize, work, lwork,info ) !> ZGEQR: computes a QR factorization of a complex M-by-N matrix A: !> A = Q * ( R ), !> ( 0 ) @@ -9391,8 +9393,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wgeqr( m, n, a, lda, t, tsize, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -9499,6 +9499,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeqr + + pure subroutine stdlib_wgeqr2( m, n, a, lda, tau, work, info ) !> ZGEQR2: computes a QR factorization of a complex m-by-n matrix A: !> A = Q * ( R ), !> ( 0 ) @@ -9506,8 +9508,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wgeqr2( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9554,6 +9554,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeqr2 + + subroutine stdlib_wgeqr2p( m, n, a, lda, tau, work, info ) !> ZGEQR2P: computes a QR factorization of a complex m-by-n matrix A: !> A = Q * ( R ), !> ( 0 ) @@ -9562,8 +9564,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_wgeqr2p( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9610,6 +9610,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeqr2p + + pure subroutine stdlib_wgeqrf( m, n, a, lda, tau, work, lwork, info ) !> ZGEQRF: computes a QR factorization of a complex M-by-N matrix A: !> A = Q * ( R ), !> ( 0 ) @@ -9617,8 +9619,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wgeqrf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9712,6 +9712,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeqrf + + subroutine stdlib_wgeqrfp( m, n, a, lda, tau, work, lwork, info ) !> ZGEQR2P computes a QR factorization of a complex M-by-N matrix A: !> A = Q * ( R ), !> ( 0 ) @@ -9720,8 +9722,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_wgeqrfp( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9811,10 +9811,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeqrfp - !> ZGEQRT: computes a blocked QR factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. pure subroutine stdlib_wgeqrt( m, n, nb, a, lda, t, ldt, work, info ) + !> ZGEQRT: computes a blocked QR factorization of a complex M-by-N matrix A + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9868,10 +9868,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeqrt - !> ZGEQRT2: computes a QR factorization of a complex M-by-N matrix A, - !> using the compact WY representation of Q. pure subroutine stdlib_wgeqrt2( m, n, a, lda, t, ldt, info ) + !> ZGEQRT2: computes a QR factorization of a complex M-by-N matrix A, + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9936,12 +9936,12 @@ module stdlib_linalg_lapack_w end do end subroutine stdlib_wgeqrt2 + + pure recursive subroutine stdlib_wgeqrt3( m, n, a, lda, t, ldt, info ) !> ZGEQRT3: 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. - - pure recursive subroutine stdlib_wgeqrt3( m, n, a, lda, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10024,11 +10024,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeqrt3 + + pure subroutine stdlib_wgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & !> ZGERFS: improves the computed solution to a system of linear !> equations and provides error bounds and backward error estimates for !> the solution. - - pure subroutine stdlib_wgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10221,10 +10221,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgerfs - !> ZGERQ2: computes an RQ factorization of a complex m by n matrix A: - !> A = R * Q. pure subroutine stdlib_wgerq2( m, n, a, lda, tau, work, info ) + !> ZGERQ2: computes an RQ factorization of a complex m by n matrix A: + !> A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10272,10 +10272,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgerq2 - !> ZGERQF: computes an RQ factorization of a complex M-by-N matrix A: - !> A = R * Q. pure subroutine stdlib_wgerqf( m, n, a, lda, tau, work, lwork, info ) + !> ZGERQF: computes an RQ factorization of a complex M-by-N matrix A: + !> A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10378,12 +10378,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgerqf + + pure subroutine stdlib_wgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) !> ZGESC2: solves a system of linear equations !> A * X = scale* RHS !> with a general N-by-N matrix A using the LU factorization with !> complete pivoting computed by ZGETC2. - - pure subroutine stdlib_wgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10437,6 +10437,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgesc2 + + subroutine stdlib_wgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, iwork, & !> ZGESDD: 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 @@ -10454,8 +10456,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_wgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, iwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -11932,6 +11932,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgesdd + + pure subroutine stdlib_wgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) !> ZGESV: 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. @@ -11941,8 +11943,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11980,6 +11980,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgesv + + subroutine stdlib_wgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,vt, ldvt, work, lwork, rwork, & !> ZGESVD: 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 @@ -11991,8 +11993,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_wgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,vt, ldvt, work, lwork, rwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -14426,6 +14426,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgesvd + + subroutine stdlib_wgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & !> ZCGESVDQ 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] @@ -14435,8 +14437,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_wgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & numrank, iwork, liwork,cwork, lcwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -15304,6 +15304,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgesvdq + + pure subroutine stdlib_wgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, cwork, lwork, & !> ZGESVJ: 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] @@ -15313,8 +15315,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, cwork, lwork, & rwork, lrwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16156,14 +16156,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgesvj + + subroutine stdlib_wgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & !> ZGESVX: uses the LU factorization to compute 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. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_wgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & x, ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16361,13 +16361,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgesvx + + pure subroutine stdlib_wgetc2( n, a, lda, ipiv, jpiv, info ) !> ZGETC2: computes an LU factorization, using complete pivoting, of the !> n-by-n matrix A. The factorization has the form A = P * L * U * Q, !> where P and Q are permutation matrices, L is lower triangular with !> unit diagonal elements and U is upper triangular. !> This is a level 1 BLAS version of the algorithm. - - pure subroutine stdlib_wgetc2( n, a, lda, ipiv, jpiv, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16445,6 +16445,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgetc2 + + pure subroutine stdlib_wgetf2( m, n, a, lda, ipiv, info ) !> ZGETF2: computes an LU factorization of a general m-by-n matrix A !> using partial pivoting with row interchanges. !> The factorization has the form @@ -16453,8 +16455,6 @@ module stdlib_linalg_lapack_w !> diagonal elements (lower trapezoidal if m > n), and U is upper !> triangular (upper trapezoidal if m < n). !> This is the right-looking Level 2 BLAS version of the algorithm. - - pure subroutine stdlib_wgetf2( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16518,6 +16518,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgetf2 + + pure subroutine stdlib_wgetrf( m, n, a, lda, ipiv, info ) !> ZGETRF: computes an LU factorization of a general M-by-N matrix A !> using partial pivoting with row interchanges. !> The factorization has the form @@ -16526,8 +16528,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wgetrf( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16596,6 +16596,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgetrf + + pure recursive subroutine stdlib_wgetrf2( m, n, a, lda, ipiv, info ) !> ZGETRF2: computes an LU factorization of a general M-by-N matrix A !> using partial pivoting with row interchanges. !> The factorization has the form @@ -16615,8 +16617,6 @@ module stdlib_linalg_lapack_w !> do the swaps on [ --- ], solve A12, update A22, !> [ A22 ] !> then calls itself to factor A22 and do the swaps on A21. - - pure recursive subroutine stdlib_wgetrf2( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16712,12 +16712,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgetrf2 + + pure subroutine stdlib_wgetri( n, a, lda, ipiv, work, lwork, info ) !> ZGETRI: computes the inverse of a matrix using the LU factorization !> computed by ZGETRF. !> This method inverts U and then computes inv(A) by solving the system !> inv(A)*L = inv(U) for inv(A). - - pure subroutine stdlib_wgetri( n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16814,12 +16814,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgetri + + pure subroutine stdlib_wgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) !> ZGETRS: 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 ZGETRF. - - pure subroutine stdlib_wgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16883,6 +16883,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgetrs + + subroutine stdlib_wgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) !> ZGETSLS: 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. @@ -16901,8 +16903,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_wgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17120,6 +17120,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgetsls + + pure subroutine stdlib_wgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) !> ZGETSQRHRT: computes a NB2-sized column blocked QR-factorization !> of a complex M-by-N matrix A with M >= N, !> A = Q * R. @@ -17132,8 +17134,6 @@ module stdlib_linalg_lapack_w !> The output Q and R factors are stored in the same format as in ZGEQRT !> (Q is in blocked compact WY-representation). See the documentation !> of ZGEQRT for more details on the format. - - pure subroutine stdlib_wgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17253,12 +17253,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgetsqrhrt + + pure subroutine stdlib_wggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) !> ZGGBAK: 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 !> ZGGBAL. - - pure subroutine stdlib_wggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17366,6 +17366,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggbak + + pure subroutine stdlib_wggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) !> ZGGBAL: 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 @@ -17375,8 +17377,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17670,6 +17670,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggbal + + subroutine stdlib_wgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alpha, beta, & !> ZGGES: 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 @@ -17690,8 +17692,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_wgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alpha, beta, & vsl, ldvsl, vsr, ldvsr, work,lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17922,6 +17922,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgges + + subroutine stdlib_wgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alpha, beta, & !> ZGGES3: 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 @@ -17942,8 +17944,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_wgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alpha, beta, & vsl, ldvsl, vsr, ldvsr,work, lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -18173,6 +18173,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgges3 + + subroutine stdlib_wggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, alpha,& !> ZGGESX: computes for a pair of N-by-N complex nonsymmetric matrices !> (A,B), the generalized eigenvalues, the complex Schur form (S,T), !> and, optionally, the left and/or right matrices of Schur vectors (VSL @@ -18195,8 +18197,6 @@ module stdlib_linalg_lapack_w !> A pair of matrices (S,T) is in generalized complex Schur form if T is !> upper triangular with non-negative diagonal and S is upper !> triangular. - - subroutine stdlib_wggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, alpha,& beta, vsl, ldvsl, vsr,ldvsr, rconde, rcondv, work, lwork, rwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- @@ -18483,6 +18483,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggesx + + subroutine stdlib_wggev( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & !> ZGGEV: 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. @@ -18498,8 +18500,6 @@ module stdlib_linalg_lapack_w !> 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). - - subroutine stdlib_wggev( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -18753,6 +18753,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggev + + subroutine stdlib_wggev3( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & !> ZGGEV3: 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. @@ -18768,8 +18770,6 @@ module stdlib_linalg_lapack_w !> 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). - - subroutine stdlib_wggev3( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19025,6 +19025,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggev3 + + subroutine stdlib_wggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alpha, beta, vl, & !> ZGGEVX: 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. @@ -19045,8 +19047,6 @@ module stdlib_linalg_lapack_w !> 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). - - subroutine stdlib_wggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alpha, beta, vl, & ldvl, vr, ldvr, ilo, ihi,lscale, rscale, abnrm, bbnrm, rconde, rcondv,work, lwork, rwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -19373,6 +19373,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggevx + + pure subroutine stdlib_wggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) !> ZGGGLM: solves a general Gauss-Markov linear model (GLM) problem: !> minimize || y ||_2 subject to d = A*x + B*y !> x @@ -19391,8 +19393,6 @@ module stdlib_linalg_lapack_w !> minimize || inv(B)*(d-A*x) ||_2 !> x !> where inv(B) denotes the inverse of B. - - pure subroutine stdlib_wggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19509,6 +19509,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggglm + + pure subroutine stdlib_wgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & !> ZGGHD3: 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 @@ -19534,8 +19536,6 @@ module stdlib_linalg_lapack_w !> problem to generalized Hessenberg form. !> This is a blocked variant of CGGHRD, using matrix-matrix !> multiplications for parts of the computation to enhance performance. - - pure subroutine stdlib_wgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20039,6 +20039,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgghd3 + + pure subroutine stdlib_wgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & !> ZGGHRD: 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 @@ -20062,8 +20064,6 @@ module stdlib_linalg_lapack_w !> If Q1 is the unitary matrix from the QR factorization of B in the !> original equation A*x = lambda*B*x, then ZGGHRD reduces the original !> problem to generalized Hessenberg form. - - pure subroutine stdlib_wgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20171,6 +20171,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgghrd + + pure subroutine stdlib_wgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) !> ZGGLSE: solves the linear equality-constrained least squares (LSE) !> problem: !> minimize || c - A*x ||_2 subject to B*x = d @@ -20183,8 +20185,6 @@ module stdlib_linalg_lapack_w !> which is obtained using a generalized RQ factorization of the !> matrices (B, A) given by !> B = (0 R)*Q, A = Z*T*Q. - - pure subroutine stdlib_wgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20303,6 +20303,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgglse + + pure subroutine stdlib_wggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) !> ZGGQRF: 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, @@ -20321,8 +20323,6 @@ module stdlib_linalg_lapack_w !> inv(B)*A = Z**H * (inv(T)*R) !> where inv(B) denotes the inverse of the matrix B, and Z**H denotes the !> conjugate transpose of matrix Z. - - pure subroutine stdlib_wggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20381,6 +20381,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggqrf + + pure subroutine stdlib_wggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) !> ZGGRQF: 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, @@ -20399,8 +20401,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20459,12 +20459,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggrqf + + pure subroutine stdlib_wgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & !> ZGSVJ0: is called from ZGESVJ as a pre-processor and that is its main !> purpose. It applies Jacobi rotations in the same way as ZGESVJ does, but !> it does not check convergence (stopping criterion). Few tuning !> parameters (marked by [TP]) are available for the implementer. - - pure subroutine stdlib_wgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21000,6 +21000,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgsvj0 + + pure subroutine stdlib_wgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & !> ZGSVJ1: is called from ZGESVJ as a pre-processor and that is its main !> purpose. It applies Jacobi rotations in the same way as ZGESVJ does, but !> it targets only particular pivots and it does not check convergence @@ -21024,8 +21026,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21373,13 +21373,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgsvj1 + + pure subroutine stdlib_wgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, info ) !> ZGTCON: estimates the reciprocal of the condition number of a complex !> tridiagonal matrix A using the LU factorization as computed by !> ZGTTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_wgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21457,11 +21457,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgtcon + + pure subroutine stdlib_wgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, x, & !> ZGTRFS: 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. - - pure subroutine stdlib_wgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, x, & ldx, ferr, berr, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21664,14 +21664,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgtrfs + + pure subroutine stdlib_wgtsv( n, nrhs, dl, d, du, b, ldb, info ) !> ZGTSV: 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. - - pure subroutine stdlib_wgtsv( n, nrhs, dl, d, du, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21756,14 +21756,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgtsv + + pure subroutine stdlib_wgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & !> ZGTSVX: uses the LU factorization to compute the solution to a complex !> system of linear equations A * X = B, A**T * X = B, or A**H * X = B, !> where A is a tridiagonal matrix of order N and X and B are N-by-NRHS !> matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - pure subroutine stdlib_wgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & ldb, x, ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21844,6 +21844,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgtsvx + + pure subroutine stdlib_wgttrf( n, dl, d, du, du2, ipiv, info ) !> ZGTTRF: computes an LU factorization of a complex tridiagonal matrix A !> using elimination with partial pivoting and row interchanges. !> The factorization has the form @@ -21851,8 +21853,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wgttrf( n, dl, d, du, du2, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21940,12 +21940,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgttrf + + pure subroutine stdlib_wgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) !> ZGTTRS: 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 ZGTTRF. - - pure subroutine stdlib_wgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22006,12 +22006,12 @@ module stdlib_linalg_lapack_w end if end subroutine stdlib_wgttrs + + pure subroutine stdlib_wgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) !> ZGTTS2: 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 ZGTTRF. - - pure subroutine stdlib_wgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22177,10 +22177,10 @@ module stdlib_linalg_lapack_w end if end subroutine stdlib_wgtts2 - !> ZHB2ST_KERNELS: is an internal routine used by the ZHETRD_HB2ST - !> subroutine. pure subroutine stdlib_whb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, lda, & + !> ZHB2ST_KERNELS: is an internal routine used by the ZHETRD_HB2ST + !> subroutine. v, tau, ldvt, work) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22322,10 +22322,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whb2st_kernels - !> ZHBEV: computes all the eigenvalues and, optionally, eigenvectors of - !> a complex Hermitian band matrix A. subroutine stdlib_whbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,rwork, info ) + !> ZHBEV: computes all the eigenvalues and, optionally, eigenvectors of + !> a complex Hermitian band matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22426,6 +22426,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whbev + + subroutine stdlib_whbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, rwork, lrwork, & !> ZHBEVD: 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. @@ -22435,8 +22437,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_whbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, rwork, lrwork, & iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22576,12 +22576,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whbevd + + subroutine stdlib_whbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & !> ZHBEVX: computes selected eigenvalues and, optionally, eigenvectors !> of a complex Hermitian band matrix A. Eigenvalues and eigenvectors !> can be selected by specifying either a range of values or a range of !> indices for the desired eigenvalues. - - subroutine stdlib_whbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & m, w, z, ldz, work, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22807,6 +22807,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whbevx + + pure subroutine stdlib_whbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, rwork,& !> ZHBGST: 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. @@ -22814,8 +22816,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_whbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, rwork,& info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23739,12 +23739,12 @@ module stdlib_linalg_lapack_w go to 490 end subroutine stdlib_whbgst + + pure subroutine stdlib_whbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & !> ZHBGV: 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. - - pure subroutine stdlib_whbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23819,6 +23819,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whbgv + + pure subroutine stdlib_whbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & !> ZHBGVD: 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 @@ -23830,8 +23832,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_whbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & lwork, rwork, lrwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23946,14 +23946,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whbgvd + + pure subroutine stdlib_whbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & !> ZHBGVX: 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. Eigenvalues and !> eigenvectors can be selected by specifying either all eigenvalues, !> a range of values or a range of indices for the desired eigenvalues. - - pure subroutine stdlib_whbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & vu, il, iu, abstol, m, w, z,ldz, work, rwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24135,11 +24135,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whbgvx + + pure subroutine stdlib_whbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) !> ZHBTRD: reduces a complex Hermitian band matrix A to real symmetric !> tridiagonal form T by a unitary similarity transformation: !> Q**H * A * Q = T. - - pure subroutine stdlib_whbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24499,13 +24499,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whbtrd + + pure subroutine stdlib_whecon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) !> ZHECON: 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 ZHETRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_whecon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24580,13 +24580,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whecon + + pure subroutine stdlib_whecon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) !> ZHECON_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))). - - pure subroutine stdlib_whecon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24661,6 +24661,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whecon_rook + + pure subroutine stdlib_wheequb( uplo, n, a, lda, s, scond, amax, work, info ) !> ZHEEQUB: 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 @@ -24668,8 +24670,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wheequb( uplo, n, a, lda, s, scond, amax, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24843,10 +24843,10 @@ module stdlib_linalg_lapack_w scond = max( smin, smlnum ) / min( smax, bignum ) end subroutine stdlib_wheequb - !> ZHEEV: computes all eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix A. subroutine stdlib_wheev( jobz, uplo, n, a, lda, w, work, lwork, rwork,info ) + !> ZHEEV: computes all eigenvalues and, optionally, eigenvectors of a + !> complex Hermitian matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24954,6 +24954,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wheev + + subroutine stdlib_wheevd( jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, liwork,& !> ZHEEVD: computes all eigenvalues and, optionally, eigenvectors of a !> complex Hermitian matrix A. If eigenvectors are desired, it uses a !> divide and conquer algorithm. @@ -24963,8 +24965,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_wheevd( jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, liwork,& info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25107,6 +25107,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wheevd + + subroutine stdlib_wheevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & !> ZHEEVR: 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 @@ -25157,8 +25159,6 @@ module stdlib_linalg_lapack_w !> hence may abort due to a floating point exception in environments !> which do not handle NaNs and infinities in the ieee standard default !> manner. - - subroutine stdlib_wheevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & isuppz, work, lwork,rwork, lrwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25446,12 +25446,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wheevr + + subroutine stdlib_wheevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & !> ZHEEVX: 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. - - subroutine stdlib_wheevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & work, lwork, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25693,6 +25693,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wheevx + + pure subroutine stdlib_whegs2( itype, uplo, n, a, lda, b, ldb, info ) !> ZHEGS2: reduces a complex Hermitian-definite generalized !> eigenproblem to standard form. !> If ITYPE = 1, the problem is A*x = lambda*B*x, @@ -25700,8 +25702,6 @@ module stdlib_linalg_lapack_w !> 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 ZPOTRF. - - pure subroutine stdlib_whegs2( itype, uplo, n, a, lda, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25826,6 +25826,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whegs2 + + pure subroutine stdlib_whegst( itype, uplo, n, a, lda, b, ldb, info ) !> ZHEGST: reduces a complex Hermitian-definite generalized !> eigenproblem to standard form. !> If ITYPE = 1, the problem is A*x = lambda*B*x, @@ -25833,8 +25835,6 @@ module stdlib_linalg_lapack_w !> 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 ZPOTRF. - - pure subroutine stdlib_whegst( itype, uplo, n, a, lda, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25965,13 +25965,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whegst + + subroutine stdlib_whegv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, info ) !> ZHEGV: 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. - - subroutine stdlib_whegv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26066,6 +26066,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whegv + + subroutine stdlib_whegvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, lrwork,& !> ZHEGVD: 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 @@ -26077,8 +26079,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_whegvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, lrwork,& iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26198,14 +26198,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whegvd + + subroutine stdlib_whegvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& !> ZHEGVX: computes selected eigenvalues, and optionally, 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. !> Eigenvalues and eigenvectors can be selected by specifying either a !> range of values or a range of indices for the desired eigenvalues. - - subroutine stdlib_whegvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& m, w, z, ldz, work,lwork, rwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26326,11 +26326,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whegvx + + pure subroutine stdlib_wherfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & !> ZHERFS: 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. - - pure subroutine stdlib_wherfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26519,6 +26519,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wherfs + + pure subroutine stdlib_whesv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) !> ZHESV: 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 @@ -26530,8 +26532,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_whesv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26597,6 +26597,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whesv + + pure subroutine stdlib_whesv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) !> ZHESV_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 @@ -26607,8 +26609,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_whesv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26669,6 +26669,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whesv_aa + + pure subroutine stdlib_whesv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) !> ZHESV_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. @@ -26683,8 +26685,6 @@ module stdlib_linalg_lapack_w !> ZHETRF_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 ZHETRS_3. - - pure subroutine stdlib_whesv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26746,6 +26746,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whesv_rk + + pure subroutine stdlib_whesv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) !> ZHESV_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 @@ -26762,8 +26764,6 @@ module stdlib_linalg_lapack_w !> pivoting method. !> The factored form of A is then used to solve the system !> of equations A * X = B by calling ZHETRS_ROOK (uses BLAS 2). - - pure subroutine stdlib_whesv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26825,14 +26825,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whesv_rook + + subroutine stdlib_whesvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & !> ZHESVX: uses the diagonal pivoting factorization to compute 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. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_whesvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & ferr, berr, work, lwork,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26922,10 +26922,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whesvx - !> ZHESWAPR: applies an elementary permutation on the rows and the columns of - !> a hermitian matrix. pure subroutine stdlib_wheswapr( uplo, n, a, lda, i1, i2) + !> ZHESWAPR: applies an elementary permutation on the rows and the columns of + !> a hermitian matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26994,11 +26994,11 @@ module stdlib_linalg_lapack_w endif end subroutine stdlib_wheswapr + + pure subroutine stdlib_whetd2( uplo, n, a, lda, d, e, tau, info ) !> ZHETD2: reduces a complex Hermitian matrix A to real symmetric !> tridiagonal form T by a unitary similarity transformation: !> Q**H * A * Q = T. - - pure subroutine stdlib_whetd2( uplo, n, a, lda, d, e, tau, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27098,6 +27098,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetd2 + + pure subroutine stdlib_whetf2( uplo, n, a, lda, ipiv, info ) !> ZHETF2: computes the factorization of a complex Hermitian matrix A !> using the Bunch-Kaufman diagonal pivoting method: !> A = U*D*U**H or A = L*D*L**H @@ -27105,8 +27107,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_whetf2( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27424,6 +27424,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetf2 + + pure subroutine stdlib_whetf2_rk( uplo, n, a, lda, e, ipiv, info ) !> ZHETF2_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), @@ -27433,8 +27435,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_whetf2_rk( uplo, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27955,6 +27955,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetf2_rk + + pure subroutine stdlib_whetf2_rook( uplo, n, a, lda, ipiv, info ) !> ZHETF2_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 @@ -27962,8 +27964,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_whetf2_rook( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28444,11 +28444,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetf2_rook + + pure subroutine stdlib_whetrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) !> ZHETRD: reduces a complex Hermitian matrix A to real symmetric !> tridiagonal form T by a unitary similarity transformation: !> Q**H * A * Q = T. - - pure subroutine stdlib_whetrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28572,11 +28572,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrd + + pure subroutine stdlib_whetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & !> ZHETRD_HB2ST: reduces a complex Hermitian band matrix A to real symmetric !> tridiagonal form T by a unitary similarity transformation: !> Q**H * A * Q = T. - - pure subroutine stdlib_whetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28845,11 +28845,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrd_hb2st + + pure subroutine stdlib_whetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) !> ZHETRD_HE2HB: reduces a complex Hermitian matrix A to complex Hermitian !> band-diagonal form AB by a unitary similarity transformation: !> Q**H * A * Q = AB. - - pure subroutine stdlib_whetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29021,6 +29021,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrd_he2hb + + pure subroutine stdlib_whetrf( uplo, n, a, lda, ipiv, work, lwork, info ) !> ZHETRF: computes the factorization of a complex Hermitian matrix A !> using the Bunch-Kaufman diagonal pivoting method. The form of the !> factorization is @@ -29029,8 +29031,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_whetrf( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29147,14 +29147,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrf + + pure subroutine stdlib_whetrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) !> ZHETRF_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. - - pure subroutine stdlib_whetrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29376,6 +29376,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrf_aa + + pure subroutine stdlib_whetrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) !> ZHETRF_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), @@ -29385,8 +29387,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_whetrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29542,6 +29542,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrf_rk + + pure subroutine stdlib_whetrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) !> ZHETRF_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 @@ -29550,8 +29552,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_whetrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29670,11 +29670,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrf_rook + + pure subroutine stdlib_whetri( uplo, n, a, lda, ipiv, work, info ) !> ZHETRI: 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 !> ZHETRF. - - pure subroutine stdlib_whetri( uplo, n, a, lda, ipiv, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29874,11 +29874,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetri + + pure subroutine stdlib_whetri_rook( uplo, n, a, lda, ipiv, work, info ) !> ZHETRI_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 !> ZHETRF_ROOK. - - pure subroutine stdlib_whetri_rook( uplo, n, a, lda, ipiv, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30142,11 +30142,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetri_rook + + pure subroutine stdlib_whetrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) !> ZHETRS: 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 ZHETRF. - - pure subroutine stdlib_whetrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30373,11 +30373,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrs + + pure subroutine stdlib_whetrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) !> ZHETRS2: 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 ZHETRF and converted by ZSYCONV. - - pure subroutine stdlib_whetrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30554,6 +30554,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrs2 + + pure subroutine stdlib_whetrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) !> ZHETRS_3: solves a system of linear equations A * X = B with a complex !> Hermitian matrix A using the factorization computed !> by ZHETRF_RK or ZHETRF_BK: @@ -30563,8 +30565,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_whetrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30714,11 +30714,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrs_3 + + pure subroutine stdlib_whetrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) !> ZHETRS_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 ZHETRF_AA. - - pure subroutine stdlib_whetrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30835,11 +30835,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrs_aa + + pure subroutine stdlib_whetrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) !> ZHETRS_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 ZHETRF_ROOK. - - pure subroutine stdlib_whetrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31074,6 +31074,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrs_rook + + pure subroutine stdlib_whfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) !> Level 3 BLAS like routine for C in RFP Format. !> ZHFRK: performs one of the Hermitian rank--k operations !> C := alpha*A*A**H + beta*C, @@ -31082,8 +31084,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_whfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31334,6 +31334,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whfrk + + subroutine stdlib_whgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alpha, beta, q, ldq,& !> ZHGEQZ: 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. @@ -31367,8 +31369,6 @@ module stdlib_linalg_lapack_w !> Ref: C.B. Moler !> Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973), !> pp. 241--256. - - subroutine stdlib_whgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alpha, beta, q, ldq,& z, ldz, work, lwork,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31834,13 +31834,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whgeqz + + pure subroutine stdlib_whpcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) !> ZHPCON: 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 ZHPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_whpcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31915,10 +31915,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whpcon - !> ZHPEV: computes all the eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix in packed storage. subroutine stdlib_whpev( jobz, uplo, n, ap, w, z, ldz, work, rwork,info ) + !> ZHPEV: computes all the eigenvalues and, optionally, eigenvectors of a + !> complex Hermitian matrix in packed storage. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32012,6 +32012,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whpev + + subroutine stdlib_whpevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,rwork, lrwork, iwork, & !> ZHPEVD: 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. @@ -32021,8 +32023,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_whpevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,rwork, lrwork, iwork, & liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32154,12 +32154,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whpevd + + subroutine stdlib_whpevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & !> ZHPEVX: computes selected eigenvalues and, optionally, eigenvectors !> of a complex Hermitian matrix A in packed storage. !> Eigenvalues/vectors can be selected by specifying either a range of !> values or a range of indices for the desired eigenvalues. - - subroutine stdlib_whpevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & work, rwork, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32371,6 +32371,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whpevx + + pure subroutine stdlib_whpgst( itype, uplo, n, ap, bp, info ) !> ZHPGST: reduces a complex Hermitian-definite generalized !> eigenproblem to standard form, using packed storage. !> If ITYPE = 1, the problem is A*x = lambda*B*x, @@ -32378,8 +32380,6 @@ module stdlib_linalg_lapack_w !> 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 ZPPTRF. - - pure subroutine stdlib_whpgst( itype, uplo, n, ap, bp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32500,13 +32500,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whpgst + + subroutine stdlib_whpgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,rwork, info ) !> ZHPGV: 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. - - subroutine stdlib_whpgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32585,6 +32585,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whpgv + + subroutine stdlib_whpgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, rwork, lrwork,& !> ZHPGVD: 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 @@ -32597,8 +32599,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_whpgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, rwork, lrwork,& iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32718,6 +32718,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whpgvd + + subroutine stdlib_whpgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & !> ZHPGVX: computes selected eigenvalues and, optionally, 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 @@ -32725,8 +32727,6 @@ module stdlib_linalg_lapack_w !> positive definite. Eigenvalues and eigenvectors can be selected by !> specifying either a range of values or a range of indices for the !> desired eigenvalues. - - subroutine stdlib_whpgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & z, ldz, work, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32830,12 +32830,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whpgvx + + pure subroutine stdlib_whprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& !> ZHPRFS: 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. - - pure subroutine stdlib_whprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33027,6 +33027,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whprfs + + pure subroutine stdlib_whpsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) !> ZHPSV: 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 @@ -33038,8 +33040,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_whpsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33078,14 +33078,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whpsv + + subroutine stdlib_whpsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & !> ZHPSVX: uses the diagonal pivoting factorization A = U*D*U**H or !> A = L*D*L**H to compute 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. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_whpsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33156,11 +33156,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whpsvx + + pure subroutine stdlib_whptrd( uplo, n, ap, d, e, tau, info ) !> ZHPTRD: 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. - - pure subroutine stdlib_whptrd( uplo, n, ap, d, e, tau, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33260,14 +33260,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whptrd + + pure subroutine stdlib_whptrf( uplo, n, ap, ipiv, info ) !> ZHPTRF: 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. - - pure subroutine stdlib_whptrf( uplo, n, ap, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33610,11 +33610,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whptrf + + pure subroutine stdlib_whptri( uplo, n, ap, ipiv, work, info ) !> ZHPTRI: 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 ZHPTRF. - - pure subroutine stdlib_whptri( uplo, n, ap, ipiv, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33829,11 +33829,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whptri + + pure subroutine stdlib_whptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) !> ZHPTRS: 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 ZHPTRF. - - pure subroutine stdlib_whptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34070,14 +34070,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whptrs + + subroutine stdlib_whsein( side, eigsrc, initv, select, n, h, ldh, w, vl,ldvl, vr, ldvr, mm, & !> ZHSEIN: 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. - - subroutine stdlib_whsein( side, eigsrc, initv, select, n, h, ldh, w, vl,ldvl, vr, ldvr, mm, & m, work, rwork, ifaill,ifailr, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34244,6 +34244,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whsein + + pure subroutine stdlib_whseqr( job, compz, n, ilo, ihi, h, ldh, w, z, ldz,work, lwork, info ) !> ZHSEQR: 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 @@ -34252,8 +34254,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_whseqr( job, compz, n, ilo, ihi, h, ldh, w, z, ldz,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34389,6 +34389,8 @@ module stdlib_linalg_lapack_w end if end subroutine stdlib_whseqr + + subroutine stdlib_wla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) !> ZLA_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), @@ -34402,8 +34404,6 @@ module stdlib_linalg_lapack_w !> "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. - - subroutine stdlib_wla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34584,10 +34584,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wla_gbamv - !> ZLA_GBRCOND_C: Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. real(qp) function stdlib_wla_gbrcond_c( trans, n, kl, ku, ab,ldab, afb, ldafb, ipiv,c, & + !> ZLA_GBRCOND_C: Computes the infinity norm condition number of + !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. capply, info, work,rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34732,14 +34732,14 @@ module stdlib_linalg_lapack_w return end function stdlib_wla_gbrcond_c + + pure real(qp) function stdlib_wla_gbrpvgrw( n, kl, ku, ncols, ab,ldab, afb, ldafb ) !> ZLA_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. - - pure real(qp) function stdlib_wla_gbrpvgrw( n, kl, ku, ncols, ab,ldab, afb, ldafb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34777,6 +34777,8 @@ module stdlib_linalg_lapack_w stdlib_wla_gbrpvgrw = rpvgrw end function stdlib_wla_gbrpvgrw + + subroutine stdlib_wla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) !> ZLA_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), @@ -34790,8 +34792,6 @@ module stdlib_linalg_lapack_w !> "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. - - subroutine stdlib_wla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34966,10 +34966,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wla_geamv - !> ZLA_GERCOND_C: computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. real(qp) function stdlib_wla_gercond_c( trans, n, a, lda, af,ldaf, ipiv, c, capply,info, & + !> ZLA_GERCOND_C: computes the infinity norm condition number of + !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. work, rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35107,14 +35107,14 @@ module stdlib_linalg_lapack_w return end function stdlib_wla_gercond_c + + pure real(qp) function stdlib_wla_gerpvgrw( n, ncols, a, lda, af,ldaf ) !> ZLA_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. - - pure real(qp) function stdlib_wla_gerpvgrw( n, ncols, a, lda, af,ldaf ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35151,6 +35151,8 @@ module stdlib_linalg_lapack_w stdlib_wla_gerpvgrw = rpvgrw end function stdlib_wla_gerpvgrw + + subroutine stdlib_wla_heamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) !> ZLA_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 @@ -35163,8 +35165,6 @@ module stdlib_linalg_lapack_w !> "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. - - subroutine stdlib_wla_heamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35345,10 +35345,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wla_heamv - !> ZLA_HERCOND_C: computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. real(qp) function stdlib_wla_hercond_c( uplo, n, a, lda, af,ldaf, ipiv, c, capply,info, work,& + !> ZLA_HERCOND_C: computes the infinity norm condition number of + !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35495,14 +35495,14 @@ module stdlib_linalg_lapack_w return end function stdlib_wla_hercond_c + + real(qp) function stdlib_wla_herpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) !> ZLA_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. - - real(qp) function stdlib_wla_herpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35684,13 +35684,13 @@ module stdlib_linalg_lapack_w stdlib_wla_herpvgrw = rpvgrw end function stdlib_wla_herpvgrw + + pure subroutine stdlib_wla_lin_berr( n, nz, nrhs, res, ayb, berr ) !> ZLA_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. - - pure subroutine stdlib_wla_lin_berr( n, nz, nrhs, res, ayb, berr ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35730,10 +35730,10 @@ module stdlib_linalg_lapack_w end do end subroutine stdlib_wla_lin_berr - !> ZLA_PORCOND_C: Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector real(qp) function stdlib_wla_porcond_c( uplo, n, a, lda, af,ldaf, c, capply, info,work, & + !> ZLA_PORCOND_C: Computes the infinity norm condition number of + !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35880,14 +35880,14 @@ module stdlib_linalg_lapack_w return end function stdlib_wla_porcond_c + + real(qp) function stdlib_wla_porpvgrw( uplo, ncols, a, lda, af,ldaf, work ) !> ZLA_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. - - real(qp) function stdlib_wla_porpvgrw( uplo, ncols, a, lda, af,ldaf, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35973,6 +35973,8 @@ module stdlib_linalg_lapack_w stdlib_wla_porpvgrw = rpvgrw end function stdlib_wla_porpvgrw + + subroutine stdlib_wla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) !> ZLA_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 @@ -35985,8 +35987,6 @@ module stdlib_linalg_lapack_w !> "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. - - subroutine stdlib_wla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36168,10 +36168,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wla_syamv - !> ZLA_SYRCOND_C: Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. real(qp) function stdlib_wla_syrcond_c( uplo, n, a, lda, af,ldaf, ipiv, c, capply,info, work,& + !> ZLA_SYRCOND_C: Computes the infinity norm condition number of + !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36319,14 +36319,14 @@ module stdlib_linalg_lapack_w return end function stdlib_wla_syrcond_c + + real(qp) function stdlib_wla_syrpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) !> ZLA_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. - - real(qp) function stdlib_wla_syrpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36508,11 +36508,11 @@ module stdlib_linalg_lapack_w stdlib_wla_syrpvgrw = rpvgrw end function stdlib_wla_syrpvgrw + + pure subroutine stdlib_wla_wwaddw( n, x, y, w ) !> ZLA_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. - - pure subroutine stdlib_wla_wwaddw( n, x, y, w ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36535,6 +36535,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wla_wwaddw + + pure subroutine stdlib_wlabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) !> ZLABRD: 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 @@ -36542,8 +36544,6 @@ module stdlib_linalg_lapack_w !> If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower !> bidiagonal form. !> This is an auxiliary routine called by ZGEBRD - - pure subroutine stdlib_wlabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36685,9 +36685,9 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlabrd - !> ZLACGV: conjugates a complex vector of length N. pure subroutine stdlib_wlacgv( n, x, incx ) + !> ZLACGV: conjugates a complex vector of length N. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36716,10 +36716,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlacgv - !> ZLACN2: estimates the 1-norm of a square, complex matrix A. - !> Reverse communication is used for evaluating matrix-vector products. pure subroutine stdlib_wlacn2( n, v, x, est, kase, isave ) + !> ZLACN2: estimates the 1-norm of a square, complex matrix A. + !> Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36843,10 +36843,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlacn2 - !> ZLACON: estimates the 1-norm of a square, complex matrix A. - !> Reverse communication is used for evaluating matrix-vector products. subroutine stdlib_wlacon( n, v, x, est, kase ) + !> ZLACON: estimates the 1-norm of a square, complex matrix A. + !> Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36970,10 +36970,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlacon - !> ZLACP2: copies all or part of a real two-dimensional matrix A to a - !> complex matrix B. pure subroutine stdlib_wlacp2( uplo, m, n, a, lda, b, ldb ) + !> ZLACP2: copies all or part of a real two-dimensional matrix A to a + !> complex matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37011,10 +37011,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlacp2 - !> ZLACPY: copies all or part of a two-dimensional matrix A to another - !> matrix B. pure subroutine stdlib_wlacpy( uplo, m, n, a, lda, b, ldb ) + !> ZLACPY: copies all or part of a two-dimensional matrix A to another + !> matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37052,12 +37052,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlacpy + + pure subroutine stdlib_wlacrm( m, n, a, lda, b, ldb, c, ldc, rwork ) !> ZLACRM: 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. - - pure subroutine stdlib_wlacrm( m, n, a, lda, b, ldb, c, ldc, rwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37106,12 +37106,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlacrm + + pure subroutine stdlib_wlacrt( n, cx, incx, cy, incy, c, s ) !> ZLACRT: 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. - - pure subroutine stdlib_wlacrt( n, cx, incx, cy, incy, c, s ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37150,11 +37150,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlacrt + + pure complex(qp) function stdlib_wladiv( x, y ) !> ZLADIV: := X / Y, where X and Y are complex. The computation of X / Y !> will not overflow on an intermediary step unless the results !> overflows. - - pure complex(qp) function stdlib_wladiv( x, y ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37172,12 +37172,12 @@ module stdlib_linalg_lapack_w return end function stdlib_wladiv + + pure subroutine stdlib_wlaed0( qsiz, n, d, e, q, ldq, qstore, ldqs, rwork,iwork, info ) !> Using the divide and conquer method, ZLAED0: 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. - - pure subroutine stdlib_wlaed0( qsiz, n, d, e, q, ldq, qstore, ldqs, rwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37350,6 +37350,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaed0 + + pure subroutine stdlib_wlaed7( n, cutpnt, qsiz, tlvls, curlvl, curpbm, d, q,ldq, rho, indxq, & !> ZLAED7: 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 @@ -37374,8 +37376,6 @@ module stdlib_linalg_lapack_w !> directly using the updated eigenvalues. The eigenvectors for !> the current problem are multiplied with the eigenvectors from !> the overall problem. - - pure subroutine stdlib_wlaed7( n, cutpnt, qsiz, tlvls, curlvl, curpbm, d, q,ldq, rho, indxq, & qstore, qptr, prmptr, perm,givptr, givcol, givnum, work, rwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37477,14 +37477,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaed7 + + pure subroutine stdlib_wlaed8( k, n, qsiz, q, ldq, d, rho, cutpnt, z, dlamda,q2, ldq2, w, & !> ZLAED8: 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. - - pure subroutine stdlib_wlaed8( k, n, qsiz, q, ldq, d, rho, cutpnt, z, dlamda,q2, ldq2, w, & indxp, indx, indxq, perm, givptr,givcol, givnum, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37680,11 +37680,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaed8 + + pure subroutine stdlib_wlaein( rightv, noinit, n, h, ldh, w, v, b, ldb, rwork,eps3, smlnum, & !> ZLAEIN: uses inverse iteration to find a right or left eigenvector !> corresponding to the eigenvalue W of a complex upper Hessenberg !> matrix H. - - pure subroutine stdlib_wlaein( rightv, noinit, n, h, ldh, w, v, b, ldb, rwork,eps3, smlnum, & info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37824,6 +37824,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaein + + pure subroutine stdlib_wlaesy( a, b, c, rt1, rt2, evscal, cs1, sn1 ) !> ZLAESY: 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 @@ -37833,8 +37835,6 @@ module stdlib_linalg_lapack_w !> 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 ] - - pure subroutine stdlib_wlaesy( a, b, c, rt1, rt2, evscal, cs1, sn1 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37914,6 +37914,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaesy + + pure subroutine stdlib_wlaev2( a, b, c, rt1, rt2, cs1, sn1 ) !> ZLAEV2: computes the eigendecomposition of a 2-by-2 Hermitian matrix !> [ A B ] !> [ CONJG(B) C ]. @@ -37922,8 +37924,6 @@ module stdlib_linalg_lapack_w !> eigenvector for RT1, giving the decomposition !> [ CS1 CONJG(SN1) ] [ A B ] [ CS1 -CONJG(SN1) ] = [ RT1 0 ] !> [-SN1 CS1 ] [ CONJG(B) C ] [ SN1 CS1 ] [ 0 RT2 ]. - - pure subroutine stdlib_wlaev2( a, b, c, rt1, rt2, cs1, sn1 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37951,13 +37951,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaev2 + + pure subroutine stdlib_wlag2c( m, n, a, lda, sa, ldsa, info ) !> ZLAG2C: converts a COMPLEX*16 matrix, SA, to a COMPLEX matrix, A. !> RMAX is the overflow for the SINGLE PRECISION arithmetic !> ZLAG2C checks that all the entries of A are between -RMAX and !> RMAX. If not the conversion is aborted and a flag is raised. !> This is an auxiliary routine so there is no argument checking. - - pure subroutine stdlib_wlag2c( m, n, a, lda, sa, ldsa, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37990,6 +37990,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlag2c + + pure subroutine stdlib_wlags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) !> ZLAGS2: computes 2-by-2 unitary matrices U, V and Q, such !> that if ( UPPER ) then !> U**H *A*Q = U**H *( A1 A2 )*Q = ( x 0 ) @@ -38014,8 +38016,6 @@ module stdlib_linalg_lapack_w !> then the transformed (2,2) element of B is not zero, except when the !> first rows of input A and B are parallel and the second rows are !> zero. - - pure subroutine stdlib_wlags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38177,13 +38177,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlags2 + + pure subroutine stdlib_wlagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) !> ZLAGTM: 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. - - pure subroutine stdlib_wlagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38313,6 +38313,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlagtm + + pure subroutine stdlib_wlahef( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) !> ZLAHEF: computes a partial factorization of a complex Hermitian !> matrix A using the Bunch-Kaufman diagonal pivoting method. The !> partial factorization has the form: @@ -38326,8 +38328,6 @@ module stdlib_linalg_lapack_w !> ZLAHEF is an auxiliary routine called by ZHETRF. It uses blocked code !> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or !> A22 (if UPLO = 'L'). - - pure subroutine stdlib_wlahef( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38852,6 +38852,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlahef + + pure subroutine stdlib_wlahef_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) !> DLAHEF_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. @@ -38862,8 +38864,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wlahef_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39096,6 +39096,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlahef_aa + + pure subroutine stdlib_wlahef_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) !> ZLAHEF_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: @@ -39108,8 +39110,6 @@ module stdlib_linalg_lapack_w !> ZLAHEF_RK is an auxiliary routine called by ZHETRF_RK. It uses !> blocked code (calling Level 3 BLAS) to update the submatrix !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). - - pure subroutine stdlib_wlahef_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39736,6 +39736,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlahef_rk + + pure subroutine stdlib_wlahef_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) !> ZLAHEF_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: @@ -39749,8 +39751,6 @@ module stdlib_linalg_lapack_w !> ZLAHEF_ROOK is an auxiliary routine called by ZHETRF_ROOK. It uses !> blocked code (calling Level 3 BLAS) to update the submatrix !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). - - pure subroutine stdlib_wlahef_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -40408,12 +40408,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlahef_rook + + pure subroutine stdlib_wlahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, info & !> ZLAHQR: 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. - - pure subroutine stdlib_wlahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, info & ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40694,14 +40694,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlahqr + + pure subroutine stdlib_wlahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) !> ZLAHR2: reduces the first NB columns of A complex general n-BY-(n-k+1) !> matrix A so that elements below the k-th subdiagonal are zero. The !> reduction is performed by an unitary similarity transformation !> Q**H * A * Q. The routine returns the matrices V and T which determine !> Q as a block reflector I - V*T*V**H, and also the matrix Y = A * V * T. !> This is an auxiliary routine called by ZGEHRD. - - pure subroutine stdlib_wlahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -40784,6 +40784,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlahr2 + + pure subroutine stdlib_wlaic1( job, j, x, sest, w, gamma, sestpr, s, c ) !> ZLAIC1: 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 @@ -40804,8 +40806,6 @@ module stdlib_linalg_lapack_w !> diag(sest*sest, 0) + [alpha gamma] * [ conjg(alpha) ] !> [ conjg(gamma) ] !> where alpha = x**H * w. - - pure subroutine stdlib_wlaic1( job, j, x, sest, w, gamma, sestpr, s, c ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41000,6 +41000,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaic1 + + pure subroutine stdlib_wlals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, & !> ZLALS0: 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 @@ -41020,8 +41022,6 @@ module stdlib_linalg_lapack_w !> null space. !> (3R) The inverse transformation of (2L). !> (4R) The inverse transformation of (1L). - - pure subroutine stdlib_wlals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, & givcol, ldgcol, givnum, ldgnum,poles, difl, difr, z, k, c, s, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41245,6 +41245,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlals0 + + pure subroutine stdlib_wlalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, difl,& !> ZLALSA: 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 @@ -41254,8 +41256,6 @@ module stdlib_linalg_lapack_w !> ICOMPQ = 1, ZLALSA applies the right singular vector matrix to the !> right hand side. The singular vector matrices were generated in !> compact form by ZLALSA. - - pure subroutine stdlib_wlalsa( 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 ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41548,6 +41548,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlalsa + + pure subroutine stdlib_wlalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, rwork, & !> ZLALSD: 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 @@ -41562,8 +41564,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wlalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, rwork, & iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41959,6 +41959,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlalsd + + pure subroutine stdlib_wlamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & !> ZLAMSWLQ: overwrites the general complex M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -41966,8 +41968,6 @@ module stdlib_linalg_lapack_w !> where Q is a complex unitary matrix defined as the product of blocked !> elementary reflectors computed by short wide LQ !> factorization (ZLASWLQ) - - pure subroutine stdlib_wlamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42117,6 +42117,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlamswlq + + pure subroutine stdlib_wlamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & !> ZLAMTSQR: overwrites the general complex M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -42124,8 +42126,6 @@ module stdlib_linalg_lapack_w !> where Q is a complex unitary matrix defined as the product !> of blocked elementary reflectors computed by tall skinny !> QR factorization (ZLATSQR) - - pure subroutine stdlib_wlamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42279,11 +42279,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlamtsqr + + real(qp) function stdlib_wlangb( norm, n, kl, ku, ab, ldab,work ) !> ZLANGB: 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. - - real(qp) function stdlib_wlangb( norm, n, kl, ku, ab, ldab,work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42354,11 +42354,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlangb + + real(qp) function stdlib_wlange( norm, m, n, a, lda, work ) !> ZLANGE: 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. - - real(qp) function stdlib_wlange( norm, m, n, a, lda, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42426,11 +42426,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlange + + pure real(qp) function stdlib_wlangt( norm, n, dl, d, du ) !> ZLANGT: 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. - - pure real(qp) function stdlib_wlangt( norm, n, dl, d, du ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42502,11 +42502,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlangt + + real(qp) function stdlib_wlanhb( norm, uplo, n, k, ab, ldab,work ) !> ZLANHB: 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. - - real(qp) function stdlib_wlanhb( norm, uplo, n, k, ab, ldab,work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42621,11 +42621,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlanhb + + real(qp) function stdlib_wlanhe( norm, uplo, n, a, lda, work ) !> ZLANHE: 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. - - real(qp) function stdlib_wlanhe( norm, uplo, n, a, lda, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42731,11 +42731,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlanhe + + real(qp) function stdlib_wlanhf( norm, transr, uplo, n, a, work ) !> ZLANHF: 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. - - real(qp) function stdlib_wlanhf( norm, transr, uplo, n, a, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43951,11 +43951,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlanhf + + real(qp) function stdlib_wlanhp( norm, uplo, n, ap, work ) !> ZLANHP: 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. - - real(qp) function stdlib_wlanhp( norm, uplo, n, ap, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44079,11 +44079,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlanhp + + real(qp) function stdlib_wlanhs( norm, n, a, lda, work ) !> ZLANHS: 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. - - real(qp) function stdlib_wlanhs( norm, n, a, lda, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44151,11 +44151,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlanhs + + pure real(qp) function stdlib_wlanht( norm, n, d, e ) !> ZLANHT: 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. - - pure real(qp) function stdlib_wlanht( norm, n, d, e ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44214,11 +44214,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlanht + + real(qp) function stdlib_wlansb( norm, uplo, n, k, ab, ldab,work ) !> ZLANSB: 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. - - real(qp) function stdlib_wlansb( norm, uplo, n, k, ab, ldab,work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44319,11 +44319,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlansb + + real(qp) function stdlib_wlansp( norm, uplo, n, ap, work ) !> ZLANSP: 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. - - real(qp) function stdlib_wlansp( norm, uplo, n, ap, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44452,11 +44452,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlansp + + real(qp) function stdlib_wlansy( norm, uplo, n, a, lda, work ) !> ZLANSY: 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. - - real(qp) function stdlib_wlansy( norm, uplo, n, a, lda, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44548,11 +44548,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlansy + + real(qp) function stdlib_wlantb( norm, uplo, diag, n, k, ab,ldab, work ) !> ZLANTB: 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. - - real(qp) function stdlib_wlantb( norm, uplo, diag, n, k, ab,ldab, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44741,11 +44741,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlantb + + real(qp) function stdlib_wlantp( norm, uplo, diag, n, ap, work ) !> ZLANTP: 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. - - real(qp) function stdlib_wlantp( norm, uplo, diag, n, ap, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44947,11 +44947,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlantp + + real(qp) function stdlib_wlantr( norm, uplo, diag, m, n, a, lda,work ) !> ZLANTR: 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. - - real(qp) function stdlib_wlantr( norm, uplo, diag, m, n, a, lda,work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45133,14 +45133,14 @@ module stdlib_linalg_lapack_w return end function stdlib_wlantr + + pure subroutine stdlib_wlapll( n, x, incx, y, incy, ssmin ) !> 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. - - pure subroutine stdlib_wlapll( n, x, incx, y, incy, ssmin ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45177,14 +45177,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlapll + + pure subroutine stdlib_wlapmr( forwrd, m, n, x, ldx, k ) !> ZLAPMR: 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. - - pure subroutine stdlib_wlapmr( forwrd, m, n, x, ldx, k ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45245,14 +45245,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlapmr + + pure subroutine stdlib_wlapmt( forwrd, m, n, x, ldx, k ) !> ZLAPMT: 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. - - pure subroutine stdlib_wlapmt( forwrd, m, n, x, ldx, k ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45313,11 +45313,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlapmt + + pure subroutine stdlib_wlaqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) !> ZLAQGB: 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. - - pure subroutine stdlib_wlaqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45383,10 +45383,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaqgb - !> ZLAQGE: equilibrates a general M by N matrix A using the row and - !> column scaling factors in the vectors R and C. pure subroutine stdlib_wlaqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed ) + !> ZLAQGE: equilibrates a general M by N matrix A using the row and + !> column scaling factors in the vectors R and C. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45449,10 +45449,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaqge - !> ZLAQHB: equilibrates a Hermitian band matrix A - !> using the scaling factors in the vector S. pure subroutine stdlib_wlaqhb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) + !> ZLAQHB: equilibrates a Hermitian band matrix A + !> using the scaling factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45511,10 +45511,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaqhb - !> ZLAQHE: equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_wlaqhe( uplo, n, a, lda, s, scond, amax, equed ) + !> ZLAQHE: equilibrates a Hermitian matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45573,10 +45573,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaqhe - !> ZLAQHP: equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_wlaqhp( uplo, n, ap, s, scond, amax, equed ) + !> ZLAQHP: equilibrates a Hermitian matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45639,11 +45639,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaqhp + + pure subroutine stdlib_wlaqp2( m, n, offset, a, lda, jpvt, tau, vn1, vn2,work ) !> ZLAQP2: computes a QR factorization with column pivoting of !> the block A(OFFSET+1:M,1:N). !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. - - pure subroutine stdlib_wlaqp2( m, n, offset, a, lda, jpvt, tau, vn1, vn2,work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45719,6 +45719,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaqp2 + + pure subroutine stdlib_wlaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & !> ZLAQPS: 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 @@ -45727,8 +45729,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wlaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45862,6 +45862,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaqps + + pure subroutine stdlib_wlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& !> ZLAQR0: 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 @@ -45870,8 +45872,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46209,14 +46209,14 @@ module stdlib_linalg_lapack_w work( 1 ) = cmplx( lwkopt, 0,KIND=qp) end subroutine stdlib_wlaqr0 + + pure subroutine stdlib_wlaqr1( n, h, ldh, s1, s2, v ) !> Given a 2-by-2 or 3-by-3 matrix H, ZLAQR1: 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. - - pure subroutine stdlib_wlaqr1( n, h, ldh, s1, s2, v ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46272,6 +46272,8 @@ module stdlib_linalg_lapack_w end if end subroutine stdlib_wlaqr1 + + pure subroutine stdlib_wlaqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & !> ZLAQR2: is identical to ZLAQR3 except that it avoids !> recursion by calling ZLAHQR instead of ZLAQR4. !> Aggressive early deflation: @@ -46283,8 +46285,6 @@ module stdlib_linalg_lapack_w !> an unitary similarity transformation of H. It is to be !> hoped that the final version of H has many zero subdiagonal !> entries. - - pure subroutine stdlib_wlaqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & ns, nd, sh, v, ldv, nh, t, ldt,nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46486,6 +46486,8 @@ module stdlib_linalg_lapack_w work( 1 ) = cmplx( lwkopt, 0,KIND=qp) end subroutine stdlib_wlaqr2 + + pure subroutine stdlib_wlaqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & !> Aggressive early deflation: !> ZLAQR3: accepts as input an upper Hessenberg matrix !> H and performs an unitary similarity transformation @@ -46495,8 +46497,6 @@ module stdlib_linalg_lapack_w !> an unitary similarity transformation of H. It is to be !> hoped that the final version of H has many zero subdiagonal !> entries. - - pure subroutine stdlib_wlaqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & ns, nd, sh, v, ldv, nh, t, ldt,nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46708,6 +46708,8 @@ module stdlib_linalg_lapack_w work( 1 ) = cmplx( lwkopt, 0,KIND=qp) end subroutine stdlib_wlaqr3 + + pure subroutine stdlib_wlaqr4( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& !> ZLAQR4: implements one level of recursion for ZLAQR0. !> It is a complete implementation of the small bulge multi-shift !> QR algorithm. It may be called by ZLAQR0 and, for large enough @@ -46722,8 +46724,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wlaqr4( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47056,10 +47056,10 @@ module stdlib_linalg_lapack_w work( 1 ) = cmplx( lwkopt, 0,KIND=qp) end subroutine stdlib_wlaqr4 - !> ZLAQR5:, called by ZLAQR0, performs a - !> single small-bulge multi-shift QR sweep. pure subroutine stdlib_wlaqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts, s,h, ldh, iloz, & + !> ZLAQR5:, called by ZLAQR0, performs a + !> single small-bulge multi-shift QR sweep. ihiz, z, ldz, v, ldv, u, ldu, nv,wv, ldwv, nh, wh, ldwh ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47454,10 +47454,10 @@ module stdlib_linalg_lapack_w end do loop_180 end subroutine stdlib_wlaqr5 - !> ZLAQSB: equilibrates a symmetric band matrix A using the scaling - !> factors in the vector S. pure subroutine stdlib_wlaqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) + !> ZLAQSB: equilibrates a symmetric band matrix A using the scaling + !> factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47514,10 +47514,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaqsb - !> ZLAQSP: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_wlaqsp( uplo, n, ap, s, scond, amax, equed ) + !> ZLAQSP: equilibrates a symmetric matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47576,10 +47576,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaqsp - !> ZLAQSY: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_wlaqsy( uplo, n, a, lda, s, scond, amax, equed ) + !> ZLAQSY: equilibrates a symmetric matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47634,6 +47634,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaqsy + + recursive subroutine stdlib_wlaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alpha, & !> ZLAQZ0: computes the eigenvalues of a real matrix pair (H,T), !> where H is an upper Hessenberg matrix and T is upper triangular, !> using the double-shift QZ method. @@ -47674,8 +47676,6 @@ module stdlib_linalg_lapack_w !> 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" - - recursive subroutine stdlib_wlaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alpha, & beta, q, ldq, z,ldz, work, lwork, rwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -47987,9 +47987,9 @@ module stdlib_linalg_lapack_w info = norm_info end subroutine stdlib_wlaqz0 - !> ZLAQZ1: chases a 1x1 shift bulge in a matrix pencil down a single position pure subroutine stdlib_wlaqz1( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, qstart, & + !> ZLAQZ1: chases a 1x1 shift bulge in a matrix pencil down a single position q, ldq, nz, zstart, z, ldz ) ! arguments logical(lk), intent( in ) :: ilq, ilz @@ -48041,9 +48041,9 @@ module stdlib_linalg_lapack_w end if end subroutine stdlib_wlaqz1 - !> ZLAQZ2: performs AED recursive subroutine stdlib_wlaqz2( ilschur, ilq, ilz, n, ilo, ihi, nw,a, lda, b, ldb, q, & + !> ZLAQZ2: performs AED ldq, z, ldz, ns,nd, alpha, beta, qc, ldqc, zc, ldzc,work, lwork, rwork, rec, info ) ! arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -48230,9 +48230,9 @@ module stdlib_linalg_lapack_w end if end subroutine stdlib_wlaqz2 - !> ZLAQZ3: Executes a single multishift QZ sweep pure subroutine stdlib_wlaqz3( ilschur, ilq, ilz, n, ilo, ihi, nshifts,nblock_qesired, alpha,& + !> ZLAQZ3: Executes a single multishift QZ sweep beta, a, lda, b, ldb,q, ldq, z, ldz, qc, ldqc, zc, ldzc, work,lwork, info ) ! function arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -48470,6 +48470,8 @@ module stdlib_linalg_lapack_w end if end subroutine stdlib_wlaqz3 + + pure subroutine stdlib_wlar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & !> ZLAR1V: 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 @@ -48485,8 +48487,6 @@ module stdlib_linalg_lapack_w !> (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. - - pure subroutine stdlib_wlar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48693,6 +48693,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlar1v + + pure subroutine stdlib_wlar2v( n, x, y, z, incx, c, s, incc ) !> ZLAR2V: 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 @@ -48700,8 +48702,6 @@ module stdlib_linalg_lapack_w !> ( 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) ) - - pure subroutine stdlib_wlar2v( n, x, y, z, incx, c, s, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48747,12 +48747,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlar2v + + pure subroutine stdlib_wlarcm( m, n, a, lda, b, ldb, c, ldc, rwork ) !> ZLARCM: 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. - - pure subroutine stdlib_wlarcm( m, n, a, lda, b, ldb, c, ldc, rwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48801,6 +48801,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarcm + + pure subroutine stdlib_wlarf( side, m, n, v, incv, tau, c, ldc, work ) !> ZLARF: 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 @@ -48809,8 +48811,6 @@ module stdlib_linalg_lapack_w !> If tau = 0, then H is taken to be the unit matrix. !> To apply H**H, supply conjg(tau) instead !> tau. - - pure subroutine stdlib_wlarf( side, m, n, v, incv, tau, c, ldc, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48881,10 +48881,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarf - !> ZLARFB: 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. pure subroutine stdlib_wlarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, ldc, & + !> ZLARFB: 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. work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49209,6 +49209,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarfb + + pure subroutine stdlib_wlarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) !> ZLARFB_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 @@ -49216,8 +49218,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wlarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49348,6 +49348,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarfb_gett + + pure subroutine stdlib_wlarfg( n, alpha, x, incx, tau ) !> ZLARFG: generates a complex elementary reflector H of order n, such !> that !> H**H * ( alpha ) = ( beta ), H**H * H = I. @@ -49361,8 +49363,6 @@ module stdlib_linalg_lapack_w !> 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 . - - pure subroutine stdlib_wlarfg( n, alpha, x, incx, tau ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49422,6 +49422,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarfg + + subroutine stdlib_wlarfgp( n, alpha, x, incx, tau ) !> ZLARFGP: generates a complex elementary reflector H of order n, such !> that !> H**H * ( alpha ) = ( beta ), H**H * H = I. @@ -49434,8 +49436,6 @@ module stdlib_linalg_lapack_w !> 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. - - subroutine stdlib_wlarfgp( n, alpha, x, incx, tau ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49558,6 +49558,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarfgp + + pure subroutine stdlib_wlarft( direct, storev, n, k, v, ldv, tau, t, ldt ) !> ZLARFT: 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; @@ -49568,8 +49570,6 @@ module stdlib_linalg_lapack_w !> 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 - - pure subroutine stdlib_wlarft( direct, storev, n, k, v, ldv, tau, t, ldt ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49685,6 +49685,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarft + + pure subroutine stdlib_wlarfx( side, m, n, v, tau, c, ldc, work ) !> ZLARFX: 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 @@ -49692,8 +49694,6 @@ module stdlib_linalg_lapack_w !> where tau is a complex scalar and v is a complex vector. !> If tau = 0, then H is taken to be the unit matrix !> This version uses inline code if H has order < 11. - - pure subroutine stdlib_wlarfx( side, m, n, v, tau, c, ldc, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50190,14 +50190,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarfx + + pure subroutine stdlib_wlarfy( uplo, n, v, incv, tau, c, ldc, work ) !> ZLARFY: 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. - - pure subroutine stdlib_wlarfy( uplo, n, v, incv, tau, c, ldc, work ) ! -- lapack test routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50224,6 +50224,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarfy + + pure subroutine stdlib_wlargv( n, x, incx, y, incy, c, incc ) !> ZLARGV: 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 @@ -50234,8 +50236,6 @@ module stdlib_linalg_lapack_w !> but differ from the BLAS1 routine ZROTG): !> 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. - - pure subroutine stdlib_wlargv( n, x, incx, y, incy, c, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50378,10 +50378,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlargv - !> ZLARNV: returns a vector of n random complex numbers from a uniform or - !> normal distribution. pure subroutine stdlib_wlarnv( idist, iseed, n, x ) + !> ZLARNV: returns a vector of n random complex numbers from a uniform or + !> normal distribution. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50443,11 +50443,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarnv + + pure subroutine stdlib_wlarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, & !> ZLARRV: 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 DLARRE. - - pure subroutine stdlib_wlarrv( 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 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51093,6 +51093,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarrv + + pure subroutine stdlib_wlartg( f, g, c, s, r ) !> ! !> !> ZLARTG: generates a plane rotation so that @@ -51117,8 +51119,6 @@ module stdlib_linalg_lapack_w !> 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=>dp stands for quad precision from LA_CONSTANTS module. - - pure subroutine stdlib_wlartg( f, g, c, s, r ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51213,12 +51213,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlartg + + pure subroutine stdlib_wlartv( n, x, incx, y, incy, c, s, incc ) !> ZLARTV: 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) ) - - pure subroutine stdlib_wlartv( n, x, incx, y, incy, c, s, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51250,6 +51250,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlartv + + pure subroutine stdlib_wlarz( side, m, n, l, v, incv, tau, c, ldc, work ) !> ZLARZ: 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 @@ -51259,8 +51261,6 @@ module stdlib_linalg_lapack_w !> 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 ZTZRZF. - - pure subroutine stdlib_wlarz( side, m, n, l, v, incv, tau, c, ldc, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51309,11 +51309,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarz + + pure subroutine stdlib_wlarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & !> ZLARZB: 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. - - pure subroutine stdlib_wlarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & ldc, work, ldwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51411,6 +51411,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarzb + + pure subroutine stdlib_wlarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) !> ZLARZT: forms the triangular factor T of a complex block reflector !> H of order > n, which is defined as a product of k elementary !> reflectors. @@ -51423,8 +51425,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wlarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51475,13 +51475,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarzt + + pure subroutine stdlib_wlascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) !> ZLASCL: 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. - - pure subroutine stdlib_wlascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51645,10 +51645,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlascl - !> ZLASET: initializes a 2-D array A to BETA on the diagonal and - !> ALPHA on the offdiagonals. pure subroutine stdlib_wlaset( uplo, m, n, alpha, beta, a, lda ) + !> ZLASET: initializes a 2-D array A to BETA on the diagonal and + !> ALPHA on the offdiagonals. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51701,6 +51701,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaset + + pure subroutine stdlib_wlasr( side, pivot, direct, m, n, c, s, a, lda ) !> ZLASR: 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 @@ -51752,8 +51754,6 @@ module stdlib_linalg_lapack_w !> ( -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. - - pure subroutine stdlib_wlasr( side, pivot, direct, m, n, c, s, a, lda ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51961,6 +51961,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlasr + + pure subroutine stdlib_wlassq( n, x, incx, scl, sumsq ) !> ! !> !> ZLASSQ: returns the values scl and smsq such that @@ -51981,8 +51983,6 @@ module stdlib_linalg_lapack_w !> and !> TINY*EPS -- tiniest representable number; !> HUGE -- biggest representable number. - - pure subroutine stdlib_wlassq( n, x, incx, scl, sumsq ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52087,6 +52087,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlassq + + pure subroutine stdlib_wlaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) !> ZLASWLQ: computes a blocked Tall-Skinny LQ factorization of !> a complexx M-by-N matrix A for M <= N: !> A = ( L 0 ) * Q, @@ -52097,8 +52099,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wlaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -52171,10 +52171,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaswlq - !> ZLASWP: performs a series of row interchanges on the matrix A. - !> One row interchange is initiated for each of rows K1 through K2 of A. pure subroutine stdlib_wlaswp( n, a, lda, k1, k2, ipiv, incx ) + !> ZLASWP: performs a series of row interchanges on the matrix A. + !> One row interchange is initiated for each of rows K1 through K2 of A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52238,6 +52238,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaswp + + pure subroutine stdlib_wlasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) !> ZLASYF: computes a partial factorization of a complex symmetric matrix !> A using the Bunch-Kaufman diagonal pivoting method. The partial !> factorization has the form: @@ -52251,8 +52253,6 @@ module stdlib_linalg_lapack_w !> ZLASYF is an auxiliary routine called by ZSYTRF. It uses blocked code !> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or !> A22 (if UPLO = 'L'). - - pure subroutine stdlib_wlasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52678,6 +52678,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlasyf + + pure subroutine stdlib_wlasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) !> 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. @@ -52688,8 +52690,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wlasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52914,6 +52914,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlasyf_aa + + pure subroutine stdlib_wlasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) !> ZLASYF_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: @@ -52926,8 +52928,6 @@ module stdlib_linalg_lapack_w !> ZLASYF_RK is an auxiliary routine called by ZSYTRF_RK. It uses !> blocked code (calling Level 3 BLAS) to update the submatrix !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). - - pure subroutine stdlib_wlasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53360,6 +53360,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlasyf_rk + + pure subroutine stdlib_wlasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) !> ZLASYF_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: @@ -53372,8 +53374,6 @@ module stdlib_linalg_lapack_w !> ZLASYF_ROOK is an auxiliary routine called by ZSYTRF_ROOK. It uses !> blocked code (calling Level 3 BLAS) to update the submatrix !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). - - pure subroutine stdlib_wlasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53826,14 +53826,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlasyf_rook + + pure subroutine stdlib_wlat2c( uplo, n, a, lda, sa, ldsa, info ) !> ZLAT2C: converts a COMPLEX*16 triangular matrix, SA, to a COMPLEX !> triangular matrix, A. !> RMAX is the overflow for the SINGLE PRECISION arithmetic !> ZLAT2C checks that all the entries of A are between -RMAX and !> RMAX. If not the conversion is aborted and a flag is raised. !> This is an auxiliary routine so there is no argument checking. - - pure subroutine stdlib_wlat2c( uplo, n, a, lda, sa, ldsa, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53883,6 +53883,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlat2c + + pure subroutine stdlib_wlatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & !> ZLATBS: 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 @@ -53893,8 +53895,6 @@ module stdlib_linalg_lapack_w !> overflow, the Level 2 BLAS routine ZTBSV 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. - - pure subroutine stdlib_wlatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54439,6 +54439,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlatbs + + pure subroutine stdlib_wlatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) !> ZLATDF: 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 @@ -54447,8 +54449,6 @@ module stdlib_linalg_lapack_w !> The factorization of Z returned by ZGETC2 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. - - pure subroutine stdlib_wlatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54553,6 +54553,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlatdf + + pure subroutine stdlib_wlatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) !> ZLATPS: 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 @@ -54564,8 +54566,6 @@ module stdlib_linalg_lapack_w !> overflow, the Level 2 BLAS routine ZTPSV 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. - - pure subroutine stdlib_wlatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55104,6 +55104,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlatps + + pure subroutine stdlib_wlatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) !> ZLATRD: reduces NB rows and columns of a complex Hermitian matrix A to !> Hermitian tridiagonal form by a unitary similarity !> transformation Q**H * A * Q, and returns the matrices V and W which are @@ -55113,8 +55115,6 @@ module stdlib_linalg_lapack_w !> if UPLO = 'L', ZLATRD reduces the first NB rows and columns of a !> matrix, of which the lower triangle is supplied. !> This is an auxiliary routine called by ZHETRD. - - pure subroutine stdlib_wlatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55220,6 +55220,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlatrd + + pure subroutine stdlib_wlatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) !> ZLATRS: 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. Here A is an upper or lower @@ -55230,8 +55232,6 @@ module stdlib_linalg_lapack_w !> unscaled problem will not cause overflow, the Level 2 BLAS routine !> ZTRSV 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. - - pure subroutine stdlib_wlatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55749,12 +55749,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlatrs + + pure subroutine stdlib_wlatrz( m, n, l, a, lda, tau, work ) !> ZLATRZ: factors the M-by-(M+L) complex upper trapezoidal matrix !> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z by means !> of unitary transformations, where Z is an (M+L)-by-(M+L) unitary !> matrix and, R and A1 are M-by-M upper triangular matrices. - - pure subroutine stdlib_wlatrz( m, n, l, a, lda, tau, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55795,6 +55795,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlatrz + + pure subroutine stdlib_wlatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) !> ZLATSQR: computes a blocked Tall-Skinny QR factorization of !> a complex M-by-N matrix A for M >= N: !> A = Q * ( R ), @@ -55806,8 +55808,6 @@ module stdlib_linalg_lapack_w !> R is an upper-triangular N-by-N matrix, stored on exit in !> the elements on and above the diagonal of the array A. !> 0 is a (M-N)-by-N zero matrix, and is not stored. - - pure subroutine stdlib_wlatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -55880,6 +55880,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlatsqr + + pure subroutine stdlib_wlaunhr_col_getrfnp( m, n, a, lda, d, info ) !> ZLAUNHR_COL_GETRFNP: computes the modified LU factorization without !> pivoting of a complex general M-by-N matrix A. The factorization has !> the form: @@ -55913,8 +55915,6 @@ module stdlib_linalg_lapack_w !> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, !> E. Solomonik, J. Parallel Distrib. Comput., !> vol. 85, pp. 3-31, 2015. - - pure subroutine stdlib_wlaunhr_col_getrfnp( m, n, a, lda, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55974,6 +55974,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaunhr_col_getrfnp + + pure recursive subroutine stdlib_wlaunhr_col_getrfnp2( m, n, a, lda, d, info ) !> ZLAUNHR_COL_GETRFNP2: computes the modified LU factorization without !> pivoting of a complex general M-by-N matrix A. The factorization has !> the form: @@ -56022,8 +56024,6 @@ module stdlib_linalg_lapack_w !> [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. - - pure recursive subroutine stdlib_wlaunhr_col_getrfnp2( m, n, a, lda, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56110,6 +56110,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaunhr_col_getrfnp2 + + pure subroutine stdlib_wlauu2( uplo, n, a, lda, info ) !> ZLAUU2: computes the product U * U**H or L**H * L, where the triangular !> factor U or L is stored in the upper or lower triangular part of !> the array A. @@ -56118,8 +56120,6 @@ module stdlib_linalg_lapack_w !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, !> overwriting the factor L in A. !> This is the unblocked form of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_wlauu2( uplo, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56188,6 +56188,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlauu2 + + pure subroutine stdlib_wlauum( uplo, n, a, lda, info ) !> ZLAUUM: computes the product U * U**H or L**H * L, where the triangular !> factor U or L is stored in the upper or lower triangular part of !> the array A. @@ -56196,8 +56198,6 @@ module stdlib_linalg_lapack_w !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, !> overwriting the factor L in A. !> This is the blocked form of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_wlauum( uplo, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56272,14 +56272,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlauum + + pure subroutine stdlib_wpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,rwork, info ) !> ZPBCON: estimates the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite band matrix using !> the Cholesky factorization A = U**H*U or A = L*L**H computed by !> ZPBTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_wpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56376,6 +56376,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbcon + + pure subroutine stdlib_wpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) !> ZPBEQU: computes row and column scalings intended to equilibrate a !> Hermitian positive definite band matrix A and reduce its condition !> number (with respect to the two-norm). S contains the scale factors, @@ -56384,8 +56386,6 @@ module stdlib_linalg_lapack_w !> choice of S puts the condition number of B within a factor N of the !> smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_wpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56463,12 +56463,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbequ + + pure subroutine stdlib_wpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & !> ZPBRFS: improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite !> and banded, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_wpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56661,6 +56661,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbrfs + + pure subroutine stdlib_wpbstf( uplo, n, kd, ab, ldab, info ) !> ZPBSTF: computes a split Cholesky factorization of a complex !> Hermitian positive definite band matrix A. !> This routine is designed to be used in conjunction with ZHBGST. @@ -56670,8 +56672,6 @@ module stdlib_linalg_lapack_w !> ( M L ) !> where U is upper triangular of order m = (n+kd)/2, and L is lower !> triangular of order n-m. - - pure subroutine stdlib_wpbstf( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56795,6 +56795,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbstf + + pure subroutine stdlib_wpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) !> ZPBSV: computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite band matrix and X @@ -56806,8 +56808,6 @@ module stdlib_linalg_lapack_w !> triangular band matrix, with the same number of superdiagonals or !> subdiagonals as A. The factored form of A is then used to solve the !> system of equations A * X = B. - - pure subroutine stdlib_wpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56849,6 +56849,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbsv + + subroutine stdlib_wpbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & !> ZPBSVX: uses the Cholesky factorization A = U**H*U or A = L*L**H to !> compute the solution to a complex system of linear equations !> A * X = B, @@ -56856,8 +56858,6 @@ module stdlib_linalg_lapack_w !> and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_wpbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57006,6 +57006,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbsvx + + pure subroutine stdlib_wpbtf2( uplo, n, kd, ab, ldab, info ) !> ZPBTF2: computes the Cholesky factorization of a complex Hermitian !> positive definite band matrix A. !> The factorization has the form @@ -57014,8 +57016,6 @@ module stdlib_linalg_lapack_w !> where U is an upper triangular matrix, U**H is the conjugate transpose !> of U, and L is lower triangular. !> This is the unblocked version of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_wpbtf2( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57101,14 +57101,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbtf2 + + pure subroutine stdlib_wpbtrf( uplo, n, kd, ab, ldab, info ) !> ZPBTRF: computes the Cholesky factorization of a complex Hermitian !> positive definite band matrix A. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. - - pure subroutine stdlib_wpbtrf( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57301,11 +57301,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbtrf + + pure subroutine stdlib_wpbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) !> ZPBTRS: solves a system of linear equations A*X = B with a Hermitian !> positive definite band matrix A using the Cholesky factorization !> A = U**H *U or A = L*L**H computed by ZPBTRF. - - pure subroutine stdlib_wpbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57369,6 +57369,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbtrs + + pure subroutine stdlib_wpftrf( transr, uplo, n, a, info ) !> ZPFTRF: computes the Cholesky factorization of a complex Hermitian !> positive definite matrix A. !> The factorization has the form @@ -57376,8 +57378,6 @@ module stdlib_linalg_lapack_w !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the block version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_wpftrf( transr, uplo, n, a, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57545,11 +57545,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpftrf + + pure subroutine stdlib_wpftri( transr, uplo, n, a, info ) !> ZPFTRI: computes the inverse of a complex Hermitian positive definite !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H !> computed by ZPFTRF. - - pure subroutine stdlib_wpftri( transr, uplo, n, a, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57704,11 +57704,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpftri + + pure subroutine stdlib_wpftrs( transr, uplo, n, nrhs, a, b, ldb, info ) !> ZPFTRS: solves a system of linear equations A*X = B with a Hermitian !> positive definite matrix A using the Cholesky factorization !> A = U**H*U or A = L*L**H computed by ZPFTRF. - - pure subroutine stdlib_wpftrs( transr, uplo, n, nrhs, a, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57758,13 +57758,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpftrs + + pure subroutine stdlib_wpocon( uplo, n, a, lda, anorm, rcond, work, rwork,info ) !> ZPOCON: estimates the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite matrix using the !> Cholesky factorization A = U**H*U or A = L*L**H computed by ZPOTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_wpocon( uplo, n, a, lda, anorm, rcond, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57858,6 +57858,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpocon + + pure subroutine stdlib_wpoequ( n, a, lda, s, scond, amax, info ) !> ZPOEQU: computes row and column scalings intended to equilibrate a !> Hermitian positive definite matrix A and reduce its condition number !> (with respect to the two-norm). S contains the scale factors, @@ -57866,8 +57868,6 @@ module stdlib_linalg_lapack_w !> choice of S puts the condition number of B within a factor N of the !> smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_wpoequ( n, a, lda, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57932,6 +57932,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpoequ + + pure subroutine stdlib_wpoequb( n, a, lda, s, scond, amax, info ) !> ZPOEQUB: computes row and column scalings intended to equilibrate a !> Hermitian positive definite matrix A and reduce its condition number !> (with respect to the two-norm). S contains the scale factors, @@ -57945,8 +57947,6 @@ module stdlib_linalg_lapack_w !> these factors introduces no additional rounding errors. However, the !> scaled diagonal entries are no longer approximately 1 but lie !> between sqrt(radix) and 1/sqrt(radix). - - pure subroutine stdlib_wpoequb( n, a, lda, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58014,12 +58014,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpoequb + + pure subroutine stdlib_wporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & !> ZPORFS: improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite, !> and provides error bounds and backward error estimates for the !> solution. - - pure subroutine stdlib_wporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58207,6 +58207,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wporfs + + pure subroutine stdlib_wposv( uplo, n, nrhs, a, lda, b, ldb, info ) !> ZPOSV: computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite matrix and X and B @@ -58217,8 +58219,6 @@ module stdlib_linalg_lapack_w !> where U is an upper triangular matrix and L is a lower triangular !> matrix. The factored form of A is then used to solve the system of !> equations A * X = B. - - pure subroutine stdlib_wposv( uplo, n, nrhs, a, lda, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58258,6 +58258,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wposv + + subroutine stdlib_wposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & !> ZPOSVX: uses the Cholesky factorization A = U**H*U or A = L*L**H to !> compute the solution to a complex system of linear equations !> A * X = B, @@ -58265,8 +58267,6 @@ module stdlib_linalg_lapack_w !> are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_wposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & rcond, ferr, berr, work,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58402,6 +58402,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wposvx + + pure subroutine stdlib_wpotf2( uplo, n, a, lda, info ) !> ZPOTF2: computes the Cholesky factorization of a complex Hermitian !> positive definite matrix A. !> The factorization has the form @@ -58409,8 +58411,6 @@ module stdlib_linalg_lapack_w !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the unblocked version of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_wpotf2( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58496,6 +58496,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpotf2 + + pure subroutine stdlib_wpotrf( uplo, n, a, lda, info ) !> ZPOTRF: computes the Cholesky factorization of a complex Hermitian !> positive definite matrix A. !> The factorization has the form @@ -58503,8 +58505,6 @@ module stdlib_linalg_lapack_w !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the block version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_wpotrf( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58591,6 +58591,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpotrf + + pure recursive subroutine stdlib_wpotrf2( uplo, n, a, lda, info ) !> ZPOTRF2: computes the Cholesky factorization of a Hermitian !> positive definite matrix A using the recursive algorithm. !> The factorization has the form @@ -58604,8 +58606,6 @@ module stdlib_linalg_lapack_w !> [ A21 | A22 ] n2 = n-n1 !> The subroutine calls itself to factor A11. Update and scale A21 !> or A12, update A22 then call itself to factor A22. - - pure recursive subroutine stdlib_wpotrf2( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58692,11 +58692,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpotrf2 + + pure subroutine stdlib_wpotri( uplo, n, a, lda, info ) !> ZPOTRI: computes the inverse of a complex Hermitian positive definite !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H !> computed by ZPOTRF. - - pure subroutine stdlib_wpotri( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58733,11 +58733,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpotri + + pure subroutine stdlib_wpotrs( uplo, n, nrhs, a, lda, b, ldb, info ) !> ZPOTRS: solves a system of linear equations A*X = B with a Hermitian !> positive definite matrix A using the Cholesky factorization !> A = U**H * U or A = L * L**H computed by ZPOTRF. - - pure subroutine stdlib_wpotrs( uplo, n, nrhs, a, lda, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58795,14 +58795,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpotrs + + pure subroutine stdlib_wppcon( uplo, n, ap, anorm, rcond, work, rwork, info ) !> ZPPCON: estimates the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite packed matrix using !> the Cholesky factorization A = U**H*U or A = L*L**H computed by !> ZPPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_wppcon( uplo, n, ap, anorm, rcond, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58894,6 +58894,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wppcon + + pure subroutine stdlib_wppequ( uplo, n, ap, s, scond, amax, info ) !> ZPPEQU: computes row and column scalings intended to equilibrate a !> Hermitian positive definite matrix A in packed storage and reduce !> its condition number (with respect to the two-norm). S contains the @@ -58902,8 +58904,6 @@ module stdlib_linalg_lapack_w !> This choice of S puts the condition number of B within a factor N of !> the smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_wppequ( uplo, n, ap, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58987,12 +58987,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wppequ + + pure subroutine stdlib_wpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & !> ZPPRFS: improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite !> and packed, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_wpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59183,6 +59183,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpprfs + + pure subroutine stdlib_wppsv( uplo, n, nrhs, ap, b, ldb, info ) !> ZPPSV: computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite matrix stored in @@ -59193,8 +59195,6 @@ module stdlib_linalg_lapack_w !> where U is an upper triangular matrix and L is a lower triangular !> matrix. The factored form of A is then used to solve the system of !> equations A * X = B. - - pure subroutine stdlib_wppsv( uplo, n, nrhs, ap, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59232,6 +59232,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wppsv + + subroutine stdlib_wppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& !> ZPPSVX: uses the Cholesky factorization A = U**H * U or A = L * L**H to !> compute the solution to a complex system of linear equations !> A * X = B, @@ -59239,8 +59241,6 @@ module stdlib_linalg_lapack_w !> packed format and X and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_wppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59372,14 +59372,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wppsvx + + pure subroutine stdlib_wpptrf( uplo, n, ap, info ) !> ZPPTRF: computes the Cholesky factorization of a complex Hermitian !> positive definite matrix A stored in packed format. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. - - pure subroutine stdlib_wpptrf( uplo, n, ap, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59458,11 +59458,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpptrf + + pure subroutine stdlib_wpptri( uplo, n, ap, info ) !> ZPPTRI: computes the inverse of a complex Hermitian positive definite !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H !> computed by ZPPTRF. - - pure subroutine stdlib_wpptri( uplo, n, ap, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59522,11 +59522,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpptri + + pure subroutine stdlib_wpptrs( uplo, n, nrhs, ap, b, ldb, info ) !> ZPPTRS: solves a system of linear equations A*X = B with a Hermitian !> positive definite matrix A in packed storage using the Cholesky !> factorization A = U**H * U or A = L * L**H computed by ZPPTRF. - - pure subroutine stdlib_wpptrs( uplo, n, nrhs, ap, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59586,6 +59586,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpptrs + + pure subroutine stdlib_wpstf2( uplo, n, a, lda, piv, rank, tol, work, info ) !> ZPSTF2: computes the Cholesky factorization with complete !> pivoting of a complex Hermitian positive semidefinite matrix A. !> The factorization has the form @@ -59595,8 +59597,6 @@ module stdlib_linalg_lapack_w !> P is stored as vector PIV. !> This algorithm does not attempt to check that A is positive !> semidefinite. This version of the algorithm calls level 2 BLAS. - - pure subroutine stdlib_wpstf2( uplo, n, a, lda, piv, rank, tol, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59780,6 +59780,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpstf2 + + pure subroutine stdlib_wpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) !> ZPSTRF: computes the Cholesky factorization with complete !> pivoting of a complex Hermitian positive semidefinite matrix A. !> The factorization has the form @@ -59789,8 +59791,6 @@ module stdlib_linalg_lapack_w !> P is stored as vector PIV. !> This algorithm does not attempt to check that A is positive !> semidefinite. This version of the algorithm calls level 3 BLAS. - - pure subroutine stdlib_wpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60006,6 +60006,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpstrf + + pure subroutine stdlib_wptcon( n, d, e, anorm, rcond, rwork, info ) !> ZPTCON: computes the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite tridiagonal matrix !> using the factorization A = L*D*L**H or A = U**H*D*U computed by @@ -60013,8 +60015,6 @@ module stdlib_linalg_lapack_w !> Norm(inv(A)) is computed by a direct method, and the reciprocal of !> the condition number is computed as !> RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_wptcon( n, d, e, anorm, rcond, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60080,6 +60080,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wptcon + + pure subroutine stdlib_wpteqr( compz, n, d, e, z, ldz, work, info ) !> ZPTEQR: computes all eigenvalues and, optionally, eigenvectors of a !> symmetric positive definite tridiagonal matrix by first factoring the !> matrix using DPTTRF and then calling ZBDSQR to compute the singular @@ -60095,8 +60097,6 @@ module stdlib_linalg_lapack_w !> tridiagonal form, however, may preclude the possibility of obtaining !> high relative accuracy in the small eigenvalues of the original !> matrix, if these eigenvalues range over many orders of magnitude.) - - pure subroutine stdlib_wpteqr( compz, n, d, e, z, ldz, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60175,12 +60175,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpteqr + + pure subroutine stdlib_wptrfs( uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx,ferr, berr, work, & !> ZPTRFS: improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite !> and tridiagonal, and provides error bounds and backward error !> estimates for the solution. - - pure subroutine stdlib_wptrfs( uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx,ferr, berr, work, & rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60393,13 +60393,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wptrfs + + pure subroutine stdlib_wptsv( n, nrhs, d, e, b, ldb, info ) !> ZPTSV: computes the solution to a complex system of linear equations !> A*X = B, where A is an N-by-N Hermitian positive definite tridiagonal !> matrix, and X and B are N-by-NRHS matrices. !> A is factored as A = L*D*L**H, and the factored form of A is then !> used to solve the system of equations. - - pure subroutine stdlib_wptsv( n, nrhs, d, e, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60435,14 +60435,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wptsv + + pure subroutine stdlib_wptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& !> ZPTSVX: uses the factorization A = L*D*L**H to compute the solution !> to a complex system of linear equations A*X = B, where A is an !> N-by-N Hermitian positive definite tridiagonal matrix and X and B !> are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - pure subroutine stdlib_wptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60512,11 +60512,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wptsvx + + pure subroutine stdlib_wpttrf( n, d, e, info ) !> ZPTTRF: computes the L*D*L**H factorization of a complex Hermitian !> positive definite tridiagonal matrix A. The factorization may also !> be regarded as having the form A = U**H *D*U. - - pure subroutine stdlib_wpttrf( n, d, e, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60611,14 +60611,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpttrf + + pure subroutine stdlib_wpttrs( uplo, n, nrhs, d, e, b, ldb, info ) !> ZPTTRS: solves a tridiagonal system of the form !> A * X = B !> using the factorization A = U**H *D* U or A = L*D*L**H computed by ZPTTRF. !> D is a diagonal matrix specified in the vector D, U (or L) is a unit !> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in !> the vector E, and X and B are N by NRHS matrices. - - pure subroutine stdlib_wpttrs( uplo, n, nrhs, d, e, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60678,14 +60678,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpttrs + + pure subroutine stdlib_wptts2( iuplo, n, nrhs, d, e, b, ldb ) !> ZPTTS2: solves a tridiagonal system of the form !> A * X = B !> using the factorization A = U**H *D*U or A = L*D*L**H computed by ZPTTRF. !> D is a diagonal matrix specified in the vector D, U (or L) is a unit !> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in !> the vector E, and X and B are N by NRHS matrices. - - pure subroutine stdlib_wptts2( iuplo, n, nrhs, d, e, b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60778,10 +60778,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wptts2 - !> ZROT: applies a plane rotation, where the cos (C) is real and the - !> sin (S) is complex, and the vectors CX and CY are complex. pure subroutine stdlib_wrot( n, cx, incx, cy, incy, c, s ) + !> ZROT: applies a plane rotation, where the cos (C) is real and the + !> sin (S) is complex, and the vectors CX and CY are complex. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60823,13 +60823,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wrot + + pure subroutine stdlib_wspcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) !> ZSPCON: estimates the reciprocal of the condition number (in the !> 1-norm) of a complex symmetric packed matrix A using the !> factorization A = U*D*U**T or A = L*D*L**T computed by ZSPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_wspcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60904,12 +60904,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wspcon + + pure subroutine stdlib_wspmv( uplo, n, alpha, ap, x, incx, beta, y, incy ) !> ZSPMV: performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix, supplied in packed form. - - pure subroutine stdlib_wspmv( uplo, n, alpha, ap, x, incx, beta, y, incy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61062,12 +61062,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wspmv + + pure subroutine stdlib_wspr( uplo, n, alpha, x, incx, ap ) !> ZSPR: performs the symmetric rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a complex scalar, x is an n element vector and A is an !> n by n symmetric matrix, supplied in packed form. - - pure subroutine stdlib_wspr( uplo, n, alpha, x, incx, ap ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61182,12 +61182,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wspr + + pure subroutine stdlib_wsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& !> ZSPRFS: improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric indefinite !> and packed, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_wsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61379,6 +61379,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsprfs + + pure subroutine stdlib_wspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) !> ZSPSV: computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix stored in packed format and X @@ -61390,8 +61392,6 @@ module stdlib_linalg_lapack_w !> triangular matrices, D is symmetric 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. - - pure subroutine stdlib_wspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61430,14 +61430,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wspsv + + subroutine stdlib_wspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & !> ZSPSVX: uses the diagonal pivoting factorization A = U*D*U**T or !> A = L*D*L**T to compute the solution to a complex system of linear !> equations A * X = B, where A is an N-by-N symmetric matrix stored !> in packed format and X and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_wspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61508,6 +61508,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wspsvx + + pure subroutine stdlib_wsptrf( uplo, n, ap, ipiv, info ) !> ZSPTRF: computes the factorization of a complex symmetric matrix A !> stored in packed format using the Bunch-Kaufman diagonal pivoting !> method: @@ -61515,8 +61517,6 @@ module stdlib_linalg_lapack_w !> where U (or L) is a product of permutation and unit upper (lower) !> triangular matrices, and D is symmetric and block diagonal with !> 1-by-1 and 2-by-2 diagonal blocks. - - pure subroutine stdlib_wsptrf( uplo, n, ap, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61837,11 +61837,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsptrf + + pure subroutine stdlib_wsptri( uplo, n, ap, ipiv, work, info ) !> ZSPTRI: computes the inverse of a complex symmetric indefinite matrix !> A in packed storage using the factorization A = U*D*U**T or !> A = L*D*L**T computed by ZSPTRF. - - pure subroutine stdlib_wsptri( uplo, n, ap, ipiv, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62048,11 +62048,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsptri + + pure subroutine stdlib_wsptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) !> ZSPTRS: solves a system of linear equations A*X = B with a complex !> symmetric matrix A stored in packed format using the factorization !> A = U*D*U**T or A = L*D*L**T computed by ZSPTRF. - - pure subroutine stdlib_wsptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62268,6 +62268,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsptrs + + pure subroutine stdlib_wstedc( compz, n, d, e, z, ldz, work, lwork, rwork,lrwork, iwork, & !> ZSTEDC: computes all eigenvalues and, optionally, eigenvectors of a !> symmetric tridiagonal matrix using the divide and conquer method. !> The eigenvectors of a full or band complex Hermitian matrix can also @@ -62279,8 +62281,6 @@ module stdlib_linalg_lapack_w !> 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 DLAED3 for details. - - pure subroutine stdlib_wstedc( compz, n, d, e, z, ldz, work, lwork, rwork,lrwork, iwork, & liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62482,6 +62482,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wstedc + + pure subroutine stdlib_wstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & !> ZSTEGR: computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has !> a well defined set of pairwise different real eigenvalues, the corresponding @@ -62498,8 +62500,6 @@ module stdlib_linalg_lapack_w !> NaNs. Normal execution may create these exceptiona values and hence !> may abort due to a floating point exception in environments which !> do not conform to the IEEE-754 standard. - - pure subroutine stdlib_wstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62524,6 +62524,8 @@ module stdlib_linalg_lapack_w tryrac, work, lwork,iwork, liwork, info ) end subroutine stdlib_wstegr + + pure subroutine stdlib_wstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & !> ZSTEIN: computes the eigenvectors of a real symmetric tridiagonal !> matrix T corresponding to specified eigenvalues, using inverse !> iteration. @@ -62533,8 +62535,6 @@ module stdlib_linalg_lapack_w !> array, which may be passed to ZUNMTR or ZUPMTR for back !> transformation to the eigenvectors of a complex Hermitian matrix !> which was reduced to tridiagonal form. - - pure subroutine stdlib_wstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62734,6 +62734,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wstein + + pure subroutine stdlib_wstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & !> ZSTEMR: computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has !> a well defined set of pairwise different real eigenvalues, the corresponding @@ -62793,8 +62795,6 @@ module stdlib_linalg_lapack_w !> Since LAPACK drivers overwrite the matrix data with the eigenvectors, !> ZSTEMR accepts complex workspace to facilitate interoperability !> with ZUNMTR or ZUPMTR. - - pure subroutine stdlib_wstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63168,13 +63168,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wstemr + + pure subroutine stdlib_wsteqr( compz, n, d, e, z, ldz, work, info ) !> ZSTEQR: computes all eigenvalues and, optionally, eigenvectors of a !> symmetric tridiagonal matrix using the implicit QL or QR method. !> The eigenvectors of a full or band complex Hermitian matrix can also !> be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this !> matrix to tridiagonal form. - - pure subroutine stdlib_wsteqr( compz, n, d, e, z, ldz, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63488,13 +63488,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsteqr + + pure subroutine stdlib_wsycon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) !> ZSYCON: estimates the reciprocal of the condition number (in the !> 1-norm) of a complex symmetric matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by ZSYTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_wsycon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63569,13 +63569,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsycon + + pure subroutine stdlib_wsycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) !> ZSYCON_ROOK: estimates the reciprocal of the condition number (in the !> 1-norm) of a complex symmetric matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by ZSYTRF_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))). - - pure subroutine stdlib_wsycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63651,11 +63651,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsycon_rook + + pure subroutine stdlib_wsyconv( uplo, way, n, a, lda, ipiv, e, info ) !> ZSYCONV: converts A given by ZHETRF into L and D or vice-versa. !> Get nondiagonal elements of D (returned in workspace) and !> apply or reverse permutation done in TRF. - - pure subroutine stdlib_wsyconv( uplo, way, n, a, lda, ipiv, e, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63856,6 +63856,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsyconv + + pure subroutine stdlib_wsyconvf( uplo, way, n, a, lda, e, ipiv, info ) !> If parameter WAY = 'C': !> ZSYCONVF: converts the factorization output format used in !> ZSYTRF provided on entry in parameter A into the factorization @@ -63873,8 +63875,6 @@ module stdlib_linalg_lapack_w !> (or ZSYTRF_BK) into the format used in ZSYTRF. !> ZSYCONVF can also convert in Hermitian matrix case, i.e. between !> formats used in ZHETRF and ZHETRF_RK (or ZHETRF_BK). - - pure subroutine stdlib_wsyconvf( uplo, way, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64113,6 +64113,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsyconvf + + pure subroutine stdlib_wsyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) !> If parameter WAY = 'C': !> ZSYCONVF_ROOK: converts the factorization output format used in !> ZSYTRF_ROOK provided on entry in parameter A into the factorization @@ -64128,8 +64130,6 @@ module stdlib_linalg_lapack_w !> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted. !> ZSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between !> formats used in ZHETRF_ROOK and ZHETRF_RK (or ZHETRF_BK). - - pure subroutine stdlib_wsyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64368,6 +64368,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsyconvf_rook + + pure subroutine stdlib_wsyequb( uplo, n, a, lda, s, scond, amax, work, info ) !> ZSYEQUB: computes row and column scalings intended to equilibrate a !> symmetric matrix A (with respect to the Euclidean norm) and reduce !> its condition number. The scale factors S are computed by the BIN @@ -64375,8 +64377,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wsyequb( uplo, n, a, lda, s, scond, amax, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64550,12 +64550,12 @@ module stdlib_linalg_lapack_w scond = max( smin, smlnum ) / min( smax, bignum ) end subroutine stdlib_wsyequb + + pure subroutine stdlib_wsymv( uplo, n, alpha, a, lda, x, incx, beta, y, incy ) !> ZSYMV: performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix. - - pure subroutine stdlib_wsymv( uplo, n, alpha, a, lda, x, incx, beta, y, incy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64704,12 +64704,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsymv + + pure subroutine stdlib_wsyr( uplo, n, alpha, x, incx, a, lda ) !> ZSYR: performs the symmetric rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a complex scalar, x is an n element vector and A is an !> n by n symmetric matrix. - - pure subroutine stdlib_wsyr( uplo, n, alpha, x, incx, a, lda ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64808,11 +64808,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsyr + + pure subroutine stdlib_wsyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & !> ZSYRFS: improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric indefinite, and !> provides error bounds and backward error estimates for the solution. - - pure subroutine stdlib_wsyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65001,6 +65001,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsyrfs + + pure subroutine stdlib_wsysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) !> ZSYSV: computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS @@ -65012,8 +65014,6 @@ module stdlib_linalg_lapack_w !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_wsysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65079,6 +65079,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsysv + + pure subroutine stdlib_wsysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) !> ZSYSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS @@ -65089,8 +65091,6 @@ module stdlib_linalg_lapack_w !> where U (or L) is a product of permutation and unit upper (lower) !> triangular matrices, and T is symmetric tridiagonal. The factored !> form of A is then used to solve the system of equations A * X = B. - - pure subroutine stdlib_wsysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65151,6 +65151,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsysv_aa + + pure subroutine stdlib_wsysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) !> ZSYSV_RK: computes the solution to a complex system of linear !> equations A * X = B, where A is an N-by-N symmetric matrix !> and X and B are N-by-NRHS matrices. @@ -65165,8 +65167,6 @@ module stdlib_linalg_lapack_w !> ZSYTRF_RK is called to compute the factorization of a complex !> symmetric matrix. The factored form of A is then used to solve !> the system of equations A * X = B by calling BLAS3 routine ZSYTRS_3. - - pure subroutine stdlib_wsysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65228,6 +65228,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsysv_rk + + pure subroutine stdlib_wsysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) !> ZSYSV_ROOK: computes the solution to a complex system of linear !> equations !> A * X = B, @@ -65244,8 +65246,6 @@ module stdlib_linalg_lapack_w !> pivoting method. !> The factored form of A is then used to solve the system !> of equations A * X = B by calling ZSYTRS_ROOK. - - pure subroutine stdlib_wsysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65307,14 +65307,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsysv_rook + + subroutine stdlib_wsysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & !> ZSYSVX: uses the diagonal pivoting factorization to compute the !> solution to a complex system of linear equations A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS !> matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_wsysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & ferr, berr, work, lwork,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65404,10 +65404,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsysvx - !> ZSYSWAPR: applies an elementary permutation on the rows and the columns of - !> a symmetric matrix. pure subroutine stdlib_wsyswapr( uplo, n, a, lda, i1, i2) + !> ZSYSWAPR: applies an elementary permutation on the rows and the columns of + !> a symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65472,6 +65472,8 @@ module stdlib_linalg_lapack_w endif end subroutine stdlib_wsyswapr + + pure subroutine stdlib_wsytf2( uplo, n, a, lda, ipiv, info ) !> ZSYTF2: computes the factorization of a complex symmetric matrix A !> using the Bunch-Kaufman diagonal pivoting method: !> A = U*D*U**T or A = L*D*L**T @@ -65479,8 +65481,6 @@ module stdlib_linalg_lapack_w !> triangular matrices, U**T is the transpose of U, and D is symmetric 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. - - pure subroutine stdlib_wsytf2( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65763,6 +65763,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytf2 + + pure subroutine stdlib_wsytf2_rk( uplo, n, a, lda, e, ipiv, info ) !> ZSYTF2_RK: computes the factorization of a complex symmetric matrix A !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), @@ -65772,8 +65774,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wsytf2_rk( uplo, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -66220,6 +66220,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytf2_rk + + pure subroutine stdlib_wsytf2_rook( uplo, n, a, lda, ipiv, info ) !> ZSYTF2_ROOK: computes the factorization of a complex symmetric matrix A !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: !> A = U*D*U**T or A = L*D*L**T @@ -66227,8 +66229,6 @@ module stdlib_linalg_lapack_w !> triangular matrices, U**T is the transpose of U, and D is symmetric 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. - - pure subroutine stdlib_wsytf2_rook( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -66636,6 +66636,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytf2_rook + + pure subroutine stdlib_wsytrf( uplo, n, a, lda, ipiv, work, lwork, info ) !> ZSYTRF: computes the factorization of a complex symmetric matrix A !> using the Bunch-Kaufman diagonal pivoting method. The form of the !> factorization is @@ -66644,8 +66646,6 @@ module stdlib_linalg_lapack_w !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_wsytrf( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -66762,14 +66762,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrf + + pure subroutine stdlib_wsytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) !> ZSYTRF_AA: computes the factorization of a complex symmetric matrix A !> using the Aasen's algorithm. The form of the factorization is !> A = U**T*T*U or A = L*T*L**T !> where U (or L) is a product of permutation and unit upper (lower) !> triangular matrices, and T is a complex symmetric tridiagonal matrix. !> This is the blocked version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_wsytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -66987,6 +66987,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrf_aa + + pure subroutine stdlib_wsytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) !> ZSYTRF_RK: computes the factorization of a complex symmetric matrix A !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), @@ -66996,8 +66998,6 @@ module stdlib_linalg_lapack_w !> 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. - - pure subroutine stdlib_wsytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67153,6 +67153,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrf_rk + + pure subroutine stdlib_wsytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) !> ZSYTRF_ROOK: computes the factorization of a complex symmetric matrix A !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. !> The form of the factorization is @@ -67161,8 +67163,6 @@ module stdlib_linalg_lapack_w !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_wsytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67281,11 +67281,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrf_rook + + pure subroutine stdlib_wsytri( uplo, n, a, lda, ipiv, work, info ) !> ZSYTRI: computes the inverse of a complex symmetric indefinite matrix !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by !> ZSYTRF. - - pure subroutine stdlib_wsytri( uplo, n, a, lda, ipiv, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67469,11 +67469,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytri + + pure subroutine stdlib_wsytri_rook( uplo, n, a, lda, ipiv, work, info ) !> ZSYTRI_ROOK: computes the inverse of a complex symmetric !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T !> computed by ZSYTRF_ROOK. - - pure subroutine stdlib_wsytri_rook( uplo, n, a, lda, ipiv, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67697,11 +67697,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytri_rook + + pure subroutine stdlib_wsytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) !> ZSYTRS: solves a system of linear equations A*X = B with a complex !> symmetric matrix A using the factorization A = U*D*U**T or !> A = L*D*L**T computed by ZSYTRF. - - pure subroutine stdlib_wsytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67907,11 +67907,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrs + + pure subroutine stdlib_wsytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) !> ZSYTRS2: solves a system of linear equations A*X = B with a complex !> symmetric matrix A using the factorization A = U*D*U**T or !> A = L*D*L**T computed by ZSYTRF and converted by ZSYCONV. - - pure subroutine stdlib_wsytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -68085,6 +68085,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrs2 + + pure subroutine stdlib_wsytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) !> ZSYTRS_3: solves a system of linear equations A * X = B with a complex !> symmetric matrix A using the factorization computed !> by ZSYTRF_RK or ZSYTRF_BK: @@ -68094,8 +68096,6 @@ module stdlib_linalg_lapack_w !> matrix, P**T is the transpose of P, and D is symmetric and block !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. !> This algorithm is using Level 3 BLAS. - - pure subroutine stdlib_wsytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -68242,11 +68242,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrs_3 + + pure subroutine stdlib_wsytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) !> ZSYTRS_AA: solves a system of linear equations A*X = B with a complex !> symmetric matrix A using the factorization A = U**T*T*U or !> A = L*T*L**T computed by ZSYTRF_AA. - - pure subroutine stdlib_wsytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68361,11 +68361,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrs_aa + + pure subroutine stdlib_wsytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) !> ZSYTRS_ROOK: solves a system of linear equations A*X = B with !> a complex symmetric matrix A using the factorization A = U*D*U**T or !> A = L*D*L**T computed by ZSYTRF_ROOK. - - pure subroutine stdlib_wsytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -68583,14 +68583,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrs_rook + + subroutine stdlib_wtbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,rwork, info ) !> ZTBCON: estimates the reciprocal of the condition number of a !> triangular band matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_wtbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68692,14 +68692,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtbcon + + pure subroutine stdlib_wtbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& !> ZTBRFS: provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular band !> coefficient matrix. !> The solution matrix X must be computed by ZTBTRS or some other !> means before entering this routine. ZTBRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_wtbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68935,12 +68935,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtbrfs + + pure subroutine stdlib_wtbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) !> ZTBTRS: solves a triangular system of the form !> A * X = B, A**T * X = B, or A**H * X = B, !> where A is a triangular band matrix of order N, and B is an !> N-by-NRHS matrix. A check is made to verify that A is nonsingular. - - pure subroutine stdlib_wtbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69008,6 +69008,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtbtrs + + pure subroutine stdlib_wtfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) !> Level 3 BLAS like routine for A in RFP Format. !> ZTFSM: solves the matrix equation !> op( A )*X = alpha*B or X*op( A ) = alpha*B @@ -69016,8 +69018,6 @@ module stdlib_linalg_lapack_w !> op( A ) = A or op( A ) = A**H. !> A is in Rectangular Full Packed (RFP) Format. !> The matrix X is overwritten on B. - - pure subroutine stdlib_wtfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69510,11 +69510,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtfsm + + pure subroutine stdlib_wtftri( transr, uplo, diag, n, a, info ) !> ZTFTRI: computes the inverse of a triangular matrix A stored in RFP !> format. !> This is a Level 3 BLAS version of the algorithm. - - pure subroutine stdlib_wtftri( transr, uplo, diag, n, a, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -69693,10 +69693,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtftri - !> ZTFTTP: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard packed format (TP). pure subroutine stdlib_wtfttp( transr, uplo, n, arf, ap, info ) + !> ZTFTTP: copies a triangular matrix A from rectangular full packed + !> format (TF) to standard packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -69952,10 +69952,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtfttp - !> ZTFTTR: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard full format (TR). pure subroutine stdlib_wtfttr( transr, uplo, n, arf, a, lda, info ) + !> ZTFTTR: copies a triangular matrix A from rectangular full packed + !> format (TF) to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -70202,6 +70202,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtfttr + + pure subroutine stdlib_wtgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & !> ZTGEVC: computes some or all of the right and/or left eigenvectors of !> a pair of complex matrices (S,P), where S and P are upper triangular. !> Matrix pairs of this type are produced by the generalized Schur @@ -70220,8 +70222,6 @@ module stdlib_linalg_lapack_w !> If Q and Z are the unitary factors from the generalized Schur !> factorization of a matrix pair (A,B), then Z*X and Q*Y !> are the matrices of right and left eigenvectors of (A,B). - - pure subroutine stdlib_wtgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & mm, m, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70615,6 +70615,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgevc + + pure subroutine stdlib_wtgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, info ) !> ZTGEX2: swaps adjacent diagonal 1 by 1 blocks (A11,B11) and (A22,B22) !> in an upper triangular matrix pair (A, B) by an unitary equivalence !> transformation. @@ -70624,8 +70626,6 @@ module stdlib_linalg_lapack_w !> updated. !> Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H !> Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H - - pure subroutine stdlib_wtgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70757,6 +70757,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgex2 + + pure subroutine stdlib_wtgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & !> ZTGEXC: reorders the generalized Schur decomposition of a complex !> matrix pair (A,B), using an unitary equivalence transformation !> (A, B) := Q * (A, B) * Z**H, so that the diagonal block of (A, B) with @@ -70767,8 +70769,6 @@ module stdlib_linalg_lapack_w !> updated. !> Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H !> Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H - - pure subroutine stdlib_wtgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70841,6 +70841,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgexc + + pure subroutine stdlib_wtgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alpha, beta, q, & !> ZTGSEN: reorders the generalized Schur decomposition of a complex !> matrix pair (A, B) (in terms of an unitary equivalence trans- !> formation Q**H * (A, B) * Z), so that a selected cluster of eigenvalues @@ -70859,8 +70861,6 @@ module stdlib_linalg_lapack_w !> the selected cluster and the eigenvalues outside the cluster, resp., !> and norms of "projections" onto left and right eigenspaces w.r.t. !> the selected cluster in the (1,1)-block. - - pure subroutine stdlib_wtgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alpha, beta, q, & ldq, z, ldz, m, pl, pr, dif,work, lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71120,6 +71120,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgsen + + pure subroutine stdlib_wtgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & !> ZTGSJA: computes the generalized singular value decomposition (GSVD) !> of two complex upper triangular (or trapezoidal) matrices A and B. !> On entry, it is assumed that matrices A and B have the following @@ -71182,8 +71184,6 @@ module stdlib_linalg_lapack_w !> The computation of the unitary transformation matrices U, V or Q !> is optional. These matrices may either be formed explicitly, or they !> may be postmultiplied into input matrices U1, V1, or Q1. - - pure subroutine stdlib_wtgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & alpha, beta, u, ldu, v, ldv,q, ldq, work, ncycle, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71369,12 +71369,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgsja + + pure subroutine stdlib_wtgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & !> ZTGSNA: estimates reciprocal condition numbers for specified !> eigenvalues and/or eigenvectors of a matrix pair (A, B). !> (A, B) must be in generalized Schur canonical form, that is, A and !> B are both upper triangular. - - pure subroutine stdlib_wtgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & dif, mm, m, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71526,6 +71526,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgsna + + pure subroutine stdlib_wtgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & !> ZTGSY2: solves the generalized Sylvester equation !> A * R - L * B = scale * C (1) !> D * R - L * E = scale * F @@ -71551,8 +71553,6 @@ module stdlib_linalg_lapack_w !> of an upper bound on the separation between to matrix pairs. Then !> the input (A, D), (B, E) are sub-pencils of two matrix pairs in !> ZTGSYL. - - pure subroutine stdlib_wtgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & ldf, scale, rdsum, rdscal,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71716,6 +71716,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgsy2 + + pure subroutine stdlib_wtgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & !> ZTGSYL: solves the generalized Sylvester equation: !> A * R - L * B = scale * C (1) !> D * R - L * E = scale * F @@ -71743,8 +71745,6 @@ module stdlib_linalg_lapack_w !> Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the !> reciprocal of the smallest singular value of Z. !> This is a level-3 BLAS algorithm. - - pure subroutine stdlib_wtgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72066,14 +72066,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgsyl + + subroutine stdlib_wtpcon( norm, uplo, diag, n, ap, rcond, work, rwork,info ) !> ZTPCON: estimates the reciprocal of the condition number of a packed !> triangular matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_wtpcon( norm, uplo, diag, n, ap, rcond, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72170,12 +72170,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtpcon + + pure subroutine stdlib_wtplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) !> ZTPLQT: computes a blocked LQ factorization of a complex !> "triangular-pentagonal" matrix C, which is composed of a !> triangular block A and pentagonal block B, using the compact !> WY representation for Q. - - pure subroutine stdlib_wtplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72232,11 +72232,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtplqt + + pure subroutine stdlib_wtplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) !> ZTPLQT2: computes a LQ a factorization of a complex "triangular-pentagonal" !> matrix C, which is composed of a triangular block A and pentagonal block B, !> using the compact WY representation for Q. - - pure subroutine stdlib_wtplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72348,11 +72348,11 @@ module stdlib_linalg_lapack_w end do end subroutine stdlib_wtplqt2 + + pure subroutine stdlib_wtpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, ldb, & !> ZTPMLQT: applies a complex unitary matrix Q obtained from a !> "triangular-pentagonal" complex block reflector H to a general !> complex matrix C, which consists of two blocks A and B. - - pure subroutine stdlib_wtpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, ldb, & work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72466,11 +72466,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtpmlqt + + pure subroutine stdlib_wtpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, ldb, & !> ZTPMQRT: applies a complex orthogonal matrix Q obtained from a !> "triangular-pentagonal" complex block reflector H to a general !> complex matrix C, which consists of two blocks A and B. - - pure subroutine stdlib_wtpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, ldb, & work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72586,12 +72586,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtpmqrt + + pure subroutine stdlib_wtpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) !> ZTPQRT: computes a blocked QR factorization of a complex !> "triangular-pentagonal" matrix C, which is composed of a !> triangular block A and pentagonal block B, using the compact !> WY representation for Q. - - pure subroutine stdlib_wtpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72648,11 +72648,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtpqrt + + pure subroutine stdlib_wtpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) !> ZTPQRT2: computes a QR factorization of a complex "triangular-pentagonal" !> matrix C, which is composed of a triangular block A and pentagonal block B, !> using the compact WY representation for Q. - - pure subroutine stdlib_wtpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72739,11 +72739,11 @@ module stdlib_linalg_lapack_w end do end subroutine stdlib_wtpqrt2 + + pure subroutine stdlib_wtprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & !> ZTPRFB: applies a complex "triangular-pentagonal" block reflector H or its !> conjugate transpose H**H to a complex matrix C, which is composed of two !> blocks A and B, either from the left or right. - - pure subroutine stdlib_wtprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & lda, b, ldb, work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73159,14 +73159,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtprfb + + pure subroutine stdlib_wtprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & !> ZTPRFS: provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular packed !> coefficient matrix. !> The solution matrix X must be computed by ZTPTRS or some other !> means before entering this routine. ZTPRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_wtprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73410,10 +73410,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtprfs - !> ZTPTRI: computes the inverse of a complex upper or lower triangular - !> matrix A stored in packed format. pure subroutine stdlib_wtptri( uplo, diag, n, ap, info ) + !> ZTPTRI: computes the inverse of a complex upper or lower triangular + !> matrix A stored in packed format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73500,13 +73500,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtptri + + pure subroutine stdlib_wtptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) !> ZTPTRS: solves a triangular system of the form !> A * X = B, A**T * X = B, or A**H * X = B, !> where A is a triangular matrix of order N stored in packed format, !> and B is an N-by-NRHS matrix. A check is made to verify that A is !> nonsingular. - - pure subroutine stdlib_wtptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73573,10 +73573,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtptrs - !> ZTPTTF: copies a triangular matrix A from standard packed format (TP) - !> to rectangular full packed format (TF). pure subroutine stdlib_wtpttf( transr, uplo, n, ap, arf, info ) + !> ZTPTTF: copies a triangular matrix A from standard packed format (TP) + !> to rectangular full packed format (TF). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73831,10 +73831,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtpttf - !> ZTPTTR: copies a triangular matrix A from standard packed format (TP) - !> to standard full format (TR). pure subroutine stdlib_wtpttr( uplo, n, ap, a, lda, info ) + !> ZTPTTR: copies a triangular matrix A from standard packed format (TP) + !> to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73885,14 +73885,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtpttr + + subroutine stdlib_wtrcon( norm, uplo, diag, n, a, lda, rcond, work,rwork, info ) !> ZTRCON: estimates the reciprocal of the condition number of a !> triangular matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_wtrcon( norm, uplo, diag, n, a, lda, rcond, work,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73991,6 +73991,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrcon + + pure subroutine stdlib_wtrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & !> ZTREVC: computes some or all of the right and/or left eigenvectors of !> a complex upper triangular matrix T. !> Matrices of this type are produced by the Schur factorization of @@ -74006,8 +74008,6 @@ module stdlib_linalg_lapack_w !> input matrix. If Q is the unitary factor that reduces a matrix A to !> Schur form T, then Q*X and Q*Y are the matrices of right and left !> eigenvectors of A. - - pure subroutine stdlib_wtrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74191,6 +74191,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrevc + + pure subroutine stdlib_wtrevc3( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & !> ZTREVC3: computes some or all of the right and/or left eigenvectors of !> a complex upper triangular matrix T. !> Matrices of this type are produced by the Schur factorization of @@ -74207,8 +74209,6 @@ module stdlib_linalg_lapack_w !> Schur form T, then Q*X and Q*Y are the matrices of right and left !> eigenvectors of A. !> This uses a Level 3 BLAS version of the back transformation. - - pure subroutine stdlib_wtrevc3( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & work, lwork, rwork, lrwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74488,14 +74488,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrevc3 + + pure subroutine stdlib_wtrexc( compq, n, t, ldt, q, ldq, ifst, ilst, info ) !> ZTREXC: reorders the Schur factorization of a complex matrix !> A = Q*T*Q**H, so that the diagonal element of T with row index IFST !> is moved to row ILST. !> The Schur form T is reordered by a unitary similarity transformation !> Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by !> postmultplying it with Z. - - pure subroutine stdlib_wtrexc( compq, n, t, ldt, q, ldq, ifst, ilst, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -74567,14 +74567,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrexc + + pure subroutine stdlib_wtrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& !> ZTRRFS: provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular !> coefficient matrix. !> The solution matrix X must be computed by ZTRTRS or some other !> means before entering this routine. ZTRRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_wtrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74808,6 +74808,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrrfs + + subroutine stdlib_wtrsen( job, compq, select, n, t, ldt, q, ldq, w, m, s,sep, work, lwork, & !> ZTRSEN: reorders the Schur factorization of a complex matrix !> A = Q*T*Q**H, so that a selected cluster of eigenvalues appears in !> the leading positions on the diagonal of the upper triangular matrix @@ -74815,8 +74817,6 @@ module stdlib_linalg_lapack_w !> corresponding right invariant subspace. !> Optionally the routine computes the reciprocal condition numbers of !> the cluster of eigenvalues and/or the invariant subspace. - - subroutine stdlib_wtrsen( job, compq, select, n, t, ldt, q, ldq, w, m, s,sep, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74945,11 +74945,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrsen + + pure subroutine stdlib_wtrsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm,& !> ZTRSNA: estimates reciprocal condition numbers for specified !> eigenvalues and/or right eigenvectors of a complex upper triangular !> matrix T (or of any matrix Q*T*Q**H with Q unitary). - - pure subroutine stdlib_wtrsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm,& m, work, ldwork, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75094,6 +75094,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrsna + + subroutine stdlib_wtrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) !> ZTRSYL: solves the complex Sylvester matrix equation: !> op(A)*X + X*op(B) = scale*C or !> op(A)*X - X*op(B) = scale*C, @@ -75101,8 +75103,6 @@ module stdlib_linalg_lapack_w !> M-by-M and B is N-by-N; the right hand side C and the solution X are !> M-by-N; and scale is an output scale factor, set <= 1 to avoid !> overflow in X. - - subroutine stdlib_wtrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75320,11 +75320,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrsyl + + pure subroutine stdlib_wtrti2( uplo, diag, n, a, lda, info ) !> ZTRTI2: computes the inverse of a complex upper or lower triangular !> matrix. !> This is the Level 2 BLAS version of the algorithm. - - pure subroutine stdlib_wtrti2( uplo, diag, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -75394,11 +75394,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrti2 + + pure subroutine stdlib_wtrtri( uplo, diag, n, a, lda, info ) !> ZTRTRI: computes the inverse of a complex upper or lower triangular !> matrix A. !> This is the Level 3 BLAS version of the algorithm. - - pure subroutine stdlib_wtrtri( uplo, diag, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -75481,12 +75481,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrtri + + pure subroutine stdlib_wtrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) !> ZTRTRS: solves a triangular system of the form !> A * X = B, A**T * X = B, or A**H * X = B, !> where A is a triangular matrix of order N, and B is an N-by-NRHS !> matrix. A check is made to verify that A is nonsingular. - - pure subroutine stdlib_wtrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -75541,10 +75541,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrtrs - !> ZTRTTF: copies a triangular matrix A from standard full format (TR) - !> to rectangular full packed format (TF) . pure subroutine stdlib_wtrttf( transr, uplo, n, a, lda, arf, info ) + !> ZTRTTF: copies a triangular matrix A from standard full format (TR) + !> to rectangular full packed format (TF) . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -75790,10 +75790,10 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrttf - !> ZTRTTP: copies a triangular matrix A from full format (TR) to standard - !> packed format (TP). pure subroutine stdlib_wtrttp( uplo, n, a, lda, ap, info ) + !> ZTRTTP: copies a triangular matrix A from full format (TR) to standard + !> packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -75844,14 +75844,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrttp + + pure subroutine stdlib_wtzrzf( m, n, a, lda, tau, work, lwork, info ) !> ZTZRZF: reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A !> to upper triangular form by means of unitary transformations. !> The upper trapezoidal matrix A is factored as !> A = ( R 0 ) * Z, !> where Z is an N-by-N unitary matrix and R is an M-by-M upper !> triangular matrix. - - pure subroutine stdlib_wtzrzf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -75960,6 +75960,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtzrzf + + subroutine stdlib_wunbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & !> ZUNBDB: simultaneously bidiagonalizes the blocks of an M-by-M !> partitioned unitary matrix X: !> [ B11 | B12 0 0 ] @@ -75976,8 +75978,6 @@ module stdlib_linalg_lapack_w !> represented implicitly by Householder vectors. !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_wunbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76283,6 +76283,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunbdb + + subroutine stdlib_wunbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & !> ZUNBDB1: simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] @@ -76298,8 +76300,6 @@ module stdlib_linalg_lapack_w !> Householder vectors. !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by !> angles THETA, PHI. - - subroutine stdlib_wunbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76388,6 +76388,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunbdb1 + + subroutine stdlib_wunbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & !> ZUNBDB2: simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] @@ -76403,8 +76405,6 @@ module stdlib_linalg_lapack_w !> Householder vectors. !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by !> angles THETA, PHI. - - subroutine stdlib_wunbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76503,6 +76503,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunbdb2 + + subroutine stdlib_wunbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & !> ZUNBDB3: simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] @@ -76518,8 +76520,6 @@ module stdlib_linalg_lapack_w !> Householder vectors. !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_wunbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76617,6 +76617,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunbdb3 + + subroutine stdlib_wunbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & !> ZUNBDB4: simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] @@ -76632,8 +76634,6 @@ module stdlib_linalg_lapack_w !> Householder vectors. !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_wunbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76766,6 +76766,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunbdb4 + + pure subroutine stdlib_wunbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & !> ZUNBDB5: orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] @@ -76777,8 +76779,6 @@ module stdlib_linalg_lapack_w !> criterion, then some other vector from the orthogonal complement !> is returned. This vector is chosen in an arbitrary but deterministic !> way. - - pure subroutine stdlib_wunbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76865,6 +76865,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunbdb5 + + pure subroutine stdlib_wunbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & !> ZUNBDB6: orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] @@ -76874,8 +76876,6 @@ module stdlib_linalg_lapack_w !> The columns of Q must be orthonormal. !> If the projection is zero according to Kahan's "twice is enough" !> criterion, then the zero vector is returned. - - pure subroutine stdlib_wunbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76993,6 +76993,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunbdb6 + + recursive subroutine stdlib_wuncsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & !> ZUNCSD: computes the CS decomposition of an M-by-M partitioned !> unitary matrix X: !> [ I 0 0 | 0 0 0 ] @@ -77006,8 +77008,6 @@ module stdlib_linalg_lapack_w !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in !> which R = MIN(P,M-P,Q,M-Q). - - recursive subroutine stdlib_wuncsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, ldv1t, v2t,ldv2t, & work, lwork, rwork, lrwork,iwork, info ) ! -- lapack computational routine -- @@ -77283,6 +77283,8 @@ module stdlib_linalg_lapack_w ! end stdlib_wuncsd end subroutine stdlib_wuncsd + + subroutine stdlib_wuncsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & !> ZUNCSD2BY1: computes the CS decomposition of an M-by-Q matrix X with !> orthonormal columns that has been partitioned into a 2-by-1 block !> structure: @@ -77298,8 +77300,6 @@ module stdlib_linalg_lapack_w !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). - - subroutine stdlib_wuncsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, rwork, lrwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77720,13 +77720,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wuncsd2by1 + + pure subroutine stdlib_wung2l( m, n, k, a, lda, tau, work, info ) !> ZUNG2L: generates an m by n complex matrix Q with orthonormal columns, !> which is defined as the last n columns of a product of k elementary !> reflectors of order m !> Q = H(k) . . . H(2) H(1) !> as returned by ZGEQLF. - - pure subroutine stdlib_wung2l( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -77784,13 +77784,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wung2l + + pure subroutine stdlib_wung2r( m, n, k, a, lda, tau, work, info ) !> ZUNG2R: generates an m by n complex matrix Q with orthonormal columns, !> which is defined as the first n columns of a product of k elementary !> reflectors of order m !> Q = H(1) H(2) . . . H(k) !> as returned by ZGEQRF. - - pure subroutine stdlib_wung2r( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -77849,6 +77849,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wung2r + + pure subroutine stdlib_wungbr( vect, m, n, k, a, lda, tau, work, lwork, info ) !> ZUNGBR: generates one of the complex unitary matrices Q or P**H !> determined by ZGEBRD when reducing a complex matrix A to bidiagonal !> form: A = Q * B * P**H. Q and P**H are defined as products of @@ -77865,8 +77867,6 @@ module stdlib_linalg_lapack_w !> rows of P**H, where n >= m >= k; !> if k >= n, P**H = G(n-1) . . . G(2) G(1) and ZUNGBR returns P**H as !> an N-by-N matrix. - - pure subroutine stdlib_wungbr( vect, m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -77998,12 +77998,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungbr + + pure subroutine stdlib_wunghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) !> ZUNGHR: generates a complex unitary matrix Q which is defined as the !> product of IHI-ILO elementary reflectors of order N, as returned by !> ZGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - - pure subroutine stdlib_wunghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78088,13 +78088,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunghr + + pure subroutine stdlib_wungl2( m, n, k, a, lda, tau, work, info ) !> ZUNGL2: generates an m-by-n complex matrix Q with orthonormal rows, !> which is defined as the first m rows of a product of k elementary !> reflectors of order n !> Q = H(k)**H . . . H(2)**H H(1)**H !> as returned by ZGELQF. - - pure subroutine stdlib_wungl2( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78159,13 +78159,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungl2 + + pure subroutine stdlib_wunglq( m, n, k, a, lda, tau, work, lwork, info ) !> ZUNGLQ: generates an M-by-N complex matrix Q with orthonormal rows, !> which is defined as the first M rows of a product of K elementary !> reflectors of order N !> Q = H(k)**H . . . H(2)**H H(1)**H !> as returned by ZGELQF. - - pure subroutine stdlib_wunglq( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78275,13 +78275,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunglq + + pure subroutine stdlib_wungql( m, n, k, a, lda, tau, work, lwork, info ) !> ZUNGQL: generates an M-by-N complex matrix Q with orthonormal columns, !> which is defined as the last N columns of a product of K elementary !> reflectors of order M !> Q = H(k) . . . H(2) H(1) !> as returned by ZGEQLF. - - pure subroutine stdlib_wungql( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78396,13 +78396,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungql + + pure subroutine stdlib_wungqr( m, n, k, a, lda, tau, work, lwork, info ) !> ZUNGQR: generates an M-by-N complex matrix Q with orthonormal columns, !> which is defined as the first N columns of a product of K elementary !> reflectors of order M !> Q = H(1) H(2) . . . H(k) !> as returned by ZGEQRF. - - pure subroutine stdlib_wungqr( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78512,13 +78512,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungqr + + pure subroutine stdlib_wungr2( m, n, k, a, lda, tau, work, info ) !> ZUNGR2: generates an m by n complex matrix Q with orthonormal rows, !> which is defined as the last m rows of a product of k elementary !> reflectors of order n !> Q = H(1)**H H(2)**H . . . H(k)**H !> as returned by ZGERQF. - - pure subroutine stdlib_wungr2( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78580,13 +78580,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungr2 + + pure subroutine stdlib_wungrq( m, n, k, a, lda, tau, work, lwork, info ) !> ZUNGRQ: generates an M-by-N complex matrix Q with orthonormal rows, !> which is defined as the last M rows of a product of K elementary !> reflectors of order N !> Q = H(1)**H H(2)**H . . . H(k)**H !> as returned by ZGERQF. - - pure subroutine stdlib_wungrq( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78702,13 +78702,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungrq + + pure subroutine stdlib_wungtr( uplo, n, a, lda, tau, work, lwork, info ) !> ZUNGTR: generates a complex unitary matrix Q which is defined as the !> product of n-1 elementary reflectors of order N, as returned by !> ZHETRD: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - - pure subroutine stdlib_wungtr( uplo, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78803,13 +78803,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungtr + + pure subroutine stdlib_wungtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) !> ZUNGTSQR: generates an M-by-N complex matrix Q_out with orthonormal !> columns, which are the first N columns of a product of comlpex unitary !> matrices of order M which are returned by ZLATSQR !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). !> See the documentation for ZLATSQR. - - pure subroutine stdlib_wungtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78901,6 +78901,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungtsqr + + pure subroutine stdlib_wungtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) !> ZUNGTSQR_ROW: generates an M-by-N complex matrix Q_out with !> orthonormal columns from the output of ZLATSQR. These N orthonormal !> columns are the first N columns of a product of complex unitary @@ -78916,8 +78918,6 @@ module stdlib_linalg_lapack_w !> starting in the bottom row block and continues to the top row block !> (hence _ROW in the routine name). This sweep is in reverse order of !> the order in which ZLATSQR generates the output blocks. - - pure subroutine stdlib_wungtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79044,6 +79044,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungtsqr_row + + pure subroutine stdlib_wunhr_col( m, n, nb, a, lda, t, ldt, d, info ) !> ZUNHR_COL: takes an M-by-N complex matrix Q_in with orthonormal columns !> as input, stored in A, and performs Householder Reconstruction (HR), !> i.e. reconstructs Householder vectors V(i) implicitly representing @@ -79053,8 +79055,6 @@ module stdlib_linalg_lapack_w !> stored in A on output, and the diagonal entries of S are stored in D. !> Block reflectors are also returned in T !> (same output format as ZGEQRT). - - pure subroutine stdlib_wunhr_col( m, n, nb, a, lda, t, ldt, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79363,6 +79363,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunm22 + + pure subroutine stdlib_wunm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) !> ZUNM2L: overwrites the general complex m-by-n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or @@ -79373,8 +79375,6 @@ module stdlib_linalg_lapack_w !> Q = H(k) . . . H(2) H(1) !> as returned by ZGEQLF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_wunm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79462,6 +79462,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunm2l + + pure subroutine stdlib_wunm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) !> ZUNM2R: overwrites the general complex m-by-n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or @@ -79472,8 +79474,6 @@ module stdlib_linalg_lapack_w !> Q = H(1) H(2) . . . H(k) !> as returned by ZGEQRF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_wunm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79565,6 +79565,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunm2r + + pure subroutine stdlib_wunmbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & !> If VECT = 'Q', ZUNMBR: overwrites the general complex M-by-N matrix C !> with !> SIDE = 'L' SIDE = 'R' @@ -79587,8 +79589,6 @@ module stdlib_linalg_lapack_w !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: !> if k < nq, P = G(1) G(2) . . . G(k); !> if k >= nq, P = G(1) G(2) . . . G(nq-1). - - pure subroutine stdlib_wunmbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79726,6 +79726,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmbr + + pure subroutine stdlib_wunmhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & !> ZUNMHR: overwrites the general complex M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -79734,8 +79736,6 @@ module stdlib_linalg_lapack_w !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of !> IHI-ILO elementary reflectors, as returned by ZGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - - pure subroutine stdlib_wunmhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79825,6 +79825,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmhr + + pure subroutine stdlib_wunml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) !> ZUNML2: overwrites the general complex m-by-n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or @@ -79835,8 +79837,6 @@ module stdlib_linalg_lapack_w !> Q = H(k)**H . . . H(2)**H H(1)**H !> as returned by ZGELQF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_wunml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79931,6 +79931,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunml2 + + pure subroutine stdlib_wunmlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) !> ZUNMLQ: overwrites the general complex M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -79940,8 +79942,6 @@ module stdlib_linalg_lapack_w !> Q = H(k)**H . . . H(2)**H H(1)**H !> as returned by ZGELQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_wunmlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80074,6 +80074,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmlq + + pure subroutine stdlib_wunmql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) !> ZUNMQL: overwrites the general complex M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -80083,8 +80085,6 @@ module stdlib_linalg_lapack_w !> Q = H(k) . . . H(2) H(1) !> as returned by ZGEQLF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_wunmql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80211,6 +80211,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmql + + pure subroutine stdlib_wunmqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) !> ZUNMQR: overwrites the general complex M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -80220,8 +80222,6 @@ module stdlib_linalg_lapack_w !> Q = H(1) H(2) . . . H(k) !> as returned by ZGEQRF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_wunmqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80348,6 +80348,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmqr + + pure subroutine stdlib_wunmr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) !> ZUNMR2: overwrites the general complex m-by-n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or @@ -80358,8 +80360,6 @@ module stdlib_linalg_lapack_w !> Q = H(1)**H H(2)**H . . . H(k)**H !> as returned by ZGERQF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_wunmr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -80449,6 +80449,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmr2 + + pure subroutine stdlib_wunmr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) !> ZUNMR3: overwrites the general complex m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or @@ -80459,8 +80461,6 @@ module stdlib_linalg_lapack_w !> Q = H(1) H(2) . . . H(k) !> as returned by ZTZRZF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_wunmr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80554,6 +80554,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmr3 + + pure subroutine stdlib_wunmrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) !> ZUNMRQ: overwrites the general complex M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -80563,8 +80565,6 @@ module stdlib_linalg_lapack_w !> Q = H(1)**H H(2)**H . . . H(k)**H !> as returned by ZGERQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_wunmrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80697,6 +80697,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmrq + + pure subroutine stdlib_wunmrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & !> ZUNMRZ: overwrites the general complex M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -80706,8 +80708,6 @@ module stdlib_linalg_lapack_w !> Q = H(1) H(2) . . . H(k) !> as returned by ZTZRZF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_wunmrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80852,6 +80852,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmrz + + pure subroutine stdlib_wunmtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & !> ZUNMTR: overwrites the general complex M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -80861,8 +80863,6 @@ module stdlib_linalg_lapack_w !> nq-1 elementary reflectors, as returned by ZHETRD: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - - pure subroutine stdlib_wunmtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80968,13 +80968,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmtr + + pure subroutine stdlib_wupgtr( uplo, n, ap, tau, q, ldq, work, info ) !> ZUPGTR: generates a complex unitary matrix Q which is defined as the !> product of n-1 elementary reflectors H(i) of order n, as returned by !> ZHPTRD using packed storage: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - - pure subroutine stdlib_wupgtr( uplo, n, ap, tau, q, ldq, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -81055,6 +81055,8 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wupgtr + + pure subroutine stdlib_wupmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) !> ZUPMTR: overwrites the general complex M-by-N matrix C with !> SIDE = 'L' SIDE = 'R' !> TRANS = 'N': Q * C C * Q @@ -81065,8 +81067,6 @@ module stdlib_linalg_lapack_w !> storage: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - - pure subroutine stdlib_wupmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_lapack_z.fypp b/src/stdlib_linalg_lapack_z.fypp index 1d42d3d5c..1e724c1d6 100644 --- a/src/stdlib_linalg_lapack_z.fypp +++ b/src/stdlib_linalg_lapack_z.fypp @@ -506,13 +506,13 @@ module stdlib_linalg_lapack_z contains #:if WITH_QP - !> ZLAG2W: converts a COMPLEX matrix, SA, to a COMPLEX*16 matrix, A. + + pure subroutine stdlib_zlag2w( m, n, sa, ldsa, a, lda, info ) + !> ZLAG2W converts a COMPLEX matrix, SA, to a COMPLEX*16 matrix, A. !> Note that while it is possible to overflow while converting !> from double to single, it is not possible to overflow when !> converting from single to double. !> This is an auxiliary routine so there is no argument checking. - - pure subroutine stdlib_zlag2w( m, n, sa, ldsa, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -536,11 +536,11 @@ module stdlib_linalg_lapack_z end subroutine stdlib_zlag2w #:endif - !> ZDRSCL: multiplies an n-element complex vector x by the real scalar - !> 1/a. This is done without overflow or underflow as long as - !> the final result x/a does not overflow or underflow. pure subroutine stdlib_zdrscl( n, sa, sx, incx ) + !> ZDRSCL multiplies an n-element complex vector x by the real scalar + !> 1/a. This is done without overflow or underflow as long as + !> the final result x/a does not overflow or underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -590,7 +590,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zdrscl - !> ZGBEQU: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_zgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) + !> ZGBEQU 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 @@ -599,8 +601,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -725,7 +725,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgbequ - !> ZGBEQUB: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_zgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) + !> ZGBEQUB 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 @@ -740,8 +742,6 @@ module stdlib_linalg_lapack_z !> 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). - - pure subroutine stdlib_zgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -875,11 +875,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgbequb - !> ZGBTF2: computes an LU factorization of a complex m-by-n band matrix - !> A using partial pivoting with row interchanges. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. pure subroutine stdlib_zgbtf2( m, n, kl, ku, ab, ldab, ipiv, info ) + !> ZGBTF2 computes an LU factorization of a complex m-by-n band matrix + !> A using partial pivoting with row interchanges. + !> This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -961,11 +961,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgbtf2 - !> ZGEBAK: forms the right or left eigenvectors of a complex general - !> matrix by backward transformation on the computed eigenvectors of the - !> balanced matrix output by ZGEBAL. pure subroutine stdlib_zgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) + !> ZGEBAK forms the right or left eigenvectors of a complex general + !> matrix by backward transformation on the computed eigenvectors of the + !> balanced matrix output by ZGEBAL. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1058,7 +1058,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgebak - !> ZGEBAL: balances a general complex matrix A. This involves, first, + + pure subroutine stdlib_zgebal( job, n, a, lda, ilo, ihi, scale, info ) + !> ZGEBAL 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 @@ -1066,8 +1068,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zgebal( job, n, a, lda, ilo, ihi, scale, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1228,7 +1228,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgebal - !> ZGEEQU: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_zgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) + !> ZGEEQU 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 @@ -1237,8 +1239,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1356,7 +1356,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeequ - !> ZGEEQUB: computes row and column scalings intended to equilibrate an + + pure subroutine stdlib_zgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) + !> ZGEEQUB 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 @@ -1371,8 +1373,6 @@ module stdlib_linalg_lapack_z !> 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). - - pure subroutine stdlib_zgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1500,13 +1500,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeequb - !> ZGETC2: computes an LU factorization, using complete pivoting, of the + + pure subroutine stdlib_zgetc2( n, a, lda, ipiv, jpiv, info ) + !> ZGETC2 computes an LU factorization, using complete pivoting, of the !> n-by-n matrix A. The factorization has the form A = P * L * U * Q, !> where P and Q are permutation matrices, L is lower triangular with !> unit diagonal elements and U is upper triangular. !> This is a level 1 BLAS version of the algorithm. - - pure subroutine stdlib_zgetc2( n, a, lda, ipiv, jpiv, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1584,7 +1584,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgetc2 - !> ZGETF2: computes an LU factorization of a general m-by-n matrix A + + pure subroutine stdlib_zgetf2( m, n, a, lda, ipiv, info ) + !> ZGETF2 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 @@ -1592,8 +1594,6 @@ module stdlib_linalg_lapack_z !> diagonal elements (lower trapezoidal if m > n), and U is upper !> triangular (upper trapezoidal if m < n). !> This is the right-looking Level 2 BLAS version of the algorithm. - - pure subroutine stdlib_zgetf2( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1657,12 +1657,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgetf2 - !> ZGGBAK: forms the right or left eigenvectors of a complex generalized + + pure subroutine stdlib_zggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) + !> ZGGBAK 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 !> ZGGBAL. - - pure subroutine stdlib_zggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1770,7 +1770,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zggbak - !> ZGGBAL: balances a pair of general complex matrices (A,B). This + + pure subroutine stdlib_zggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) + !> ZGGBAL 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 @@ -1779,8 +1781,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2074,14 +2074,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zggbal - !> ZGTSV: solves the equation + + pure subroutine stdlib_zgtsv( n, nrhs, dl, d, du, b, ldb, info ) + !> ZGTSV 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. - - pure subroutine stdlib_zgtsv( n, nrhs, dl, d, du, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2166,15 +2166,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgtsv - !> ZGTTRF: computes an LU factorization of a complex tridiagonal matrix A + + pure subroutine stdlib_zgttrf( n, dl, d, du, du2, ipiv, info ) + !> ZGTTRF 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. - - pure subroutine stdlib_zgttrf( n, dl, d, du, du2, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2262,12 +2262,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgttrf - !> ZGTTS2: solves one of the systems of equations + + pure subroutine stdlib_zgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) + !> ZGTTS2 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 ZGTTRF. - - pure subroutine stdlib_zgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2433,10 +2433,10 @@ module stdlib_linalg_lapack_z end if end subroutine stdlib_zgtts2 - !> ZHESWAPR: applies an elementary permutation on the rows and the columns of - !> a hermitian matrix. pure subroutine stdlib_zheswapr( uplo, n, a, lda, i1, i2) + !> ZHESWAPR applies an elementary permutation on the rows and the columns of + !> a hermitian matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2505,15 +2505,15 @@ module stdlib_linalg_lapack_z endif end subroutine stdlib_zheswapr - !> ZHETF2: computes the factorization of a complex Hermitian matrix A + + pure subroutine stdlib_zhetf2( uplo, n, a, lda, ipiv, info ) + !> ZHETF2 computes the factorization of a complex Hermitian 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, 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. - - pure subroutine stdlib_zhetf2( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2831,7 +2831,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetf2 - !> ZHETF2_RK: computes the factorization of a complex Hermitian matrix A + + pure subroutine stdlib_zhetf2_rk( uplo, n, a, lda, e, ipiv, info ) + !> ZHETF2_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, @@ -2840,8 +2842,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zhetf2_rk( uplo, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3362,15 +3362,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetf2_rk - !> ZHETF2_ROOK: computes the factorization of a complex Hermitian matrix A + + pure subroutine stdlib_zhetf2_rook( uplo, n, a, lda, ipiv, info ) + !> ZHETF2_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. - - pure subroutine stdlib_zhetf2_rook( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3851,11 +3851,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetf2_rook - !> ZHETRI: 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 - !> ZHETRF. pure subroutine stdlib_zhetri( uplo, n, a, lda, ipiv, work, info ) + !> ZHETRI 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 + !> ZHETRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4055,11 +4055,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetri - !> ZHETRI_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 - !> ZHETRF_ROOK. pure subroutine stdlib_zhetri_rook( uplo, n, a, lda, ipiv, work, info ) + !> ZHETRI_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 + !> ZHETRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4323,7 +4323,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetri_rook - !> ZHETRS_3: solves a system of linear equations A * X = B with a complex + + pure subroutine stdlib_zhetrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) + !> ZHETRS_3 solves a system of linear equations A * X = B with a complex !> Hermitian matrix A using the factorization computed !> by ZHETRF_RK or ZHETRF_BK: !> A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T), @@ -4332,8 +4334,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zhetrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4483,16 +4483,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrs_3 + + pure subroutine stdlib_zhfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) !> Level 3 BLAS like routine for C in RFP Format. - !> ZHFRK: performs one of the Hermitian rank--k operations + !> ZHFRK 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. - - pure subroutine stdlib_zhfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4743,15 +4743,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhfrk - !> ZHPGST: reduces a complex Hermitian-definite generalized + + pure subroutine stdlib_zhpgst( itype, uplo, n, ap, bp, info ) + !> ZHPGST 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 ZPPTRF. - - pure subroutine stdlib_zhpgst( itype, uplo, n, ap, bp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4872,14 +4872,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpgst - !> ZHPTRF: computes the factorization of a complex Hermitian packed + + pure subroutine stdlib_zhptrf( uplo, n, ap, ipiv, info ) + !> ZHPTRF 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. - - pure subroutine stdlib_zhptrf( uplo, n, ap, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5222,11 +5222,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhptrf - !> ZHPTRI: 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 ZHPTRF. pure subroutine stdlib_zhptri( uplo, n, ap, ipiv, work, info ) + !> ZHPTRI 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 ZHPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5441,7 +5441,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhptri - !> ZLA_GBAMV: performs one of the matrix-vector operations + + subroutine stdlib_zla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) + !> ZLA_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 @@ -5454,8 +5456,6 @@ module stdlib_linalg_lapack_z !> "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. - - subroutine stdlib_zla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5636,14 +5636,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zla_gbamv - !> ZLA_GBRPVGRW: computes the reciprocal pivot growth factor + + pure real(dp) function stdlib_zla_gbrpvgrw( n, kl, ku, ncols, ab,ldab, afb, ldafb ) + !> ZLA_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. - - pure real(dp) function stdlib_zla_gbrpvgrw( n, kl, ku, ncols, ab,ldab, afb, ldafb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5681,7 +5681,9 @@ module stdlib_linalg_lapack_z stdlib_zla_gbrpvgrw = rpvgrw end function stdlib_zla_gbrpvgrw - !> ZLA_GEAMV: performs one of the matrix-vector operations + + subroutine stdlib_zla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) + !> ZLA_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 @@ -5694,8 +5696,6 @@ module stdlib_linalg_lapack_z !> "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. - - subroutine stdlib_zla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5870,14 +5870,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zla_geamv - !> ZLA_GERPVGRW: computes the reciprocal pivot growth factor + + pure real(dp) function stdlib_zla_gerpvgrw( n, ncols, a, lda, af,ldaf ) + !> ZLA_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. - - pure real(dp) function stdlib_zla_gerpvgrw( n, ncols, a, lda, af,ldaf ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5914,6 +5914,8 @@ module stdlib_linalg_lapack_z stdlib_zla_gerpvgrw = rpvgrw end function stdlib_zla_gerpvgrw + + subroutine stdlib_zla_heamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) !> ZLA_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 @@ -5926,8 +5928,6 @@ module stdlib_linalg_lapack_z !> "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. - - subroutine stdlib_zla_heamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6108,13 +6108,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zla_heamv - !> ZLA_LIN_BERR: computes componentwise relative backward error from + + pure subroutine stdlib_zla_lin_berr( n, nz, nrhs, res, ayb, berr ) + !> ZLA_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. - - pure subroutine stdlib_zla_lin_berr( n, nz, nrhs, res, ayb, berr ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6154,14 +6154,14 @@ module stdlib_linalg_lapack_z end do end subroutine stdlib_zla_lin_berr - !> ZLA_PORPVGRW: computes the reciprocal pivot growth factor + + real(dp) function stdlib_zla_porpvgrw( uplo, ncols, a, lda, af,ldaf, work ) + !> ZLA_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. - - real(dp) function stdlib_zla_porpvgrw( uplo, ncols, a, lda, af,ldaf, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6247,7 +6247,9 @@ module stdlib_linalg_lapack_z stdlib_zla_porpvgrw = rpvgrw end function stdlib_zla_porpvgrw - !> ZLA_SYAMV: performs the matrix-vector operation + + subroutine stdlib_zla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) + !> ZLA_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. @@ -6259,8 +6261,6 @@ module stdlib_linalg_lapack_z !> "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. - - subroutine stdlib_zla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6442,11 +6442,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zla_syamv - !> ZLA_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. pure subroutine stdlib_zla_wwaddw( n, x, y, w ) + !> ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6469,9 +6469,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zla_wwaddw - !> ZLACGV: conjugates a complex vector of length N. pure subroutine stdlib_zlacgv( n, x, incx ) + !> ZLACGV conjugates a complex vector of length N. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6500,10 +6500,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlacgv - !> ZLACN2: estimates the 1-norm of a square, complex matrix A. - !> Reverse communication is used for evaluating matrix-vector products. pure subroutine stdlib_zlacn2( n, v, x, est, kase, isave ) + !> ZLACN2 estimates the 1-norm of a square, complex matrix A. + !> Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6627,10 +6627,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlacn2 - !> ZLACON: estimates the 1-norm of a square, complex matrix A. - !> Reverse communication is used for evaluating matrix-vector products. subroutine stdlib_zlacon( n, v, x, est, kase ) + !> ZLACON estimates the 1-norm of a square, complex matrix A. + !> Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6754,10 +6754,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlacon - !> ZLACP2: copies all or part of a real two-dimensional matrix A to a - !> complex matrix B. pure subroutine stdlib_zlacp2( uplo, m, n, a, lda, b, ldb ) + !> ZLACP2 copies all or part of a real two-dimensional matrix A to a + !> complex matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6795,10 +6795,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlacp2 - !> ZLACPY: copies all or part of a two-dimensional matrix A to another - !> matrix B. pure subroutine stdlib_zlacpy( uplo, m, n, a, lda, b, ldb ) + !> ZLACPY copies all or part of a two-dimensional matrix A to another + !> matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6836,12 +6836,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlacpy - !> ZLACRM: performs a very simple matrix-matrix multiplication: + + pure subroutine stdlib_zlacrm( m, n, a, lda, b, ldb, c, ldc, rwork ) + !> ZLACRM 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. - - pure subroutine stdlib_zlacrm( m, n, a, lda, b, ldb, c, ldc, rwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6890,12 +6890,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlacrm - !> ZLACRT: performs the operation + + pure subroutine stdlib_zlacrt( n, cx, incx, cy, incy, c, s ) + !> ZLACRT 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. - - pure subroutine stdlib_zlacrt( n, cx, incx, cy, incy, c, s ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6934,11 +6934,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlacrt - !> ZLADIV: := X / Y, where X and Y are complex. The computation of X / Y - !> will not overflow on an intermediary step unless the results - !> overflows. pure complex(dp) function stdlib_zladiv( x, y ) + !> ZLADIV := X / Y, where X and Y are complex. The computation of X / Y + !> will not overflow on an intermediary step unless the results + !> overflows. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6956,14 +6956,14 @@ module stdlib_linalg_lapack_z return end function stdlib_zladiv - !> ZLAED8: merges the two sets of eigenvalues together into a single + + pure subroutine stdlib_zlaed8( k, n, qsiz, q, ldq, d, rho, cutpnt, z, dlamda,q2, ldq2, w, & + !> ZLAED8 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. - - pure subroutine stdlib_zlaed8( k, n, qsiz, q, ldq, d, rho, cutpnt, z, dlamda,q2, ldq2, w, & indxp, indx, indxq, perm, givptr,givcol, givnum, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7159,7 +7159,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaed8 - !> ZLAESY: computes the eigendecomposition of a 2-by-2 symmetric matrix + + pure subroutine stdlib_zlaesy( a, b, c, rt1, rt2, evscal, cs1, sn1 ) + !> ZLAESY 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. @@ -7168,8 +7170,6 @@ module stdlib_linalg_lapack_z !> 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 ] - - pure subroutine stdlib_zlaesy( a, b, c, rt1, rt2, evscal, cs1, sn1 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7249,7 +7249,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaesy - !> ZLAEV2: computes the eigendecomposition of a 2-by-2 Hermitian matrix + + pure subroutine stdlib_zlaev2( a, b, c, rt1, rt2, cs1, sn1 ) + !> ZLAEV2 computes the eigendecomposition of a 2-by-2 Hermitian matrix !> [ A B ] !> [ CONJG(B) C ]. !> On return, RT1 is the eigenvalue of larger absolute value, RT2 is the @@ -7257,8 +7259,6 @@ module stdlib_linalg_lapack_z !> eigenvector for RT1, giving the decomposition !> [ CS1 CONJG(SN1) ] [ A B ] [ CS1 -CONJG(SN1) ] = [ RT1 0 ] !> [-SN1 CS1 ] [ CONJG(B) C ] [ SN1 CS1 ] [ 0 RT2 ]. - - pure subroutine stdlib_zlaev2( a, b, c, rt1, rt2, cs1, sn1 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7286,13 +7286,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaev2 - !> ZLAG2C: converts a COMPLEX*16 matrix, SA, to a COMPLEX matrix, A. + + pure subroutine stdlib_zlag2c( m, n, a, lda, sa, ldsa, info ) + !> ZLAG2C converts a COMPLEX*16 matrix, SA, to a COMPLEX matrix, A. !> RMAX is the overflow for the SINGLE PRECISION arithmetic !> ZLAG2C checks that all the entries of A are between -RMAX and !> RMAX. If not the conversion is aborted and a flag is raised. !> This is an auxiliary routine so there is no argument checking. - - pure subroutine stdlib_zlag2c( m, n, a, lda, sa, ldsa, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7325,13 +7325,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlag2c - !> ZLAGTM: performs a matrix-vector product of the form + + pure subroutine stdlib_zlagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) + !> ZLAGTM 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. - - pure subroutine stdlib_zlagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7461,7 +7461,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlagtm - !> ZLAHEF: computes a partial factorization of a complex Hermitian + + pure subroutine stdlib_zlahef( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) + !> ZLAHEF 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: @@ -7474,8 +7476,6 @@ module stdlib_linalg_lapack_z !> ZLAHEF is an auxiliary routine called by ZHETRF. It uses blocked code !> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or !> A22 (if UPLO = 'L'). - - pure subroutine stdlib_zlahef( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8000,7 +8000,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlahef - !> ZLAHEF_RK: computes a partial factorization of a complex Hermitian + + pure subroutine stdlib_zlahef_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) + !> ZLAHEF_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: @@ -8012,8 +8014,6 @@ module stdlib_linalg_lapack_z !> ZLAHEF_RK is an auxiliary routine called by ZHETRF_RK. It uses !> blocked code (calling Level 3 BLAS) to update the submatrix !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). - - pure subroutine stdlib_zlahef_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8640,7 +8640,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlahef_rk - !> ZLAHEF_ROOK: computes a partial factorization of a complex Hermitian + + pure subroutine stdlib_zlahef_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) + !> ZLAHEF_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: @@ -8653,8 +8655,6 @@ module stdlib_linalg_lapack_z !> ZLAHEF_ROOK is an auxiliary routine called by ZHETRF_ROOK. It uses !> blocked code (calling Level 3 BLAS) to update the submatrix !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). - - pure subroutine stdlib_zlahef_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9312,7 +9312,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlahef_rook - !> ZLAIC1: applies one step of incremental condition estimation in + + pure subroutine stdlib_zlaic1( job, j, x, sest, w, gamma, sestpr, s, c ) + !> ZLAIC1 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 @@ -9332,8 +9334,6 @@ module stdlib_linalg_lapack_z !> diag(sest*sest, 0) + [alpha gamma] * [ conjg(alpha) ] !> [ conjg(gamma) ] !> where alpha = x**H * w. - - pure subroutine stdlib_zlaic1( job, j, x, sest, w, gamma, sestpr, s, c ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9528,14 +9528,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaic1 - !> ZLAPMR: rearranges the rows of the M by N matrix X as specified + + pure subroutine stdlib_zlapmr( forwrd, m, n, x, ldx, k ) + !> ZLAPMR 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. - - pure subroutine stdlib_zlapmr( forwrd, m, n, x, ldx, k ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9596,14 +9596,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlapmr - !> ZLAPMT: rearranges the columns of the M by N matrix X as specified + + pure subroutine stdlib_zlapmt( forwrd, m, n, x, ldx, k ) + !> ZLAPMT 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. - - pure subroutine stdlib_zlapmt( forwrd, m, n, x, ldx, k ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9664,11 +9664,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlapmt - !> ZLAQGB: 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. pure subroutine stdlib_zlaqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) + !> ZLAQGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -9734,10 +9734,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaqgb - !> ZLAQGE: equilibrates a general M by N matrix A using the row and - !> column scaling factors in the vectors R and C. pure subroutine stdlib_zlaqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed ) + !> ZLAQGE equilibrates a general M by N matrix A using the row and + !> column scaling factors in the vectors R and C. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9800,10 +9800,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaqge - !> ZLAQHB: equilibrates a Hermitian band matrix A - !> using the scaling factors in the vector S. pure subroutine stdlib_zlaqhb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) + !> ZLAQHB equilibrates a Hermitian band matrix A + !> using the scaling factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9862,10 +9862,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaqhb - !> ZLAQHE: equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_zlaqhe( uplo, n, a, lda, s, scond, amax, equed ) + !> ZLAQHE equilibrates a Hermitian matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9924,10 +9924,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaqhe - !> ZLAQHP: equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_zlaqhp( uplo, n, ap, s, scond, amax, equed ) + !> ZLAQHP equilibrates a Hermitian matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9990,14 +9990,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaqhp + + pure subroutine stdlib_zlaqr1( n, h, ldh, s1, s2, v ) !> Given a 2-by-2 or 3-by-3 matrix H, ZLAQR1: 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. - - pure subroutine stdlib_zlaqr1( n, h, ldh, s1, s2, v ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10053,10 +10053,10 @@ module stdlib_linalg_lapack_z end if end subroutine stdlib_zlaqr1 - !> ZLAQSB: equilibrates a symmetric band matrix A using the scaling - !> factors in the vector S. pure subroutine stdlib_zlaqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) + !> ZLAQSB equilibrates a symmetric band matrix A using the scaling + !> factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10113,10 +10113,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaqsb - !> ZLAQSP: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_zlaqsp( uplo, n, ap, s, scond, amax, equed ) + !> ZLAQSP equilibrates a symmetric matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10175,10 +10175,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaqsp - !> ZLAQSY: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. pure subroutine stdlib_zlaqsy( uplo, n, a, lda, s, scond, amax, equed ) + !> ZLAQSY equilibrates a symmetric matrix A using the scaling factors + !> in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10233,7 +10233,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaqsy - !> ZLAR1V: computes the (scaled) r-th column of the inverse of + + pure subroutine stdlib_zlar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & + !> ZLAR1V 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 @@ -10248,8 +10250,6 @@ module stdlib_linalg_lapack_z !> (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. - - pure subroutine stdlib_zlar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10456,15 +10456,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlar1v - !> ZLAR2V: applies a vector of complex plane rotations with real cosines + + pure subroutine stdlib_zlar2v( n, x, y, z, incx, c, s, incc ) + !> ZLAR2V 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) ) - - pure subroutine stdlib_zlar2v( n, x, y, z, incx, c, s, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10510,12 +10510,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlar2v - !> ZLARCM: performs a very simple matrix-matrix multiplication: + + pure subroutine stdlib_zlarcm( m, n, a, lda, b, ldb, c, ldc, rwork ) + !> ZLARCM 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. - - pure subroutine stdlib_zlarcm( m, n, a, lda, b, ldb, c, ldc, rwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10564,7 +10564,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarcm - !> ZLARF: applies a complex elementary reflector H to a complex M-by-N + + pure subroutine stdlib_zlarf( side, m, n, v, incv, tau, c, ldc, work ) + !> ZLARF 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 @@ -10572,8 +10574,6 @@ module stdlib_linalg_lapack_z !> If tau = 0, then H is taken to be the unit matrix. !> To apply H**H, supply conjg(tau) instead !> tau. - - pure subroutine stdlib_zlarf( side, m, n, v, incv, tau, c, ldc, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10644,10 +10644,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarf - !> ZLARFB: 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. pure subroutine stdlib_zlarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, ldc, & + !> ZLARFB 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. work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10972,15 +10972,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarfb - !> ZLARFB_GETT: applies a complex Householder block reflector H from the + + pure subroutine stdlib_zlarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) + !> ZLARFB_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. - - pure subroutine stdlib_zlarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -11111,7 +11111,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarfb_gett - !> ZLARFG: generates a complex elementary reflector H of order n, such + + pure subroutine stdlib_zlarfg( n, alpha, x, incx, tau ) + !> ZLARFG generates a complex elementary reflector H of order n, such !> that !> H**H * ( alpha ) = ( beta ), H**H * H = I. !> ( x ) ( 0 ) @@ -11124,8 +11126,6 @@ module stdlib_linalg_lapack_z !> 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 . - - pure subroutine stdlib_zlarfg( n, alpha, x, incx, tau ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11185,7 +11185,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarfg - !> ZLARFGP: generates a complex elementary reflector H of order n, such + + subroutine stdlib_zlarfgp( n, alpha, x, incx, tau ) + !> ZLARFGP generates a complex elementary reflector H of order n, such !> that !> H**H * ( alpha ) = ( beta ), H**H * H = I. !> ( x ) ( 0 ) @@ -11197,8 +11199,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zlarfgp( n, alpha, x, incx, tau ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11321,7 +11321,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarfgp - !> ZLARFT: forms the triangular factor T of a complex block reflector H + + pure subroutine stdlib_zlarft( direct, storev, n, k, v, ldv, tau, t, ldt ) + !> ZLARFT 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. @@ -11331,8 +11333,6 @@ module stdlib_linalg_lapack_z !> 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 - - pure subroutine stdlib_zlarft( direct, storev, n, k, v, ldv, tau, t, ldt ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11448,15 +11448,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarft - !> ZLARFX: applies a complex elementary reflector H to a complex m by n + + pure subroutine stdlib_zlarfx( side, m, n, v, tau, c, ldc, work ) + !> ZLARFX 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 !> This version uses inline code if H has order < 11. - - pure subroutine stdlib_zlarfx( side, m, n, v, tau, c, ldc, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11953,14 +11953,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarfx - !> ZLARFY: applies an elementary reflector, or Householder matrix, H, + + pure subroutine stdlib_zlarfy( uplo, n, v, incv, tau, c, ldc, work ) + !> ZLARFY 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. - - pure subroutine stdlib_zlarfy( uplo, n, v, incv, tau, c, ldc, work ) ! -- lapack test routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11987,10 +11987,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarfy - !> ZLARNV: returns a vector of n random complex numbers from a uniform or - !> normal distribution. pure subroutine stdlib_zlarnv( idist, iseed, n, x ) + !> ZLARNV returns a vector of n random complex numbers from a uniform or + !> normal distribution. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12052,9 +12052,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarnv + + pure subroutine stdlib_zlartg( f, g, c, s, r ) !> ! !> - !> ZLARTG: generates a plane rotation so that + !> ZLARTG 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. @@ -12076,8 +12078,6 @@ module stdlib_linalg_lapack_z !> 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=>dp stands for double precision from LA_CONSTANTS module. - - pure subroutine stdlib_zlartg( f, g, c, s, r ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12172,12 +12172,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlartg - !> ZLARTV: applies a vector of complex plane rotations with real cosines + + pure subroutine stdlib_zlartv( n, x, incx, y, incy, c, s, incc ) + !> ZLARTV 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) ) - - pure subroutine stdlib_zlartv( n, x, incx, y, incy, c, s, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12209,7 +12209,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlartv - !> ZLARZ: applies a complex elementary reflector H to a complex + + pure subroutine stdlib_zlarz( side, m, n, l, v, incv, tau, c, ldc, work ) + !> ZLARZ 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 @@ -12218,8 +12220,6 @@ module stdlib_linalg_lapack_z !> 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 ZTZRZF. - - pure subroutine stdlib_zlarz( side, m, n, l, v, incv, tau, c, ldc, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12268,11 +12268,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarz - !> ZLARZB: 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. pure subroutine stdlib_zlarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & + !> ZLARZB 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. ldc, work, ldwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12370,7 +12370,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarzb - !> ZLARZT: forms the triangular factor T of a complex block reflector + + pure subroutine stdlib_zlarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) + !> ZLARZT 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; @@ -12382,8 +12384,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zlarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12434,13 +12434,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarzt - !> ZLASCL: multiplies the M by N complex matrix A by the real scalar + + pure subroutine stdlib_zlascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) + !> ZLASCL 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. - - pure subroutine stdlib_zlascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12604,10 +12604,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlascl - !> ZLASET: initializes a 2-D array A to BETA on the diagonal and - !> ALPHA on the offdiagonals. pure subroutine stdlib_zlaset( uplo, m, n, alpha, beta, a, lda ) + !> ZLASET initializes a 2-D array A to BETA on the diagonal and + !> ALPHA on the offdiagonals. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12660,7 +12660,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaset - !> ZLASR: applies a sequence of real plane rotations to a complex matrix + + pure subroutine stdlib_zlasr( side, pivot, direct, m, n, c, s, a, lda ) + !> ZLASR 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 @@ -12711,8 +12713,6 @@ module stdlib_linalg_lapack_z !> ( -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. - - pure subroutine stdlib_zlasr( side, pivot, direct, m, n, c, s, a, lda ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12920,9 +12920,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlasr + + pure subroutine stdlib_zlassq( n, x, incx, scl, sumsq ) !> ! !> - !> ZLASSQ: returns the values scl and smsq such that + !> ZLASSQ 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. @@ -12940,8 +12942,6 @@ module stdlib_linalg_lapack_z !> and !> TINY*EPS -- tiniest representable number; !> HUGE -- biggest representable number. - - pure subroutine stdlib_zlassq( n, x, incx, scl, sumsq ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13046,10 +13046,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlassq - !> ZLASWP: performs a series of row interchanges on the matrix A. - !> One row interchange is initiated for each of rows K1 through K2 of A. pure subroutine stdlib_zlaswp( n, a, lda, k1, k2, ipiv, incx ) + !> ZLASWP performs a series of row interchanges on the matrix A. + !> One row interchange is initiated for each of rows K1 through K2 of A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13113,7 +13113,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaswp - !> ZLASYF: computes a partial factorization of a complex symmetric matrix + + pure subroutine stdlib_zlasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) + !> ZLASYF 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: @@ -13126,8 +13128,6 @@ module stdlib_linalg_lapack_z !> ZLASYF is an auxiliary routine called by ZSYTRF. It uses blocked code !> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or !> A22 (if UPLO = 'L'). - - pure subroutine stdlib_zlasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13553,7 +13553,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlasyf - !> ZLASYF_RK: computes a partial factorization of a complex symmetric + + pure subroutine stdlib_zlasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) + !> ZLASYF_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: @@ -13565,8 +13567,6 @@ module stdlib_linalg_lapack_z !> ZLASYF_RK is an auxiliary routine called by ZSYTRF_RK. It uses !> blocked code (calling Level 3 BLAS) to update the submatrix !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). - - pure subroutine stdlib_zlasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13999,7 +13999,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlasyf_rk - !> ZLASYF_ROOK: computes a partial factorization of a complex symmetric + + pure subroutine stdlib_zlasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) + !> ZLASYF_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: @@ -14011,8 +14013,6 @@ module stdlib_linalg_lapack_z !> ZLASYF_ROOK is an auxiliary routine called by ZSYTRF_ROOK. It uses !> blocked code (calling Level 3 BLAS) to update the submatrix !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). - - pure subroutine stdlib_zlasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14465,14 +14465,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlasyf_rook - !> ZLAT2C: converts a COMPLEX*16 triangular matrix, SA, to a COMPLEX + + pure subroutine stdlib_zlat2c( uplo, n, a, lda, sa, ldsa, info ) + !> ZLAT2C converts a COMPLEX*16 triangular matrix, SA, to a COMPLEX !> triangular matrix, A. !> RMAX is the overflow for the SINGLE PRECISION arithmetic !> ZLAT2C checks that all the entries of A are between -RMAX and !> RMAX. If not the conversion is aborted and a flag is raised. !> This is an auxiliary routine so there is no argument checking. - - pure subroutine stdlib_zlat2c( uplo, n, a, lda, sa, ldsa, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14522,7 +14522,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlat2c - !> ZLATBS: solves one of the triangular systems + + pure subroutine stdlib_zlatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & + !> ZLATBS 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 @@ -14532,8 +14534,6 @@ module stdlib_linalg_lapack_z !> overflow, the Level 2 BLAS routine ZTBSV 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. - - pure subroutine stdlib_zlatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15078,7 +15078,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlatbs - !> ZLATPS: solves one of the triangular systems + + pure subroutine stdlib_zlatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) + !> ZLATPS 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 @@ -15089,8 +15091,6 @@ module stdlib_linalg_lapack_z !> overflow, the Level 2 BLAS routine ZTPSV 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. - - pure subroutine stdlib_zlatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15629,7 +15629,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlatps - !> ZLATRD: reduces NB rows and columns of a complex Hermitian matrix A to + + pure subroutine stdlib_zlatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) + !> ZLATRD reduces NB rows and columns of a complex Hermitian matrix A to !> Hermitian tridiagonal form by a unitary similarity !> transformation Q**H * A * Q, and returns the matrices V and W which are !> needed to apply the transformation to the unreduced part of A. @@ -15638,8 +15640,6 @@ module stdlib_linalg_lapack_z !> if UPLO = 'L', ZLATRD reduces the first NB rows and columns of a !> matrix, of which the lower triangle is supplied. !> This is an auxiliary routine called by ZHETRD. - - pure subroutine stdlib_zlatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15745,7 +15745,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlatrd - !> ZLATRS: solves one of the triangular systems + + pure subroutine stdlib_zlatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) + !> ZLATRS 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. Here A is an upper or lower !> triangular matrix, A**T denotes the transpose of A, A**H denotes the @@ -15755,8 +15757,6 @@ module stdlib_linalg_lapack_z !> unscaled problem will not cause overflow, the Level 2 BLAS routine !> ZTRSV 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. - - pure subroutine stdlib_zlatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16274,12 +16274,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlatrs - !> ZLATRZ: factors the M-by-(M+L) complex upper trapezoidal matrix + + pure subroutine stdlib_zlatrz( m, n, l, a, lda, tau, work ) + !> ZLATRZ factors the M-by-(M+L) complex upper trapezoidal matrix !> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z by means !> of unitary transformations, where Z is an (M+L)-by-(M+L) unitary !> matrix and, R and A1 are M-by-M upper triangular matrices. - - pure subroutine stdlib_zlatrz( m, n, l, a, lda, tau, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16320,7 +16320,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlatrz - !> ZLAUNHR_COL_GETRFNP2: computes the modified LU factorization without + + pure recursive subroutine stdlib_zlaunhr_col_getrfnp2( m, n, a, lda, d, info ) + !> ZLAUNHR_COL_GETRFNP2 computes the modified LU factorization without !> pivoting of a complex general M-by-N matrix A. The factorization has !> the form: !> A - S = L * U, @@ -16368,8 +16370,6 @@ module stdlib_linalg_lapack_z !> [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. - - pure recursive subroutine stdlib_zlaunhr_col_getrfnp2( m, n, a, lda, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16456,7 +16456,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaunhr_col_getrfnp2 - !> ZLAUU2: computes the product U * U**H or L**H * L, where the triangular + + pure subroutine stdlib_zlauu2( uplo, n, a, lda, info ) + !> ZLAUU2 computes the product U * U**H or L**H * L, where the triangular !> factor U or L is stored in the upper or lower triangular part of !> the array A. !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, @@ -16464,8 +16466,6 @@ module stdlib_linalg_lapack_z !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, !> overwriting the factor L in A. !> This is the unblocked form of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_zlauu2( uplo, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16534,7 +16534,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlauu2 - !> ZLAUUM: computes the product U * U**H or L**H * L, where the triangular + + pure subroutine stdlib_zlauum( uplo, n, a, lda, info ) + !> ZLAUUM computes the product U * U**H or L**H * L, where the triangular !> factor U or L is stored in the upper or lower triangular part of !> the array A. !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, @@ -16542,8 +16544,6 @@ module stdlib_linalg_lapack_z !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, !> overwriting the factor L in A. !> This is the blocked form of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_zlauum( uplo, n, a, lda, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16618,14 +16618,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlauum - !> ZPBCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_zpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,rwork, info ) + !> ZPBCON estimates the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite band matrix using !> the Cholesky factorization A = U**H*U or A = L*L**H computed by !> ZPBTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_zpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16722,7 +16722,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpbcon - !> ZPBEQU: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_zpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) + !> ZPBEQU computes row and column scalings intended to equilibrate a !> Hermitian positive definite band matrix A and reduce its condition !> number (with respect to the two-norm). S contains the scale factors, !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with @@ -16730,8 +16732,6 @@ module stdlib_linalg_lapack_z !> choice of S puts the condition number of B within a factor N of the !> smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_zpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16809,7 +16809,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpbequ - !> ZPBSTF: computes a split Cholesky factorization of a complex + + pure subroutine stdlib_zpbstf( uplo, n, kd, ab, ldab, info ) + !> ZPBSTF computes a split Cholesky factorization of a complex !> Hermitian positive definite band matrix A. !> This routine is designed to be used in conjunction with ZHBGST. !> The factorization has the form A = S**H*S where S is a band matrix @@ -16818,8 +16820,6 @@ module stdlib_linalg_lapack_z !> ( M L ) !> where U is upper triangular of order m = (n+kd)/2, and L is lower !> triangular of order n-m. - - pure subroutine stdlib_zpbstf( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16943,7 +16943,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpbstf - !> ZPBTF2: computes the Cholesky factorization of a complex Hermitian + + pure subroutine stdlib_zpbtf2( uplo, n, kd, ab, ldab, info ) + !> ZPBTF2 computes the Cholesky factorization of a complex Hermitian !> positive definite band matrix A. !> The factorization has the form !> A = U**H * U , if UPLO = 'U', or @@ -16951,8 +16953,6 @@ module stdlib_linalg_lapack_z !> where U is an upper triangular matrix, U**H is the conjugate transpose !> of U, and L is lower triangular. !> This is the unblocked version of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_zpbtf2( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17038,11 +17038,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpbtf2 - !> ZPBTRS: solves a system of linear equations A*X = B with a Hermitian - !> positive definite band matrix A using the Cholesky factorization - !> A = U**H *U or A = L*L**H computed by ZPBTRF. pure subroutine stdlib_zpbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) + !> ZPBTRS solves a system of linear equations A*X = B with a Hermitian + !> positive definite band matrix A using the Cholesky factorization + !> A = U**H *U or A = L*L**H computed by ZPBTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17106,13 +17106,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpbtrs - !> ZPOCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_zpocon( uplo, n, a, lda, anorm, rcond, work, rwork,info ) + !> ZPOCON estimates the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite matrix using the !> Cholesky factorization A = U**H*U or A = L*L**H computed by ZPOTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_zpocon( uplo, n, a, lda, anorm, rcond, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17206,7 +17206,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpocon - !> ZPOEQU: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_zpoequ( n, a, lda, s, scond, amax, info ) + !> ZPOEQU computes row and column scalings intended to equilibrate a !> Hermitian positive definite matrix A and reduce its condition number !> (with respect to the two-norm). S contains the scale factors, !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with @@ -17214,8 +17216,6 @@ module stdlib_linalg_lapack_z !> choice of S puts the condition number of B within a factor N of the !> smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_zpoequ( n, a, lda, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17280,7 +17280,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpoequ - !> ZPOEQUB: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_zpoequb( n, a, lda, s, scond, amax, info ) + !> ZPOEQUB computes row and column scalings intended to equilibrate a !> Hermitian positive definite matrix A and reduce its condition number !> (with respect to the two-norm). S contains the scale factors, !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with @@ -17293,8 +17295,6 @@ module stdlib_linalg_lapack_z !> these factors introduces no additional rounding errors. However, the !> scaled diagonal entries are no longer approximately 1 but lie !> between sqrt(radix) and 1/sqrt(radix). - - pure subroutine stdlib_zpoequb( n, a, lda, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17362,15 +17362,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpoequb - !> ZPOTF2: computes the Cholesky factorization of a complex Hermitian + + pure subroutine stdlib_zpotf2( uplo, n, a, lda, info ) + !> ZPOTF2 computes the Cholesky factorization of a complex Hermitian !> positive definite matrix A. !> The factorization has the form !> A = U**H * U , if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the unblocked version of the algorithm, calling Level 2 BLAS. - - pure subroutine stdlib_zpotf2( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17456,7 +17456,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpotf2 - !> ZPOTRF2: computes the Cholesky factorization of a Hermitian + + pure recursive subroutine stdlib_zpotrf2( uplo, n, a, lda, info ) + !> ZPOTRF2 computes the Cholesky factorization of a Hermitian !> positive definite matrix A using the recursive algorithm. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or @@ -17469,8 +17471,6 @@ module stdlib_linalg_lapack_z !> [ A21 | A22 ] n2 = n-n1 !> The subroutine calls itself to factor A11. Update and scale A21 !> or A12, update A22 then call itself to factor A22. - - pure recursive subroutine stdlib_zpotrf2( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17557,11 +17557,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpotrf2 - !> ZPOTRS: solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A using the Cholesky factorization - !> A = U**H * U or A = L * L**H computed by ZPOTRF. pure subroutine stdlib_zpotrs( uplo, n, nrhs, a, lda, b, ldb, info ) + !> ZPOTRS solves a system of linear equations A*X = B with a Hermitian + !> positive definite matrix A using the Cholesky factorization + !> A = U**H * U or A = L * L**H computed by ZPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17619,14 +17619,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpotrs - !> ZPPCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_zppcon( uplo, n, ap, anorm, rcond, work, rwork, info ) + !> ZPPCON estimates the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite packed matrix using !> the Cholesky factorization A = U**H*U or A = L*L**H computed by !> ZPPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_zppcon( uplo, n, ap, anorm, rcond, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17718,7 +17718,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zppcon - !> ZPPEQU: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_zppequ( uplo, n, ap, s, scond, amax, info ) + !> ZPPEQU computes row and column scalings intended to equilibrate a !> Hermitian positive definite matrix A in packed storage and reduce !> its condition number (with respect to the two-norm). S contains the !> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix @@ -17726,8 +17728,6 @@ module stdlib_linalg_lapack_z !> This choice of S puts the condition number of B within a factor N of !> the smallest possible condition number over all possible diagonal !> scalings. - - pure subroutine stdlib_zppequ( uplo, n, ap, s, scond, amax, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17811,14 +17811,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zppequ - !> ZPPTRF: computes the Cholesky factorization of a complex Hermitian + + pure subroutine stdlib_zpptrf( uplo, n, ap, info ) + !> ZPPTRF computes the Cholesky factorization of a complex Hermitian !> positive definite matrix A stored in packed format. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. - - pure subroutine stdlib_zpptrf( uplo, n, ap, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17897,11 +17897,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpptrf - !> ZPPTRS: solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A in packed storage using the Cholesky - !> factorization A = U**H * U or A = L * L**H computed by ZPPTRF. pure subroutine stdlib_zpptrs( uplo, n, nrhs, ap, b, ldb, info ) + !> ZPPTRS solves a system of linear equations A*X = B with a Hermitian + !> positive definite matrix A in packed storage using the Cholesky + !> factorization A = U**H * U or A = L * L**H computed by ZPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17961,7 +17961,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpptrs - !> ZPSTF2: computes the Cholesky factorization with complete + + pure subroutine stdlib_zpstf2( uplo, n, a, lda, piv, rank, tol, work, info ) + !> ZPSTF2 computes the Cholesky factorization with complete !> pivoting of a complex Hermitian positive semidefinite matrix A. !> The factorization has the form !> P**T * A * P = U**H * U , if UPLO = 'U', @@ -17970,8 +17972,6 @@ module stdlib_linalg_lapack_z !> P is stored as vector PIV. !> This algorithm does not attempt to check that A is positive !> semidefinite. This version of the algorithm calls level 2 BLAS. - - pure subroutine stdlib_zpstf2( uplo, n, a, lda, piv, rank, tol, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18155,7 +18155,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpstf2 - !> ZPSTRF: computes the Cholesky factorization with complete + + pure subroutine stdlib_zpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) + !> ZPSTRF computes the Cholesky factorization with complete !> pivoting of a complex Hermitian positive semidefinite matrix A. !> The factorization has the form !> P**T * A * P = U**H * U , if UPLO = 'U', @@ -18164,8 +18166,6 @@ module stdlib_linalg_lapack_z !> P is stored as vector PIV. !> This algorithm does not attempt to check that A is positive !> semidefinite. This version of the algorithm calls level 3 BLAS. - - pure subroutine stdlib_zpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18381,15 +18381,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpstrf - !> ZPTCON: computes the reciprocal of the condition number (in the + + pure subroutine stdlib_zptcon( n, d, e, anorm, rcond, rwork, info ) + !> ZPTCON computes the reciprocal of the condition number (in the !> 1-norm) of a complex Hermitian positive definite tridiagonal matrix !> using the factorization A = L*D*L**H or A = U**H*D*U computed by !> ZPTTRF. !> Norm(inv(A)) is computed by a direct method, and the reciprocal of !> the condition number is computed as !> RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_zptcon( n, d, e, anorm, rcond, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18455,11 +18455,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zptcon - !> ZPTTRF: computes the L*D*L**H factorization of a complex Hermitian - !> positive definite tridiagonal matrix A. The factorization may also - !> be regarded as having the form A = U**H *D*U. pure subroutine stdlib_zpttrf( n, d, e, info ) + !> ZPTTRF computes the L*D*L**H factorization of a complex Hermitian + !> positive definite tridiagonal matrix A. The factorization may also + !> be regarded as having the form A = U**H *D*U. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18554,14 +18554,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpttrf - !> ZPTTS2: solves a tridiagonal system of the form + + pure subroutine stdlib_zptts2( iuplo, n, nrhs, d, e, b, ldb ) + !> ZPTTS2 solves a tridiagonal system of the form !> A * X = B !> using the factorization A = U**H *D*U or A = L*D*L**H computed by ZPTTRF. !> D is a diagonal matrix specified in the vector D, U (or L) is a unit !> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in !> the vector E, and X and B are N by NRHS matrices. - - pure subroutine stdlib_zptts2( iuplo, n, nrhs, d, e, b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18654,10 +18654,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zptts2 - !> ZROT: applies a plane rotation, where the cos (C) is real and the - !> sin (S) is complex, and the vectors CX and CY are complex. pure subroutine stdlib_zrot( n, cx, incx, cy, incy, c, s ) + !> ZROT applies a plane rotation, where the cos (C) is real and the + !> sin (S) is complex, and the vectors CX and CY are complex. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18699,12 +18699,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zrot - !> ZSPMV: performs the matrix-vector operation + + pure subroutine stdlib_zspmv( uplo, n, alpha, ap, x, incx, beta, y, incy ) + !> ZSPMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix, supplied in packed form. - - pure subroutine stdlib_zspmv( uplo, n, alpha, ap, x, incx, beta, y, incy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18857,12 +18857,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zspmv - !> ZSPR: performs the symmetric rank 1 operation + + pure subroutine stdlib_zspr( uplo, n, alpha, x, incx, ap ) + !> ZSPR performs the symmetric rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a complex scalar, x is an n element vector and A is an !> n by n symmetric matrix, supplied in packed form. - - pure subroutine stdlib_zspr( uplo, n, alpha, x, incx, ap ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18977,15 +18977,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zspr - !> ZSPTRF: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_zsptrf( uplo, n, ap, ipiv, info ) + !> ZSPTRF computes the factorization of a complex symmetric matrix A !> stored in packed format using the Bunch-Kaufman diagonal pivoting !> method: !> 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 symmetric and block diagonal with !> 1-by-1 and 2-by-2 diagonal blocks. - - pure subroutine stdlib_zsptrf( uplo, n, ap, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19306,11 +19306,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsptrf - !> ZSPTRI: computes the inverse of a complex symmetric indefinite matrix - !> A in packed storage using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by ZSPTRF. pure subroutine stdlib_zsptri( uplo, n, ap, ipiv, work, info ) + !> ZSPTRI computes the inverse of a complex symmetric indefinite matrix + !> A in packed storage using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by ZSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19517,11 +19517,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsptri - !> ZSPTRS: solves a system of linear equations A*X = B with a complex - !> symmetric matrix A stored in packed format using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by ZSPTRF. pure subroutine stdlib_zsptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) + !> ZSPTRS solves a system of linear equations A*X = B with a complex + !> symmetric matrix A stored in packed format using the factorization + !> A = U*D*U**T or A = L*D*L**T computed by ZSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19737,7 +19737,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsptrs - !> ZSTEIN: computes the eigenvectors of a real symmetric tridiagonal + + pure subroutine stdlib_zstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & + !> ZSTEIN computes the eigenvectors of a real symmetric tridiagonal !> matrix T corresponding to specified eigenvalues, using inverse !> iteration. !> The maximum number of iterations allowed for each eigenvector is @@ -19746,8 +19748,6 @@ module stdlib_linalg_lapack_z !> array, which may be passed to ZUNMTR or ZUPMTR for back !> transformation to the eigenvectors of a complex Hermitian matrix !> which was reduced to tridiagonal form. - - pure subroutine stdlib_zstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19947,13 +19947,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zstein - !> ZSTEQR: computes all eigenvalues and, optionally, eigenvectors of a + + pure subroutine stdlib_zsteqr( compz, n, d, e, z, ldz, work, info ) + !> ZSTEQR computes all eigenvalues and, optionally, eigenvectors of a !> symmetric tridiagonal matrix using the implicit QL or QR method. !> The eigenvectors of a full or band complex Hermitian matrix can also !> be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this !> matrix to tridiagonal form. - - pure subroutine stdlib_zsteqr( compz, n, d, e, z, ldz, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20267,11 +20267,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsteqr - !> ZSYCONV: converts A given by ZHETRF into L and D or vice-versa. - !> Get nondiagonal elements of D (returned in workspace) and - !> apply or reverse permutation done in TRF. pure subroutine stdlib_zsyconv( uplo, way, n, a, lda, ipiv, e, info ) + !> ZSYCONV converts A given by ZHETRF into L and D or vice-versa. + !> Get nondiagonal elements of D (returned in workspace) and + !> apply or reverse permutation done in TRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20472,8 +20472,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsyconv + + pure subroutine stdlib_zsyconvf( uplo, way, n, a, lda, e, ipiv, info ) !> If parameter WAY = 'C': - !> ZSYCONVF: converts the factorization output format used in + !> ZSYCONVF converts the factorization output format used in !> ZSYTRF provided on entry in parameter A into the factorization !> output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored !> on exit in parameters A and E. It also converts in place details of @@ -20489,8 +20491,6 @@ module stdlib_linalg_lapack_z !> (or ZSYTRF_BK) into the format used in ZSYTRF. !> ZSYCONVF can also convert in Hermitian matrix case, i.e. between !> formats used in ZHETRF and ZHETRF_RK (or ZHETRF_BK). - - pure subroutine stdlib_zsyconvf( uplo, way, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20729,8 +20729,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsyconvf + + pure subroutine stdlib_zsyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) !> If parameter WAY = 'C': - !> ZSYCONVF_ROOK: converts the factorization output format used in + !> ZSYCONVF_ROOK converts the factorization output format used in !> ZSYTRF_ROOK provided on entry in parameter A into the factorization !> output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored !> on exit in parameters A and E. IPIV format for ZSYTRF_ROOK and @@ -20744,8 +20746,6 @@ module stdlib_linalg_lapack_z !> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted. !> ZSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between !> formats used in ZHETRF_ROOK and ZHETRF_RK (or ZHETRF_BK). - - pure subroutine stdlib_zsyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20984,15 +20984,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsyconvf_rook - !> ZSYEQUB: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_zsyequb( uplo, n, a, lda, s, scond, amax, work, info ) + !> ZSYEQUB computes row and column scalings intended to equilibrate a !> symmetric 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. - - pure subroutine stdlib_zsyequb( uplo, n, a, lda, s, scond, amax, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21166,12 +21166,12 @@ module stdlib_linalg_lapack_z scond = max( smin, smlnum ) / min( smax, bignum ) end subroutine stdlib_zsyequb - !> ZSYMV: performs the matrix-vector operation + + pure subroutine stdlib_zsymv( uplo, n, alpha, a, lda, x, incx, beta, y, incy ) + !> ZSYMV performs the matrix-vector operation !> y := alpha*A*x + beta*y, !> where alpha and beta are scalars, x and y are n element vectors and !> A is an n by n symmetric matrix. - - pure subroutine stdlib_zsymv( uplo, n, alpha, a, lda, x, incx, beta, y, incy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21320,12 +21320,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsymv - !> ZSYR: performs the symmetric rank 1 operation + + pure subroutine stdlib_zsyr( uplo, n, alpha, x, incx, a, lda ) + !> ZSYR performs the symmetric rank 1 operation !> A := alpha*x*x**H + A, !> where alpha is a complex scalar, x is an n element vector and A is an !> n by n symmetric matrix. - - pure subroutine stdlib_zsyr( uplo, n, alpha, x, incx, a, lda ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21424,10 +21424,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsyr - !> ZSYSWAPR: applies an elementary permutation on the rows and the columns of - !> a symmetric matrix. pure subroutine stdlib_zsyswapr( uplo, n, a, lda, i1, i2) + !> ZSYSWAPR applies an elementary permutation on the rows and the columns of + !> a symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21492,15 +21492,15 @@ module stdlib_linalg_lapack_z endif end subroutine stdlib_zsyswapr - !> ZSYTF2: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_zsytf2( uplo, n, a, lda, ipiv, info ) + !> ZSYTF2 computes the factorization of a complex symmetric matrix A !> using the Bunch-Kaufman diagonal pivoting method: !> 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, U**T is the transpose of U, and D is symmetric 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. - - pure subroutine stdlib_zsytf2( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21783,7 +21783,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytf2 - !> ZSYTF2_RK: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_zsytf2_rk( uplo, n, a, lda, e, ipiv, info ) + !> ZSYTF2_RK computes the factorization of a complex symmetric matrix A !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), !> where U (or L) is unit upper (or lower) triangular matrix, @@ -21792,8 +21794,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zsytf2_rk( uplo, n, a, lda, e, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22240,15 +22240,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytf2_rk - !> ZSYTF2_ROOK: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_zsytf2_rook( uplo, n, a, lda, ipiv, info ) + !> ZSYTF2_ROOK computes the factorization of a complex symmetric matrix A !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: !> 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, U**T is the transpose of U, and D is symmetric 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. - - pure subroutine stdlib_zsytf2_rook( uplo, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22656,7 +22656,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytf2_rook - !> ZSYTRF: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_zsytrf( uplo, n, a, lda, ipiv, work, lwork, info ) + !> ZSYTRF computes the factorization of a complex symmetric matrix A !> using the Bunch-Kaufman diagonal pivoting method. The form of the !> factorization is !> A = U*D*U**T or A = L*D*L**T @@ -22664,8 +22666,6 @@ module stdlib_linalg_lapack_z !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_zsytrf( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22782,7 +22782,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytrf - !> ZSYTRF_RK: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_zsytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) + !> ZSYTRF_RK computes the factorization of a complex symmetric matrix A !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), !> where U (or L) is unit upper (or lower) triangular matrix, @@ -22791,8 +22793,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zsytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22948,7 +22948,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytrf_rk - !> ZSYTRF_ROOK: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_zsytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) + !> ZSYTRF_ROOK computes the factorization of a complex symmetric 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 @@ -22956,8 +22958,6 @@ module stdlib_linalg_lapack_z !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_zsytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23076,11 +23076,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytrf_rook - !> ZSYTRI: computes the inverse of a complex symmetric indefinite matrix - !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by - !> ZSYTRF. pure subroutine stdlib_zsytri( uplo, n, a, lda, ipiv, work, info ) + !> ZSYTRI computes the inverse of a complex symmetric indefinite matrix + !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by + !> ZSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23264,11 +23264,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytri - !> ZSYTRI_ROOK: computes the inverse of a complex symmetric - !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T - !> computed by ZSYTRF_ROOK. pure subroutine stdlib_zsytri_rook( uplo, n, a, lda, ipiv, work, info ) + !> ZSYTRI_ROOK computes the inverse of a complex symmetric + !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T + !> computed by ZSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23492,11 +23492,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytri_rook - !> ZSYTRS: solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by ZSYTRF. pure subroutine stdlib_zsytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) + !> ZSYTRS solves a system of linear equations A*X = B with a complex + !> symmetric matrix A using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by ZSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23702,11 +23702,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytrs - !> ZSYTRS2: solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by ZSYTRF and converted by ZSYCONV. pure subroutine stdlib_zsytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) + !> ZSYTRS2 solves a system of linear equations A*X = B with a complex + !> symmetric matrix A using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by ZSYTRF and converted by ZSYCONV. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23880,7 +23880,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytrs2 - !> ZSYTRS_3: solves a system of linear equations A * X = B with a complex + + pure subroutine stdlib_zsytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) + !> ZSYTRS_3 solves a system of linear equations A * X = B with a complex !> symmetric matrix A using the factorization computed !> by ZSYTRF_RK or ZSYTRF_BK: !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), @@ -23889,8 +23891,6 @@ module stdlib_linalg_lapack_z !> matrix, P**T is the transpose of P, and D is symmetric and block !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. !> This algorithm is using Level 3 BLAS. - - pure subroutine stdlib_zsytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24037,11 +24037,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytrs_3 - !> ZSYTRS_AA: solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U**T*T*U or - !> A = L*T*L**T computed by ZSYTRF_AA. pure subroutine stdlib_zsytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) + !> ZSYTRS_AA solves a system of linear equations A*X = B with a complex + !> symmetric matrix A using the factorization A = U**T*T*U or + !> A = L*T*L**T computed by ZSYTRF_AA. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24156,11 +24156,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytrs_aa - !> ZSYTRS_ROOK: solves a system of linear equations A*X = B with - !> a complex symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by ZSYTRF_ROOK. pure subroutine stdlib_zsytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) + !> ZSYTRS_ROOK solves a system of linear equations A*X = B with + !> a complex symmetric matrix A using the factorization A = U*D*U**T or + !> A = L*D*L**T computed by ZSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24378,14 +24378,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytrs_rook - !> ZTBRFS: provides error bounds and backward error estimates for the + + pure subroutine stdlib_ztbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& + !> ZTBRFS provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular band !> coefficient matrix. !> The solution matrix X must be computed by ZTBTRS or some other !> means before entering this routine. ZTBRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_ztbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24621,12 +24621,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztbrfs - !> ZTBTRS: solves a triangular system of the form + + pure subroutine stdlib_ztbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) + !> ZTBTRS solves a triangular system of the form !> A * X = B, A**T * X = B, or A**H * X = B, !> where A is a triangular band matrix of order N, and B is an !> N-by-NRHS matrix. A check is made to verify that A is nonsingular. - - pure subroutine stdlib_ztbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24694,16 +24694,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztbtrs + + pure subroutine stdlib_ztfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) !> Level 3 BLAS like routine for A in RFP Format. - !> ZTFSM: solves the matrix equation + !> ZTFSM solves the matrix equation !> op( A )*X = alpha*B or X*op( A ) = alpha*B !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or !> non-unit, upper or lower triangular matrix and op( A ) is one of !> op( A ) = A or op( A ) = A**H. !> A is in Rectangular Full Packed (RFP) Format. !> The matrix X is overwritten on B. - - pure subroutine stdlib_ztfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25196,10 +25196,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztfsm - !> ZTFTTP: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard packed format (TP). pure subroutine stdlib_ztfttp( transr, uplo, n, arf, ap, info ) + !> ZTFTTP copies a triangular matrix A from rectangular full packed + !> format (TF) to standard packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25455,10 +25455,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztfttp - !> ZTFTTR: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard full format (TR). pure subroutine stdlib_ztfttr( transr, uplo, n, arf, a, lda, info ) + !> ZTFTTR copies a triangular matrix A from rectangular full packed + !> format (TF) to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25705,7 +25705,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztfttr - !> ZTGEVC: computes some or all of the right and/or left eigenvectors of + + pure subroutine stdlib_ztgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & + !> ZTGEVC computes some or all of the right and/or left eigenvectors of !> a pair of complex matrices (S,P), where S and P are upper triangular. !> Matrix pairs of this type are produced by the generalized Schur !> factorization of a complex matrix pair (A,B): @@ -25723,8 +25725,6 @@ module stdlib_linalg_lapack_z !> If Q and Z are the unitary factors from the generalized Schur !> factorization of a matrix pair (A,B), then Z*X and Q*Y !> are the matrices of right and left eigenvectors of (A,B). - - pure subroutine stdlib_ztgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & mm, m, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26118,7 +26118,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztgevc - !> ZTGEX2: swaps adjacent diagonal 1 by 1 blocks (A11,B11) and (A22,B22) + + pure subroutine stdlib_ztgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, info ) + !> ZTGEX2 swaps adjacent diagonal 1 by 1 blocks (A11,B11) and (A22,B22) !> in an upper triangular matrix pair (A, B) by an unitary equivalence !> transformation. !> (A, B) must be in generalized Schur canonical form, that is, A and @@ -26127,8 +26129,6 @@ module stdlib_linalg_lapack_z !> updated. !> Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H !> Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H - - pure subroutine stdlib_ztgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26260,7 +26260,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztgex2 - !> ZTGEXC: reorders the generalized Schur decomposition of a complex + + pure subroutine stdlib_ztgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & + !> ZTGEXC reorders the generalized Schur decomposition of a complex !> matrix pair (A,B), using an unitary equivalence transformation !> (A, B) := Q * (A, B) * Z**H, so that the diagonal block of (A, B) with !> row index IFST is moved to row ILST. @@ -26270,8 +26272,6 @@ module stdlib_linalg_lapack_z !> updated. !> Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H !> Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H - - pure subroutine stdlib_ztgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26344,11 +26344,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztgexc - !> ZTPLQT2: computes a LQ a factorization of a complex "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. pure subroutine stdlib_ztplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) + !> ZTPLQT2 computes a LQ a factorization of a complex "triangular-pentagonal" + !> matrix C, which is composed of a triangular block A and pentagonal block B, + !> using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26460,11 +26460,11 @@ module stdlib_linalg_lapack_z end do end subroutine stdlib_ztplqt2 - !> ZTPQRT2: computes a QR factorization of a complex "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. pure subroutine stdlib_ztpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) + !> ZTPQRT2 computes a QR factorization of a complex "triangular-pentagonal" + !> matrix C, which is composed of a triangular block A and pentagonal block B, + !> using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26551,11 +26551,11 @@ module stdlib_linalg_lapack_z end do end subroutine stdlib_ztpqrt2 - !> ZTPRFB: applies a complex "triangular-pentagonal" block reflector H or its - !> conjugate transpose H**H to a complex matrix C, which is composed of two - !> blocks A and B, either from the left or right. pure subroutine stdlib_ztprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & + !> ZTPRFB applies a complex "triangular-pentagonal" block reflector H or its + !> conjugate transpose H**H to a complex matrix C, which is composed of two + !> blocks A and B, either from the left or right. lda, b, ldb, work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26971,14 +26971,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztprfb - !> ZTPRFS: provides error bounds and backward error estimates for the + + pure subroutine stdlib_ztprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & + !> ZTPRFS provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular packed !> coefficient matrix. !> The solution matrix X must be computed by ZTPTRS or some other !> means before entering this routine. ZTPRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_ztprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27222,10 +27222,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztprfs - !> ZTPTRI: computes the inverse of a complex upper or lower triangular - !> matrix A stored in packed format. pure subroutine stdlib_ztptri( uplo, diag, n, ap, info ) + !> ZTPTRI computes the inverse of a complex upper or lower triangular + !> matrix A stored in packed format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27312,13 +27312,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztptri - !> ZTPTRS: solves a triangular system of the form + + pure subroutine stdlib_ztptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) + !> ZTPTRS solves a triangular system of the form !> A * X = B, A**T * X = B, or A**H * X = B, !> where A is a triangular matrix of order N stored in packed format, !> and B is an N-by-NRHS matrix. A check is made to verify that A is !> nonsingular. - - pure subroutine stdlib_ztptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27385,10 +27385,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztptrs - !> ZTPTTF: copies a triangular matrix A from standard packed format (TP) - !> to rectangular full packed format (TF). pure subroutine stdlib_ztpttf( transr, uplo, n, ap, arf, info ) + !> ZTPTTF copies a triangular matrix A from standard packed format (TP) + !> to rectangular full packed format (TF). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27643,10 +27643,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztpttf - !> ZTPTTR: copies a triangular matrix A from standard packed format (TP) - !> to standard full format (TR). pure subroutine stdlib_ztpttr( uplo, n, ap, a, lda, info ) + !> ZTPTTR copies a triangular matrix A from standard packed format (TP) + !> to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27697,7 +27697,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztpttr - !> ZTREVC: computes some or all of the right and/or left eigenvectors of + + pure subroutine stdlib_ztrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & + !> ZTREVC computes some or all of the right and/or left eigenvectors of !> a complex upper triangular matrix T. !> Matrices of this type are produced by the Schur factorization of !> a complex general matrix: A = Q*T*Q**H, as computed by ZHSEQR. @@ -27712,8 +27714,6 @@ module stdlib_linalg_lapack_z !> input matrix. If Q is the unitary factor that reduces a matrix A to !> Schur form T, then Q*X and Q*Y are the matrices of right and left !> eigenvectors of A. - - pure subroutine stdlib_ztrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27897,7 +27897,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrevc - !> ZTREVC3: computes some or all of the right and/or left eigenvectors of + + pure subroutine stdlib_ztrevc3( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & + !> ZTREVC3 computes some or all of the right and/or left eigenvectors of !> a complex upper triangular matrix T. !> Matrices of this type are produced by the Schur factorization of !> a complex general matrix: A = Q*T*Q**H, as computed by ZHSEQR. @@ -27913,8 +27915,6 @@ module stdlib_linalg_lapack_z !> Schur form T, then Q*X and Q*Y are the matrices of right and left !> eigenvectors of A. !> This uses a Level 3 BLAS version of the back transformation. - - pure subroutine stdlib_ztrevc3( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & work, lwork, rwork, lrwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28194,14 +28194,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrevc3 - !> ZTREXC: reorders the Schur factorization of a complex matrix + + pure subroutine stdlib_ztrexc( compq, n, t, ldt, q, ldq, ifst, ilst, info ) + !> ZTREXC reorders the Schur factorization of a complex matrix !> A = Q*T*Q**H, so that the diagonal element of T with row index IFST !> is moved to row ILST. !> The Schur form T is reordered by a unitary similarity transformation !> Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by !> postmultplying it with Z. - - pure subroutine stdlib_ztrexc( compq, n, t, ldt, q, ldq, ifst, ilst, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28273,14 +28273,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrexc - !> ZTRRFS: provides error bounds and backward error estimates for the + + pure subroutine stdlib_ztrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& + !> ZTRRFS provides error bounds and backward error estimates for the !> solution to a system of linear equations with a triangular !> coefficient matrix. !> The solution matrix X must be computed by ZTRTRS or some other !> means before entering this routine. ZTRRFS does not do iterative !> refinement because doing so cannot improve the backward error. - - pure subroutine stdlib_ztrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28514,11 +28514,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrrfs - !> ZTRSNA: estimates reciprocal condition numbers for specified - !> eigenvalues and/or right eigenvectors of a complex upper triangular - !> matrix T (or of any matrix Q*T*Q**H with Q unitary). pure subroutine stdlib_ztrsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm,& + !> ZTRSNA estimates reciprocal condition numbers for specified + !> eigenvalues and/or right eigenvectors of a complex upper triangular + !> matrix T (or of any matrix Q*T*Q**H with Q unitary). m, work, ldwork, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28663,11 +28663,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrsna - !> ZTRTI2: computes the inverse of a complex upper or lower triangular - !> matrix. - !> This is the Level 2 BLAS version of the algorithm. pure subroutine stdlib_ztrti2( uplo, diag, n, a, lda, info ) + !> ZTRTI2 computes the inverse of a complex upper or lower triangular + !> matrix. + !> This is the Level 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28737,11 +28737,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrti2 - !> ZTRTRI: computes the inverse of a complex upper or lower triangular - !> matrix A. - !> This is the Level 3 BLAS version of the algorithm. pure subroutine stdlib_ztrtri( uplo, diag, n, a, lda, info ) + !> ZTRTRI computes the inverse of a complex upper or lower triangular + !> matrix A. + !> This is the Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28824,12 +28824,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrtri - !> ZTRTRS: solves a triangular system of the form + + pure subroutine stdlib_ztrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) + !> ZTRTRS solves a triangular system of the form !> A * X = B, A**T * X = B, or A**H * X = B, !> where A is a triangular matrix of order N, and B is an N-by-NRHS !> matrix. A check is made to verify that A is nonsingular. - - pure subroutine stdlib_ztrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28884,10 +28884,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrtrs - !> ZTRTTF: copies a triangular matrix A from standard full format (TR) - !> to rectangular full packed format (TF) . pure subroutine stdlib_ztrttf( transr, uplo, n, a, lda, arf, info ) + !> ZTRTTF copies a triangular matrix A from standard full format (TR) + !> to rectangular full packed format (TF) . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29133,10 +29133,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrttf - !> ZTRTTP: copies a triangular matrix A from full format (TR) to standard - !> packed format (TP). pure subroutine stdlib_ztrttp( uplo, n, a, lda, ap, info ) + !> ZTRTTP copies a triangular matrix A from full format (TR) to standard + !> packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29187,14 +29187,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrttp - !> ZTZRZF: reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A + + pure subroutine stdlib_ztzrzf( m, n, a, lda, tau, work, lwork, info ) + !> ZTZRZF reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A !> to upper triangular form by means of unitary transformations. !> The upper trapezoidal matrix A is factored as !> A = ( R 0 ) * Z, !> where Z is an N-by-N unitary matrix and R is an M-by-M upper !> triangular matrix. - - pure subroutine stdlib_ztzrzf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29303,7 +29303,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztzrzf - !> ZUNBDB: simultaneously bidiagonalizes the blocks of an M-by-M + + subroutine stdlib_zunbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & + !> ZUNBDB simultaneously bidiagonalizes the blocks of an M-by-M !> partitioned unitary matrix X: !> [ B11 | B12 0 0 ] !> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**H @@ -29319,8 +29321,6 @@ module stdlib_linalg_lapack_z !> represented implicitly by Householder vectors. !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_zunbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29626,7 +29626,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunbdb - !> ZUNBDB6: orthogonalizes the column vector + + pure subroutine stdlib_zunbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & + !> ZUNBDB6 orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] !> with respect to the columns of @@ -29635,8 +29637,6 @@ module stdlib_linalg_lapack_z !> The columns of Q must be orthonormal. !> If the projection is zero according to Kahan's "twice is enough" !> criterion, then the zero vector is returned. - - pure subroutine stdlib_zunbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29754,13 +29754,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunbdb6 - !> ZUNG2L: generates an m by n complex matrix Q with orthonormal columns, + + pure subroutine stdlib_zung2l( m, n, k, a, lda, tau, work, info ) + !> ZUNG2L generates an m by n complex matrix Q with orthonormal columns, !> which is defined as the last n columns of a product of k elementary !> reflectors of order m !> Q = H(k) . . . H(2) H(1) !> as returned by ZGEQLF. - - pure subroutine stdlib_zung2l( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29818,13 +29818,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zung2l - !> ZUNG2R: generates an m by n complex matrix Q with orthonormal columns, + + pure subroutine stdlib_zung2r( m, n, k, a, lda, tau, work, info ) + !> ZUNG2R generates an m by n complex matrix Q with orthonormal columns, !> which is defined as the first n columns of a product of k elementary !> reflectors of order m !> Q = H(1) H(2) . . . H(k) !> as returned by ZGEQRF. - - pure subroutine stdlib_zung2r( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29883,13 +29883,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zung2r - !> ZUNGL2: generates an m-by-n complex matrix Q with orthonormal rows, + + pure subroutine stdlib_zungl2( m, n, k, a, lda, tau, work, info ) + !> ZUNGL2 generates an m-by-n complex matrix Q with orthonormal rows, !> which is defined as the first m rows of a product of k elementary !> reflectors of order n !> Q = H(k)**H . . . H(2)**H H(1)**H !> as returned by ZGELQF. - - pure subroutine stdlib_zungl2( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29954,13 +29954,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungl2 - !> ZUNGLQ: generates an M-by-N complex matrix Q with orthonormal rows, + + pure subroutine stdlib_zunglq( m, n, k, a, lda, tau, work, lwork, info ) + !> ZUNGLQ generates an M-by-N complex matrix Q with orthonormal rows, !> which is defined as the first M rows of a product of K elementary !> reflectors of order N !> Q = H(k)**H . . . H(2)**H H(1)**H !> as returned by ZGELQF. - - pure subroutine stdlib_zunglq( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30070,13 +30070,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunglq - !> ZUNGQL: generates an M-by-N complex matrix Q with orthonormal columns, + + pure subroutine stdlib_zungql( m, n, k, a, lda, tau, work, lwork, info ) + !> ZUNGQL generates an M-by-N complex matrix Q with orthonormal columns, !> which is defined as the last N columns of a product of K elementary !> reflectors of order M !> Q = H(k) . . . H(2) H(1) !> as returned by ZGEQLF. - - pure subroutine stdlib_zungql( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30191,13 +30191,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungql - !> ZUNGQR: generates an M-by-N complex matrix Q with orthonormal columns, + + pure subroutine stdlib_zungqr( m, n, k, a, lda, tau, work, lwork, info ) + !> ZUNGQR generates an M-by-N complex matrix Q with orthonormal columns, !> which is defined as the first N columns of a product of K elementary !> reflectors of order M !> Q = H(1) H(2) . . . H(k) !> as returned by ZGEQRF. - - pure subroutine stdlib_zungqr( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30307,13 +30307,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungqr - !> ZUNGR2: generates an m by n complex matrix Q with orthonormal rows, + + pure subroutine stdlib_zungr2( m, n, k, a, lda, tau, work, info ) + !> ZUNGR2 generates an m by n complex matrix Q with orthonormal rows, !> which is defined as the last m rows of a product of k elementary !> reflectors of order n !> Q = H(1)**H H(2)**H . . . H(k)**H !> as returned by ZGERQF. - - pure subroutine stdlib_zungr2( m, n, k, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30375,13 +30375,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungr2 - !> ZUNGRQ: generates an M-by-N complex matrix Q with orthonormal rows, + + pure subroutine stdlib_zungrq( m, n, k, a, lda, tau, work, lwork, info ) + !> ZUNGRQ generates an M-by-N complex matrix Q with orthonormal rows, !> which is defined as the last M rows of a product of K elementary !> reflectors of order N !> Q = H(1)**H H(2)**H . . . H(k)**H !> as returned by ZGERQF. - - pure subroutine stdlib_zungrq( m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30497,7 +30497,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungrq - !> ZUNGTSQR_ROW: generates an M-by-N complex matrix Q_out with + + pure subroutine stdlib_zungtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) + !> ZUNGTSQR_ROW generates an M-by-N complex matrix Q_out with !> orthonormal columns from the output of ZLATSQR. These N orthonormal !> columns are the first N columns of a product of complex unitary !> matrices Q(k)_in of order M, which are returned by ZLATSQR in @@ -30512,8 +30514,6 @@ module stdlib_linalg_lapack_z !> starting in the bottom row block and continues to the top row block !> (hence _ROW in the routine name). This sweep is in reverse order of !> the order in which ZLATSQR generates the output blocks. - - pure subroutine stdlib_zungtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30822,7 +30822,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunm22 - !> ZUNM2L: overwrites the general complex m-by-n matrix C with + + pure subroutine stdlib_zunm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> ZUNM2L overwrites the general complex m-by-n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -30832,8 +30834,6 @@ module stdlib_linalg_lapack_z !> Q = H(k) . . . H(2) H(1) !> as returned by ZGEQLF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_zunm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30921,7 +30921,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunm2l - !> ZUNM2R: overwrites the general complex m-by-n matrix C with + + pure subroutine stdlib_zunm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> ZUNM2R overwrites the general complex m-by-n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -30931,8 +30933,6 @@ module stdlib_linalg_lapack_z !> Q = H(1) H(2) . . . H(k) !> as returned by ZGEQRF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_zunm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31024,7 +31024,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunm2r - !> ZUNML2: overwrites the general complex m-by-n matrix C with + + pure subroutine stdlib_zunml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> ZUNML2 overwrites the general complex m-by-n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -31034,8 +31036,6 @@ module stdlib_linalg_lapack_z !> Q = H(k)**H . . . H(2)**H H(1)**H !> as returned by ZGELQF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_zunml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31130,7 +31130,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunml2 - !> ZUNMLQ: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_zunmlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> ZUNMLQ 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 @@ -31139,8 +31141,6 @@ module stdlib_linalg_lapack_z !> Q = H(k)**H . . . H(2)**H H(1)**H !> as returned by ZGELQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_zunmlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31273,7 +31273,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmlq - !> ZUNMQL: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_zunmql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> ZUNMQL 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 @@ -31282,8 +31284,6 @@ module stdlib_linalg_lapack_z !> Q = H(k) . . . H(2) H(1) !> as returned by ZGEQLF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_zunmql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31410,7 +31410,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmql - !> ZUNMQR: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_zunmqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> ZUNMQR 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 @@ -31419,8 +31421,6 @@ module stdlib_linalg_lapack_z !> Q = H(1) H(2) . . . H(k) !> as returned by ZGEQRF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_zunmqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31547,7 +31547,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmqr - !> ZUNMR2: overwrites the general complex m-by-n matrix C with + + pure subroutine stdlib_zunmr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) + !> ZUNMR2 overwrites the general complex m-by-n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -31557,8 +31559,6 @@ module stdlib_linalg_lapack_z !> Q = H(1)**H H(2)**H . . . H(k)**H !> as returned by ZGERQF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_zunmr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31648,7 +31648,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmr2 - !> ZUNMR3: overwrites the general complex m by n matrix C with + + pure subroutine stdlib_zunmr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) + !> ZUNMR3 overwrites the general complex m by n matrix C with !> Q * C if SIDE = 'L' and TRANS = 'N', or !> Q**H* C if SIDE = 'L' and TRANS = 'C', or !> C * Q if SIDE = 'R' and TRANS = 'N', or @@ -31658,8 +31660,6 @@ module stdlib_linalg_lapack_z !> Q = H(1) H(2) . . . H(k) !> as returned by ZTZRZF. Q is of order m if SIDE = 'L' and of order n !> if SIDE = 'R'. - - pure subroutine stdlib_zunmr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31753,7 +31753,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmr3 - !> ZUNMRQ: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_zunmrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) + !> ZUNMRQ 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 @@ -31762,8 +31764,6 @@ module stdlib_linalg_lapack_z !> Q = H(1)**H H(2)**H . . . H(k)**H !> as returned by ZGERQF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_zunmrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31896,7 +31896,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmrq - !> ZUNMRZ: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_zunmrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & + !> ZUNMRZ 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 @@ -31905,8 +31907,6 @@ module stdlib_linalg_lapack_z !> Q = H(1) H(2) . . . H(k) !> as returned by ZTZRZF. Q is of order M if SIDE = 'L' and of order N !> if SIDE = 'R'. - - pure subroutine stdlib_zunmrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32051,7 +32051,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmrz - !> ZBBCSD: computes the CS decomposition of a unitary matrix in + + pure subroutine stdlib_zbbcsd( jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q,theta, phi, u1, & + !> ZBBCSD computes the CS decomposition of a unitary matrix in !> bidiagonal-block form, !> [ B11 | B12 0 0 ] !> [ 0 | 0 -I 0 ] @@ -32072,8 +32074,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zbbcsd( 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 ) ! -- lapack computational routine -- @@ -32664,7 +32664,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zbbcsd - !> ZBDSQR: computes the singular values and, optionally, the right and/or + + pure subroutine stdlib_zbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, rwork,& + !> ZBDSQR 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 @@ -32688,8 +32690,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, rwork,& info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33127,14 +33127,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zbdsqr - !> ZGBCON: estimates the reciprocal of the condition number of a complex + + pure subroutine stdlib_zgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, rwork, & + !> ZGBCON 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 ZGBTRF. !> 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)) ). - - pure subroutine stdlib_zgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, rwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33261,11 +33261,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgbcon - !> ZGBTRF: 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. pure subroutine stdlib_zgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) + !> ZGBTRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33511,12 +33511,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgbtrf - !> ZGBTRS: solves a system of linear equations + + pure subroutine stdlib_zgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) + !> ZGBTRS 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 ZGBTRF. - - pure subroutine stdlib_zgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33624,11 +33624,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgbtrs - !> ZGEBD2: reduces a complex general m by n matrix A to upper or lower - !> real 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. pure subroutine stdlib_zgebd2( m, n, a, lda, d, e, tauq, taup, work, info ) + !> ZGEBD2 reduces a complex general m by n matrix A to upper or lower + !> real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33722,14 +33722,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgebd2 - !> ZGECON: estimates the reciprocal of the condition number of a general + + pure subroutine stdlib_zgecon( norm, n, a, lda, anorm, rcond, work, rwork,info ) + !> ZGECON 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 ZGETRF. !> 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)) ). - - pure subroutine stdlib_zgecon( norm, n, a, lda, anorm, rcond, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33828,10 +33828,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgecon - !> ZGEHD2: reduces a complex general matrix A to upper Hessenberg form H - !> by a unitary similarity transformation: Q**H * A * Q = H . pure subroutine stdlib_zgehd2( n, ilo, ihi, a, lda, tau, work, info ) + !> ZGEHD2 reduces a complex general matrix A to upper Hessenberg form H + !> by a unitary similarity transformation: Q**H * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33880,14 +33880,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgehd2 - !> ZGELQ2: computes an LQ factorization of a complex m-by-n matrix A: + + pure subroutine stdlib_zgelq2( m, n, a, lda, tau, work, info ) + !> ZGELQ2 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. - - pure subroutine stdlib_zgelq2( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33936,14 +33936,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelq2 - !> ZGELQF: computes an LQ factorization of a complex M-by-N matrix A: + + pure subroutine stdlib_zgelqf( m, n, a, lda, tau, work, lwork, info ) + !> ZGELQF 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. - - pure subroutine stdlib_zgelqf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34033,12 +34033,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelqf - !> ZGELQT3: recursively computes a LQ factorization of a complex M-by-N + + pure recursive subroutine stdlib_zgelqt3( m, n, a, lda, t, ldt, info ) + !> ZGELQT3 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. - - pure recursive subroutine stdlib_zgelqt3( m, n, a, lda, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34123,7 +34123,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelqt3 - !> ZGEMLQT: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_zgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) + !> ZGEMLQT 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 @@ -34132,8 +34134,6 @@ module stdlib_linalg_lapack_z !> Q = H(1) H(2) . . . H(K) = I - V T V**H !> generated using the compact WY representation as returned by ZGELQT. !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. - - pure subroutine stdlib_zgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34221,7 +34221,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgemlqt - !> ZGEMQRT: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_zgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) + !> ZGEMQRT 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 @@ -34230,8 +34232,6 @@ module stdlib_linalg_lapack_z !> Q = H(1) H(2) . . . H(K) = I - V T V**H !> generated using the compact WY representation as returned by ZGEQRT. !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. - - pure subroutine stdlib_zgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34319,10 +34319,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgemqrt - !> ZGEQL2: computes a QL factorization of a complex m by n matrix A: - !> A = Q * L. pure subroutine stdlib_zgeql2( m, n, a, lda, tau, work, info ) + !> ZGEQL2 computes a QL factorization of a complex m by n matrix A: + !> A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34368,10 +34368,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeql2 - !> ZGEQLF: computes a QL factorization of a complex M-by-N matrix A: - !> A = Q * L. pure subroutine stdlib_zgeqlf( m, n, a, lda, tau, work, lwork, info ) + !> ZGEQLF computes a QL factorization of a complex M-by-N matrix A: + !> A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34474,15 +34474,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeqlf - !> ZGEQR2: computes a QR factorization of a complex m-by-n matrix A: + + pure subroutine stdlib_zgeqr2( m, n, a, lda, tau, work, info ) + !> ZGEQR2 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. - - pure subroutine stdlib_zgeqr2( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34529,7 +34529,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeqr2 - !> ZGEQR2P: computes a QR factorization of a complex m-by-n matrix A: + + subroutine stdlib_zgeqr2p( m, n, a, lda, tau, work, info ) + !> ZGEQR2P computes a QR factorization of a complex m-by-n matrix A: !> A = Q * ( R ), !> ( 0 ) !> where: @@ -34537,8 +34539,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zgeqr2p( m, n, a, lda, tau, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34585,15 +34585,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeqr2p - !> ZGEQRF: computes a QR factorization of a complex M-by-N matrix A: + + pure subroutine stdlib_zgeqrf( m, n, a, lda, tau, work, lwork, info ) + !> ZGEQRF 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. - - pure subroutine stdlib_zgeqrf( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34687,6 +34687,8 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeqrf + + subroutine stdlib_zgeqrfp( m, n, a, lda, tau, work, lwork, info ) !> ZGEQR2P computes a QR factorization of a complex M-by-N matrix A: !> A = Q * ( R ), !> ( 0 ) @@ -34695,8 +34697,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zgeqrfp( m, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34786,10 +34786,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeqrfp - !> ZGEQRT2: computes a QR factorization of a complex M-by-N matrix A, - !> using the compact WY representation of Q. pure subroutine stdlib_zgeqrt2( m, n, a, lda, t, ldt, info ) + !> ZGEQRT2 computes a QR factorization of a complex M-by-N matrix A, + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34854,12 +34854,12 @@ module stdlib_linalg_lapack_z end do end subroutine stdlib_zgeqrt2 - !> ZGEQRT3: recursively computes a QR factorization of a complex M-by-N + + pure recursive subroutine stdlib_zgeqrt3( m, n, a, lda, t, ldt, info ) + !> ZGEQRT3 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. - - pure recursive subroutine stdlib_zgeqrt3( m, n, a, lda, t, ldt, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34942,10 +34942,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeqrt3 - !> ZGERQ2: computes an RQ factorization of a complex m by n matrix A: - !> A = R * Q. pure subroutine stdlib_zgerq2( m, n, a, lda, tau, work, info ) + !> ZGERQ2 computes an RQ factorization of a complex m by n matrix A: + !> A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34993,10 +34993,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgerq2 - !> ZGERQF: computes an RQ factorization of a complex M-by-N matrix A: - !> A = R * Q. pure subroutine stdlib_zgerqf( m, n, a, lda, tau, work, lwork, info ) + !> ZGERQF computes an RQ factorization of a complex M-by-N matrix A: + !> A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35099,12 +35099,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgerqf - !> ZGESC2: solves a system of linear equations + + pure subroutine stdlib_zgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) + !> ZGESC2 solves a system of linear equations !> A * X = scale* RHS !> with a general N-by-N matrix A using the LU factorization with !> complete pivoting computed by ZGETC2. - - pure subroutine stdlib_zgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35158,7 +35158,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgesc2 - !> ZGETRF2: computes an LU factorization of a general M-by-N matrix A + + pure recursive subroutine stdlib_zgetrf2( m, n, a, lda, ipiv, info ) + !> ZGETRF2 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 @@ -35177,8 +35179,6 @@ module stdlib_linalg_lapack_z !> do the swaps on [ --- ], solve A12, update A22, !> [ A22 ] !> then calls itself to factor A22 and do the swaps on A21. - - pure recursive subroutine stdlib_zgetrf2( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35274,12 +35274,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgetrf2 - !> ZGETRI: computes the inverse of a matrix using the LU factorization + + pure subroutine stdlib_zgetri( n, a, lda, ipiv, work, lwork, info ) + !> ZGETRI computes the inverse of a matrix using the LU factorization !> computed by ZGETRF. !> This method inverts U and then computes inv(A) by solving the system !> inv(A)*L = inv(U) for inv(A). - - pure subroutine stdlib_zgetri( n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35376,12 +35376,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgetri - !> ZGETRS: solves a system of linear equations + + pure subroutine stdlib_zgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) + !> ZGETRS 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 ZGETRF. - - pure subroutine stdlib_zgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35445,7 +35445,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgetrs - !> ZGGHRD: reduces a pair of complex matrices (A,B) to generalized upper + + pure subroutine stdlib_zgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & + !> ZGGHRD 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 @@ -35468,8 +35470,6 @@ module stdlib_linalg_lapack_z !> If Q1 is the unitary matrix from the QR factorization of B in the !> original equation A*x = lambda*B*x, then ZGGHRD reduces the original !> problem to generalized Hessenberg form. - - pure subroutine stdlib_zgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35577,7 +35577,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgghrd - !> ZGGQRF: computes a generalized QR factorization of an N-by-M matrix A + + pure subroutine stdlib_zggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) + !> ZGGQRF 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, @@ -35595,8 +35597,6 @@ module stdlib_linalg_lapack_z !> inv(B)*A = Z**H * (inv(T)*R) !> where inv(B) denotes the inverse of the matrix B, and Z**H denotes the !> conjugate transpose of matrix Z. - - pure subroutine stdlib_zggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35655,7 +35655,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zggqrf - !> ZGGRQF: computes a generalized RQ factorization of an M-by-N matrix A + + pure subroutine stdlib_zggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) + !> ZGGRQF 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 @@ -35673,8 +35675,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35733,12 +35733,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zggrqf - !> ZGTTRS: solves one of the systems of equations + + pure subroutine stdlib_zgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) + !> ZGTTRS 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 ZGTTRF. - - pure subroutine stdlib_zgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35799,10 +35799,10 @@ module stdlib_linalg_lapack_z end if end subroutine stdlib_zgttrs - !> ZHB2ST_KERNELS: is an internal routine used by the ZHETRD_HB2ST - !> subroutine. pure subroutine stdlib_zhb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, lda, & + !> ZHB2ST_KERNELS is an internal routine used by the ZHETRD_HB2ST + !> subroutine. v, tau, ldvt, work) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35944,15 +35944,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhb2st_kernels - !> ZHEEQUB: computes row and column scalings intended to equilibrate a + + pure subroutine stdlib_zheequb( uplo, n, a, lda, s, scond, amax, work, info ) + !> ZHEEQUB 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. - - pure subroutine stdlib_zheequb( uplo, n, a, lda, s, scond, amax, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36126,15 +36126,15 @@ module stdlib_linalg_lapack_z scond = max( smin, smlnum ) / min( smax, bignum ) end subroutine stdlib_zheequb - !> ZHEGS2: reduces a complex Hermitian-definite generalized + + pure subroutine stdlib_zhegs2( itype, uplo, n, a, lda, b, ldb, info ) + !> ZHEGS2 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 ZPOTRF. - - pure subroutine stdlib_zhegs2( itype, uplo, n, a, lda, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36259,15 +36259,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhegs2 - !> ZHEGST: reduces a complex Hermitian-definite generalized + + pure subroutine stdlib_zhegst( itype, uplo, n, a, lda, b, ldb, info ) + !> ZHEGST 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 ZPOTRF. - - pure subroutine stdlib_zhegst( itype, uplo, n, a, lda, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36398,11 +36398,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhegst - !> ZHETD2: reduces a complex Hermitian matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. pure subroutine stdlib_zhetd2( uplo, n, a, lda, d, e, tau, info ) + !> ZHETD2 reduces a complex Hermitian matrix A to real symmetric + !> tridiagonal form T by a unitary similarity transformation: + !> Q**H * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36502,11 +36502,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetd2 - !> ZHETRD: reduces a complex Hermitian matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. pure subroutine stdlib_zhetrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) + !> ZHETRD reduces a complex Hermitian matrix A to real symmetric + !> tridiagonal form T by a unitary similarity transformation: + !> Q**H * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36630,11 +36630,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrd - !> ZHETRD_HB2ST: reduces a complex Hermitian band matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. pure subroutine stdlib_zhetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & + !> ZHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric + !> tridiagonal form T by a unitary similarity transformation: + !> Q**H * A * Q = T. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36903,11 +36903,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrd_hb2st - !> ZHETRD_HE2HB: reduces a complex Hermitian matrix A to complex Hermitian - !> band-diagonal form AB by a unitary similarity transformation: - !> Q**H * A * Q = AB. pure subroutine stdlib_zhetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) + !> ZHETRD_HE2HB reduces a complex Hermitian matrix A to complex Hermitian + !> band-diagonal form AB by a unitary similarity transformation: + !> Q**H * A * Q = AB. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37079,7 +37079,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrd_he2hb - !> ZHETRF: computes the factorization of a complex Hermitian matrix A + + pure subroutine stdlib_zhetrf( uplo, n, a, lda, ipiv, work, lwork, info ) + !> ZHETRF 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 @@ -37087,8 +37089,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zhetrf( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37205,7 +37205,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrf - !> ZHETRF_RK: computes the factorization of a complex Hermitian matrix A + + pure subroutine stdlib_zhetrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) + !> ZHETRF_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, @@ -37214,8 +37216,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zhetrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37371,7 +37371,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrf_rk - !> ZHETRF_ROOK: computes the factorization of a complex Hermitian matrix A + + pure subroutine stdlib_zhetrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) + !> ZHETRF_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 @@ -37379,8 +37381,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zhetrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37499,11 +37499,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrf_rook - !> ZHETRS: 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 ZHETRF. pure subroutine stdlib_zhetrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) + !> ZHETRS 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 ZHETRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37730,11 +37730,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrs - !> ZHETRS2: 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 ZHETRF and converted by ZSYCONV. pure subroutine stdlib_zhetrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) + !> ZHETRS2 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 ZHETRF and converted by ZSYCONV. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37911,11 +37911,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrs2 - !> ZHETRS_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 ZHETRF_AA. pure subroutine stdlib_zhetrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) + !> ZHETRS_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 ZHETRF_AA. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38032,11 +38032,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrs_aa - !> ZHETRS_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 ZHETRF_ROOK. pure subroutine stdlib_zhetrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) + !> ZHETRS_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 ZHETRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38271,11 +38271,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrs_rook - !> ZHPTRD: 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. pure subroutine stdlib_zhptrd( uplo, n, ap, d, e, tau, info ) + !> ZHPTRD 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38375,11 +38375,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhptrd - !> ZHPTRS: 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 ZHPTRF. pure subroutine stdlib_zhptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) + !> ZHPTRS 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 ZHPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38616,10 +38616,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhptrs - !> ZLA_GBRCOND_C: Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. real(dp) function stdlib_zla_gbrcond_c( trans, n, kl, ku, ab,ldab, afb, ldafb, ipiv,c, & + !> ZLA_GBRCOND_C Computes the infinity norm condition number of + !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. capply, info, work,rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38764,10 +38764,10 @@ module stdlib_linalg_lapack_z return end function stdlib_zla_gbrcond_c - !> ZLA_GERCOND_C: computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. real(dp) function stdlib_zla_gercond_c( trans, n, a, lda, af,ldaf, ipiv, c, capply,info, & + !> ZLA_GERCOND_C computes the infinity norm condition number of + !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. work, rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38905,10 +38905,10 @@ module stdlib_linalg_lapack_z return end function stdlib_zla_gercond_c - !> ZLA_HERCOND_C: computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. real(dp) function stdlib_zla_hercond_c( uplo, n, a, lda, af,ldaf, ipiv, c, capply,info, work,& + !> ZLA_HERCOND_C computes the infinity norm condition number of + !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39055,14 +39055,14 @@ module stdlib_linalg_lapack_z return end function stdlib_zla_hercond_c - !> ZLA_HERPVGRW: computes the reciprocal pivot growth factor + + real(dp) function stdlib_zla_herpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) + !> ZLA_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. - - real(dp) function stdlib_zla_herpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39244,10 +39244,10 @@ module stdlib_linalg_lapack_z stdlib_zla_herpvgrw = rpvgrw end function stdlib_zla_herpvgrw - !> ZLA_PORCOND_C: Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector real(dp) function stdlib_zla_porcond_c( uplo, n, a, lda, af,ldaf, c, capply, info,work, & + !> ZLA_PORCOND_C Computes the infinity norm condition number of + !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39394,10 +39394,10 @@ module stdlib_linalg_lapack_z return end function stdlib_zla_porcond_c - !> ZLA_SYRCOND_C: Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. real(dp) function stdlib_zla_syrcond_c( uplo, n, a, lda, af,ldaf, ipiv, c, capply,info, work,& + !> ZLA_SYRCOND_C Computes the infinity norm condition number of + !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39545,14 +39545,14 @@ module stdlib_linalg_lapack_z return end function stdlib_zla_syrcond_c - !> ZLA_SYRPVGRW: computes the reciprocal pivot growth factor + + real(dp) function stdlib_zla_syrpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) + !> ZLA_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. - - real(dp) function stdlib_zla_syrpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39734,15 +39734,15 @@ module stdlib_linalg_lapack_z stdlib_zla_syrpvgrw = rpvgrw end function stdlib_zla_syrpvgrw - !> ZLABRD: reduces the first NB rows and columns of a complex general + + pure subroutine stdlib_zlabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) + !> ZLABRD 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 ZGEBRD - - pure subroutine stdlib_zlabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39884,7 +39884,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlabrd - !> ZLAED7: computes the updated eigensystem of a diagonal + + pure subroutine stdlib_zlaed7( n, cutpnt, qsiz, tlvls, curlvl, curpbm, d, q,ldq, rho, indxq, & + !> ZLAED7 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 @@ -39908,8 +39910,6 @@ module stdlib_linalg_lapack_z !> directly using the updated eigenvalues. The eigenvectors for !> the current problem are multiplied with the eigenvectors from !> the overall problem. - - pure subroutine stdlib_zlaed7( n, cutpnt, qsiz, tlvls, curlvl, curpbm, d, q,ldq, rho, indxq, & qstore, qptr, prmptr, perm,givptr, givcol, givnum, work, rwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40011,11 +40011,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaed7 - !> ZLAEIN: uses inverse iteration to find a right or left eigenvector - !> corresponding to the eigenvalue W of a complex upper Hessenberg - !> matrix H. pure subroutine stdlib_zlaein( rightv, noinit, n, h, ldh, w, v, b, ldb, rwork,eps3, smlnum, & + !> ZLAEIN uses inverse iteration to find a right or left eigenvector + !> corresponding to the eigenvalue W of a complex upper Hessenberg + !> matrix H. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40155,7 +40155,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaein - !> ZLAGS2: computes 2-by-2 unitary matrices U, V and Q, such + + pure subroutine stdlib_zlags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) + !> ZLAGS2 computes 2-by-2 unitary matrices U, V and Q, such !> that if ( UPPER ) then !> U**H *A*Q = U**H *( A1 A2 )*Q = ( x 0 ) !> ( 0 A3 ) ( x x ) @@ -40179,8 +40181,6 @@ module stdlib_linalg_lapack_z !> then the transformed (2,2) element of B is not zero, except when the !> first rows of input A and B are parallel and the second rows are !> zero. - - pure subroutine stdlib_zlags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40342,12 +40342,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlags2 - !> ZLAHQR: is an auxiliary routine called by CHSEQR to update the + + pure subroutine stdlib_zlahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, info & + !> ZLAHQR 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. - - pure subroutine stdlib_zlahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, info & ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40628,14 +40628,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlahqr - !> ZLAHR2: reduces the first NB columns of A complex general n-BY-(n-k+1) + + pure subroutine stdlib_zlahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) + !> ZLAHR2 reduces the first NB columns of A complex general n-BY-(n-k+1) !> matrix A so that elements below the k-th subdiagonal are zero. The !> reduction is performed by an unitary similarity transformation !> Q**H * A * Q. The routine returns the matrices V and T which determine !> Q as a block reflector I - V*T*V**H, and also the matrix Y = A * V * T. !> This is an auxiliary routine called by ZGEHRD. - - pure subroutine stdlib_zlahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -40718,7 +40718,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlahr2 - !> ZLALS0: applies back the multiplying factors of either the left or the + + pure subroutine stdlib_zlals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, & + !> ZLALS0 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. @@ -40738,8 +40740,6 @@ module stdlib_linalg_lapack_z !> null space. !> (3R) The inverse transformation of (2L). !> (4R) The inverse transformation of (1L). - - pure subroutine stdlib_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 ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40963,7 +40963,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlals0 - !> ZLALSA: is an itermediate step in solving the least squares problem + + pure subroutine stdlib_zlalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, difl,& + !> ZLALSA 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.). @@ -40972,8 +40974,6 @@ module stdlib_linalg_lapack_z !> ICOMPQ = 1, ZLALSA applies the right singular vector matrix to the !> right hand side. The singular vector matrices were generated in !> compact form by ZLALSA. - - pure subroutine stdlib_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 ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41266,7 +41266,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlalsa - !> ZLALSD: uses the singular value decomposition of A to solve the least + + pure subroutine stdlib_zlalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, rwork, & + !> ZLALSD 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. @@ -41280,8 +41282,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zlalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, rwork, & iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41677,11 +41677,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlalsd - !> ZLANGB: 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. real(dp) function stdlib_zlangb( norm, n, kl, ku, ab, ldab,work ) + !> ZLANGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41752,11 +41752,11 @@ module stdlib_linalg_lapack_z return end function stdlib_zlangb - !> ZLANGE: 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. real(dp) function stdlib_zlange( norm, m, n, a, lda, work ) + !> ZLANGE 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41824,11 +41824,11 @@ module stdlib_linalg_lapack_z return end function stdlib_zlange - !> ZLANGT: 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. pure real(dp) function stdlib_zlangt( norm, n, dl, d, du ) + !> ZLANGT 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41900,11 +41900,11 @@ module stdlib_linalg_lapack_z return end function stdlib_zlangt - !> ZLANHB: 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. real(dp) function stdlib_zlanhb( norm, uplo, n, k, ab, ldab,work ) + !> ZLANHB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42019,11 +42019,11 @@ module stdlib_linalg_lapack_z return end function stdlib_zlanhb - !> ZLANHE: 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. real(dp) function stdlib_zlanhe( norm, uplo, n, a, lda, work ) + !> ZLANHE 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42129,11 +42129,11 @@ module stdlib_linalg_lapack_z return end function stdlib_zlanhe - !> ZLANHF: 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. real(dp) function stdlib_zlanhf( norm, transr, uplo, n, a, work ) + !> ZLANHF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43349,11 +43349,11 @@ module stdlib_linalg_lapack_z return end function stdlib_zlanhf - !> ZLANHP: 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. real(dp) function stdlib_zlanhp( norm, uplo, n, ap, work ) + !> ZLANHP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43477,11 +43477,11 @@ module stdlib_linalg_lapack_z return end function stdlib_zlanhp - !> ZLANHS: 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. real(dp) function stdlib_zlanhs( norm, n, a, lda, work ) + !> ZLANHS 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43549,11 +43549,11 @@ module stdlib_linalg_lapack_z return end function stdlib_zlanhs - !> ZLANHT: 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. pure real(dp) function stdlib_zlanht( norm, n, d, e ) + !> ZLANHT 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43612,11 +43612,11 @@ module stdlib_linalg_lapack_z return end function stdlib_zlanht - !> ZLANSB: 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. real(dp) function stdlib_zlansb( norm, uplo, n, k, ab, ldab,work ) + !> ZLANSB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43717,11 +43717,11 @@ module stdlib_linalg_lapack_z return end function stdlib_zlansb - !> ZLANSP: 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. real(dp) function stdlib_zlansp( norm, uplo, n, ap, work ) + !> ZLANSP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43850,11 +43850,11 @@ module stdlib_linalg_lapack_z return end function stdlib_zlansp - !> ZLANSY: 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. real(dp) function stdlib_zlansy( norm, uplo, n, a, lda, work ) + !> ZLANSY 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43946,11 +43946,11 @@ module stdlib_linalg_lapack_z return end function stdlib_zlansy - !> ZLANTB: 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. real(dp) function stdlib_zlantb( norm, uplo, diag, n, k, ab,ldab, work ) + !> ZLANTB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44139,11 +44139,11 @@ module stdlib_linalg_lapack_z return end function stdlib_zlantb - !> ZLANTP: 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. real(dp) function stdlib_zlantp( norm, uplo, diag, n, ap, work ) + !> ZLANTP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44345,11 +44345,11 @@ module stdlib_linalg_lapack_z return end function stdlib_zlantp - !> ZLANTR: 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. real(dp) function stdlib_zlantr( norm, uplo, diag, m, n, a, lda,work ) + !> ZLANTR 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44531,14 +44531,14 @@ module stdlib_linalg_lapack_z return end function stdlib_zlantr + + pure subroutine stdlib_zlapll( n, x, incx, y, incy, ssmin ) !> 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. - - pure subroutine stdlib_zlapll( n, x, incx, y, incy, ssmin ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44575,11 +44575,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlapll - !> ZLAQP2: computes a QR factorization with column pivoting of - !> the block A(OFFSET+1:M,1:N). - !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. pure subroutine stdlib_zlaqp2( m, n, offset, a, lda, jpvt, tau, vn1, vn2,work ) + !> ZLAQP2 computes a QR factorization with column pivoting of + !> the block A(OFFSET+1:M,1:N). + !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44655,7 +44655,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaqp2 - !> ZLAQPS: computes a step of QR factorization with column pivoting + + pure subroutine stdlib_zlaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & + !> ZLAQPS 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. @@ -44663,8 +44665,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zlaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -44798,10 +44798,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaqps - !> ZLAQR5:, called by ZLAQR0, performs a - !> single small-bulge multi-shift QR sweep. pure subroutine stdlib_zlaqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts, s,h, ldh, iloz, & + !> ZLAQR5 , called by ZLAQR0, performs a + !> single small-bulge multi-shift QR sweep. ihiz, z, ldz, v, ldv, u, ldu, nv,wv, ldwv, nh, wh, ldwh ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45196,9 +45196,9 @@ module stdlib_linalg_lapack_z end do loop_180 end subroutine stdlib_zlaqr5 - !> ZLAQZ1: chases a 1x1 shift bulge in a matrix pencil down a single position pure subroutine stdlib_zlaqz1( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, qstart, & + !> ZLAQZ1 chases a 1x1 shift bulge in a matrix pencil down a single position q, ldq, nz, zstart, z, ldz ) ! arguments logical(lk), intent( in ) :: ilq, ilz @@ -45250,9 +45250,9 @@ module stdlib_linalg_lapack_z end if end subroutine stdlib_zlaqz1 - !> ZLAQZ3: Executes a single multishift QZ sweep pure subroutine stdlib_zlaqz3( ilschur, ilq, ilz, n, ilo, ihi, nshifts,nblock_desired, alpha,& + !> ZLAQZ3 Executes a single multishift QZ sweep beta, a, lda, b, ldb,q, ldq, z, ldz, qc, ldqc, zc, ldzc, work,lwork, info ) ! function arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -45490,7 +45490,9 @@ module stdlib_linalg_lapack_z end if end subroutine stdlib_zlaqz3 - !> ZLARGV: generates a vector of complex plane rotations with real + + pure subroutine stdlib_zlargv( n, x, incx, y, incy, c, incc ) + !> ZLARGV 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) ) @@ -45500,8 +45502,6 @@ module stdlib_linalg_lapack_z !> but differ from the BLAS1 routine ZROTG): !> 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. - - pure subroutine stdlib_zlargv( n, x, incx, y, incy, c, incc ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45644,11 +45644,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlargv - !> ZLARRV: 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 DLARRE. pure subroutine stdlib_zlarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, & + !> ZLARRV 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 DLARRE. rtol2, w, werr, wgap,iblock, indexw, gers, z, ldz, isuppz,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46294,7 +46294,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarrv - !> ZLATDF: computes the contribution to the reciprocal Dif-estimate + + pure subroutine stdlib_zlatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) + !> ZLATDF 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 ZGETC2. On entry RHS = f holds the @@ -46302,8 +46304,6 @@ module stdlib_linalg_lapack_z !> The factorization of Z returned by ZGETC2 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. - - pure subroutine stdlib_zlatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46408,7 +46408,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlatdf - !> ZLAUNHR_COL_GETRFNP: computes the modified LU factorization without + + pure subroutine stdlib_zlaunhr_col_getrfnp( m, n, a, lda, d, info ) + !> ZLAUNHR_COL_GETRFNP computes the modified LU factorization without !> pivoting of a complex general M-by-N matrix A. The factorization has !> the form: !> A - S = L * U, @@ -46441,8 +46443,6 @@ module stdlib_linalg_lapack_z !> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, !> E. Solomonik, J. Parallel Distrib. Comput., !> vol. 85, pp. 3-31, 2015. - - pure subroutine stdlib_zlaunhr_col_getrfnp( m, n, a, lda, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46502,12 +46502,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaunhr_col_getrfnp - !> ZPBRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_zpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & + !> ZPBRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite !> and banded, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_zpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46700,14 +46700,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpbrfs - !> ZPBTRF: computes the Cholesky factorization of a complex Hermitian + + pure subroutine stdlib_zpbtrf( uplo, n, kd, ab, ldab, info ) + !> ZPBTRF computes the Cholesky factorization of a complex Hermitian !> positive definite band matrix A. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. - - pure subroutine stdlib_zpbtrf( uplo, n, kd, ab, ldab, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46900,11 +46900,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpbtrf - !> ZPFTRS: solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A using the Cholesky factorization - !> A = U**H*U or A = L*L**H computed by ZPFTRF. pure subroutine stdlib_zpftrs( transr, uplo, n, nrhs, a, b, ldb, info ) + !> ZPFTRS solves a system of linear equations A*X = B with a Hermitian + !> positive definite matrix A using the Cholesky factorization + !> A = U**H*U or A = L*L**H computed by ZPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46954,12 +46954,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpftrs - !> ZPORFS: improves the computed solution to a system of linear + + pure subroutine stdlib_zporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & + !> ZPORFS improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite, !> and provides error bounds and backward error estimates for the !> solution. - - pure subroutine stdlib_zporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47147,15 +47147,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zporfs - !> ZPOTRF: computes the Cholesky factorization of a complex Hermitian + + pure subroutine stdlib_zpotrf( uplo, n, a, lda, info ) + !> ZPOTRF computes the Cholesky factorization of a complex Hermitian !> positive definite matrix A. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the block version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_zpotrf( uplo, n, a, lda, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47242,11 +47242,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpotrf - !> ZPOTRI: computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by ZPOTRF. pure subroutine stdlib_zpotri( uplo, n, a, lda, info ) + !> ZPOTRI computes the inverse of a complex Hermitian positive definite + !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !> computed by ZPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47283,12 +47283,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpotri - !> ZPPRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_zpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & + !> ZPPRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite !> and packed, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_zpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47479,7 +47479,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpprfs - !> ZPPSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_zppsv( uplo, n, nrhs, ap, b, ldb, info ) + !> ZPPSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite matrix stored in !> packed format and X and B are N-by-NRHS matrices. @@ -47489,8 +47491,6 @@ module stdlib_linalg_lapack_z !> where U is an upper triangular matrix and L is a lower triangular !> matrix. The factored form of A is then used to solve the system of !> equations A * X = B. - - pure subroutine stdlib_zppsv( uplo, n, nrhs, ap, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47528,15 +47528,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zppsv - !> ZPPSVX: uses the Cholesky factorization A = U**H * U or A = L * L**H to + + subroutine stdlib_zppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& + !> ZPPSVX uses the Cholesky factorization A = U**H * U or A = L * L**H to !> compute the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite matrix stored in !> packed format and X and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_zppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47668,11 +47668,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zppsvx - !> ZPPTRI: computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by ZPPTRF. pure subroutine stdlib_zpptri( uplo, n, ap, info ) + !> ZPPTRI computes the inverse of a complex Hermitian positive definite + !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !> computed by ZPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47732,7 +47732,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpptri - !> ZPTEQR: computes all eigenvalues and, optionally, eigenvectors of a + + pure subroutine stdlib_zpteqr( compz, n, d, e, z, ldz, work, info ) + !> ZPTEQR computes all eigenvalues and, optionally, eigenvectors of a !> symmetric positive definite tridiagonal matrix by first factoring the !> matrix using DPTTRF and then calling ZBDSQR to compute the singular !> values of the bidiagonal factor. @@ -47747,8 +47749,6 @@ module stdlib_linalg_lapack_z !> tridiagonal form, however, may preclude the possibility of obtaining !> high relative accuracy in the small eigenvalues of the original !> matrix, if these eigenvalues range over many orders of magnitude.) - - pure subroutine stdlib_zpteqr( compz, n, d, e, z, ldz, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47827,14 +47827,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpteqr - !> ZPTTRS: solves a tridiagonal system of the form + + pure subroutine stdlib_zpttrs( uplo, n, nrhs, d, e, b, ldb, info ) + !> ZPTTRS solves a tridiagonal system of the form !> A * X = B !> using the factorization A = U**H *D* U or A = L*D*L**H computed by ZPTTRF. !> D is a diagonal matrix specified in the vector D, U (or L) is a unit !> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in !> the vector E, and X and B are N by NRHS matrices. - - pure subroutine stdlib_zpttrs( uplo, n, nrhs, d, e, b, ldb, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47894,13 +47894,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpttrs - !> ZSPCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_zspcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) + !> ZSPCON estimates the reciprocal of the condition number (in the !> 1-norm) of a complex symmetric packed matrix A using the !> factorization A = U*D*U**T or A = L*D*L**T computed by ZSPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_zspcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47975,12 +47975,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zspcon - !> ZSPRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_zsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& + !> ZSPRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is symmetric indefinite !> and packed, and provides error bounds and backward error estimates !> for the solution. - - pure subroutine stdlib_zsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48172,7 +48172,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsprfs - !> ZSPSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_zspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) + !> ZSPSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix stored in packed format and X !> and B are N-by-NRHS matrices. @@ -48183,8 +48185,6 @@ module stdlib_linalg_lapack_z !> triangular matrices, D is symmetric 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. - - pure subroutine stdlib_zspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48223,14 +48223,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zspsv - !> ZSPSVX: uses the diagonal pivoting factorization A = U*D*U**T or + + subroutine stdlib_zspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & + !> ZSPSVX uses the diagonal pivoting factorization A = U*D*U**T or !> A = L*D*L**T to compute the solution to a complex system of linear !> equations A * X = B, where A is an N-by-N symmetric matrix stored !> in packed format and X and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_zspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48301,7 +48301,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zspsvx - !> ZSTEMR: computes selected eigenvalues and, optionally, eigenvectors + + pure subroutine stdlib_zstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & + !> ZSTEMR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has !> a well defined set of pairwise different real eigenvalues, the corresponding !> real eigenvectors are pairwise orthogonal. @@ -48360,8 +48362,6 @@ module stdlib_linalg_lapack_z !> Since LAPACK drivers overwrite the matrix data with the eigenvectors, !> ZSTEMR accepts complex workspace to facilitate interoperability !> with ZUNMTR or ZUPMTR. - - pure subroutine stdlib_zstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48735,13 +48735,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zstemr - !> ZSYCON: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_zsycon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) + !> ZSYCON estimates the reciprocal of the condition number (in the !> 1-norm) of a complex symmetric matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by ZSYTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_zsycon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48816,13 +48816,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsycon - !> ZSYCON_ROOK: estimates the reciprocal of the condition number (in the + + pure subroutine stdlib_zsycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) + !> ZSYCON_ROOK estimates the reciprocal of the condition number (in the !> 1-norm) of a complex symmetric matrix A using the factorization !> A = U*D*U**T or A = L*D*L**T computed by ZSYTRF_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))). - - pure subroutine stdlib_zsycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48898,11 +48898,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsycon_rook - !> ZSYRFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite, and - !> provides error bounds and backward error estimates for the solution. pure subroutine stdlib_zsyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & + !> ZSYRFS improves the computed solution to a system of linear + !> equations when the coefficient matrix is symmetric indefinite, and + !> provides error bounds and backward error estimates for the solution. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49091,7 +49091,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsyrfs - !> ZSYSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_zsysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) + !> ZSYSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS !> matrices. @@ -49102,8 +49104,6 @@ module stdlib_linalg_lapack_z !> triangular matrices, and D is symmetric 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. - - pure subroutine stdlib_zsysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49169,7 +49169,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsysv - !> ZSYSV_RK: computes the solution to a complex system of linear + + pure subroutine stdlib_zsysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) + !> ZSYSV_RK computes the solution to a complex system of linear !> equations A * X = B, where A is an N-by-N symmetric matrix !> and X and B are N-by-NRHS matrices. !> The bounded Bunch-Kaufman (rook) diagonal pivoting method is used @@ -49183,8 +49185,6 @@ module stdlib_linalg_lapack_z !> ZSYTRF_RK is called to compute the factorization of a complex !> symmetric matrix. The factored form of A is then used to solve !> the system of equations A * X = B by calling BLAS3 routine ZSYTRS_3. - - pure subroutine stdlib_zsysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49246,7 +49246,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsysv_rk - !> ZSYSV_ROOK: computes the solution to a complex system of linear + + pure subroutine stdlib_zsysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) + !> ZSYSV_ROOK computes the solution to a complex system of linear !> equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS @@ -49262,8 +49264,6 @@ module stdlib_linalg_lapack_z !> pivoting method. !> The factored form of A is then used to solve the system !> of equations A * X = B by calling ZSYTRS_ROOK. - - pure subroutine stdlib_zsysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49325,14 +49325,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsysv_rook - !> ZSYSVX: uses the diagonal pivoting factorization to compute the + + subroutine stdlib_zsysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & + !> ZSYSVX uses the diagonal pivoting factorization to compute the !> solution to a complex system of linear equations A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS !> matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_zsysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & ferr, berr, work, lwork,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49422,14 +49422,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsysvx - !> ZTBCON: estimates the reciprocal of the condition number of a + + subroutine stdlib_ztbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,rwork, info ) + !> ZTBCON estimates the reciprocal of the condition number of a !> triangular band matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_ztbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49531,11 +49531,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztbcon - !> ZTFTRI: computes the inverse of a triangular matrix A stored in RFP - !> format. - !> This is a Level 3 BLAS version of the algorithm. pure subroutine stdlib_ztftri( transr, uplo, diag, n, a, info ) + !> ZTFTRI computes the inverse of a triangular matrix A stored in RFP + !> format. + !> This is a Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49714,7 +49714,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztftri - !> ZTGSJA: computes the generalized singular value decomposition (GSVD) + + pure subroutine stdlib_ztgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & + !> ZTGSJA computes the generalized singular value decomposition (GSVD) !> of two complex upper triangular (or trapezoidal) matrices A and B. !> On entry, it is assumed that matrices A and B have the following !> forms, which may be obtained by the preprocessing subroutine ZGGSVP @@ -49776,8 +49778,6 @@ module stdlib_linalg_lapack_z !> The computation of the unitary transformation matrices U, V or Q !> is optional. These matrices may either be formed explicitly, or they !> may be postmultiplied into input matrices U1, V1, or Q1. - - pure subroutine stdlib_ztgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & alpha, beta, u, ldu, v, ldv,q, ldq, work, ncycle, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49963,7 +49963,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztgsja - !> ZTGSY2: solves the generalized Sylvester equation + + pure subroutine stdlib_ztgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & + !> ZTGSY2 solves the generalized Sylvester equation !> A * R - L * B = scale * C (1) !> D * R - L * E = scale * F !> using Level 1 and 2 BLAS, where R and L are unknown M-by-N matrices, @@ -49988,8 +49990,6 @@ module stdlib_linalg_lapack_z !> of an upper bound on the separation between to matrix pairs. Then !> the input (A, D), (B, E) are sub-pencils of two matrix pairs in !> ZTGSYL. - - pure subroutine stdlib_ztgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & ldf, scale, rdsum, rdscal,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50153,7 +50153,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztgsy2 - !> ZTGSYL: solves the generalized Sylvester equation: + + pure subroutine stdlib_ztgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & + !> ZTGSYL solves the generalized Sylvester equation: !> A * R - L * B = scale * C (1) !> D * R - L * E = scale * F !> where R and L are unknown m-by-n matrices, (A, D), (B, E) and @@ -50180,8 +50182,6 @@ module stdlib_linalg_lapack_z !> Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the !> reciprocal of the smallest singular value of Z. !> This is a level-3 BLAS algorithm. - - pure subroutine stdlib_ztgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50503,14 +50503,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztgsyl - !> ZTPCON: estimates the reciprocal of the condition number of a packed + + subroutine stdlib_ztpcon( norm, uplo, diag, n, ap, rcond, work, rwork,info ) + !> ZTPCON estimates the reciprocal of the condition number of a packed !> triangular matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_ztpcon( norm, uplo, diag, n, ap, rcond, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50607,12 +50607,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztpcon - !> ZTPLQT: computes a blocked LQ factorization of a complex + + pure subroutine stdlib_ztplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) + !> ZTPLQT computes a blocked LQ factorization of a complex !> "triangular-pentagonal" matrix C, which is composed of a !> triangular block A and pentagonal block B, using the compact !> WY representation for Q. - - pure subroutine stdlib_ztplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50669,11 +50669,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztplqt - !> ZTPMLQT: applies a complex unitary matrix Q obtained from a - !> "triangular-pentagonal" complex block reflector H to a general - !> complex matrix C, which consists of two blocks A and B. pure subroutine stdlib_ztpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, ldb, & + !> ZTPMLQT applies a complex unitary matrix Q obtained from a + !> "triangular-pentagonal" complex block reflector H to a general + !> complex matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50787,11 +50787,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztpmlqt - !> ZTPMQRT: applies a complex orthogonal matrix Q obtained from a - !> "triangular-pentagonal" complex block reflector H to a general - !> complex matrix C, which consists of two blocks A and B. pure subroutine stdlib_ztpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, ldb, & + !> ZTPMQRT applies a complex orthogonal matrix Q obtained from a + !> "triangular-pentagonal" complex block reflector H to a general + !> complex matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50907,12 +50907,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztpmqrt - !> ZTPQRT: computes a blocked QR factorization of a complex + + pure subroutine stdlib_ztpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) + !> ZTPQRT computes a blocked QR factorization of a complex !> "triangular-pentagonal" matrix C, which is composed of a !> triangular block A and pentagonal block B, using the compact !> WY representation for Q. - - pure subroutine stdlib_ztpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50969,14 +50969,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztpqrt - !> ZTRCON: estimates the reciprocal of the condition number of a + + subroutine stdlib_ztrcon( norm, uplo, diag, n, a, lda, rcond, work,rwork, info ) + !> ZTRCON estimates the reciprocal of the condition number of a !> triangular matrix A, in either the 1-norm or the infinity-norm. !> The norm of A is computed and an estimate is obtained for !> norm(inv(A)), then the reciprocal of the condition number is !> computed as !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). - - subroutine stdlib_ztrcon( norm, uplo, diag, n, a, lda, rcond, work,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51075,15 +51075,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrcon - !> ZTRSYL: solves the complex Sylvester matrix equation: + + subroutine stdlib_ztrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) + !> ZTRSYL solves the complex Sylvester matrix equation: !> op(A)*X + X*op(B) = scale*C or !> op(A)*X - X*op(B) = scale*C, !> where op(A) = A or A**H, and A and B are both upper triangular. A is !> M-by-M and B is N-by-N; the right hand side C and the solution X are !> M-by-N; and scale is an output scale factor, set <= 1 to avoid !> overflow in X. - - subroutine stdlib_ztrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51301,7 +51301,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrsyl - !> ZUNBDB5: orthogonalizes the column vector + + pure subroutine stdlib_zunbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & + !> ZUNBDB5 orthogonalizes the column vector !> X = [ X1 ] !> [ X2 ] !> with respect to the columns of @@ -51312,8 +51314,6 @@ module stdlib_linalg_lapack_z !> criterion, then some other vector from the orthogonal complement !> is returned. This vector is chosen in an arbitrary but deterministic !> way. - - pure subroutine stdlib_zunbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51400,7 +51400,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunbdb5 - !> ZUNCSD: computes the CS decomposition of an M-by-M partitioned + + recursive subroutine stdlib_zuncsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & + !> ZUNCSD computes the CS decomposition of an M-by-M partitioned !> unitary matrix X: !> [ I 0 0 | 0 0 0 ] !> [ 0 C 0 | 0 -S 0 ] @@ -51413,8 +51415,6 @@ module stdlib_linalg_lapack_z !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in !> which R = MIN(P,M-P,Q,M-Q). - - recursive subroutine stdlib_zuncsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, ldv1t, v2t,ldv2t, & work, lwork, rwork, lrwork,iwork, info ) ! -- lapack computational routine -- @@ -51690,12 +51690,12 @@ module stdlib_linalg_lapack_z ! end stdlib_zuncsd end subroutine stdlib_zuncsd - !> ZUNGHR: generates a complex unitary matrix Q which is defined as the + + pure subroutine stdlib_zunghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) + !> ZUNGHR generates a complex unitary matrix Q which is defined as the !> product of IHI-ILO elementary reflectors of order N, as returned by !> ZGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - - pure subroutine stdlib_zunghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51780,13 +51780,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunghr - !> ZUNGTR: generates a complex unitary matrix Q which is defined as the + + pure subroutine stdlib_zungtr( uplo, n, a, lda, tau, work, lwork, info ) + !> ZUNGTR generates a complex unitary matrix Q which is defined as the !> product of n-1 elementary reflectors of order N, as returned by !> ZHETRD: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - - pure subroutine stdlib_zungtr( uplo, n, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51881,7 +51881,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungtr - !> ZUNHR_COL: takes an M-by-N complex matrix Q_in with orthonormal columns + + pure subroutine stdlib_zunhr_col( m, n, nb, a, lda, t, ldt, d, info ) + !> ZUNHR_COL takes an M-by-N complex matrix Q_in with orthonormal columns !> as input, stored in A, and performs Householder Reconstruction (HR), !> i.e. reconstructs Householder vectors V(i) implicitly representing !> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, @@ -51890,8 +51892,6 @@ module stdlib_linalg_lapack_z !> stored in A on output, and the diagonal entries of S are stored in D. !> Block reflectors are also returned in T !> (same output format as ZGEQRT). - - pure subroutine stdlib_zunhr_col( m, n, nb, a, lda, t, ldt, d, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52018,7 +52018,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunhr_col - !> ZUNMHR: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_zunmhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & + !> ZUNMHR 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 @@ -52026,8 +52028,6 @@ module stdlib_linalg_lapack_z !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of !> IHI-ILO elementary reflectors, as returned by ZGEHRD: !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). - - pure subroutine stdlib_zunmhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52117,7 +52117,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmhr - !> ZUNMTR: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_zunmtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & + !> ZUNMTR 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 @@ -52126,8 +52128,6 @@ module stdlib_linalg_lapack_z !> nq-1 elementary reflectors, as returned by ZHETRD: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - - pure subroutine stdlib_zunmtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52233,13 +52233,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmtr - !> ZUPGTR: generates a complex unitary matrix Q which is defined as the + + pure subroutine stdlib_zupgtr( uplo, n, ap, tau, q, ldq, work, info ) + !> ZUPGTR generates a complex unitary matrix Q which is defined as the !> product of n-1 elementary reflectors H(i) of order n, as returned by !> ZHPTRD using packed storage: !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). - - pure subroutine stdlib_zupgtr( uplo, n, ap, tau, q, ldq, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52320,7 +52320,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zupgtr - !> ZUPMTR: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_zupmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) + !> ZUPMTR 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 @@ -52330,8 +52332,6 @@ module stdlib_linalg_lapack_z !> storage: !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). - - pure subroutine stdlib_zupmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52477,7 +52477,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zupmtr - !> ZCPOSV: computes the solution to a complex system of linear equations + + subroutine stdlib_zcposv( uplo, n, nrhs, a, lda, b, ldb, x, ldx, work,swork, rwork, iter, & + !> ZCPOSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite matrix and X and B !> are N-by-NRHS matrices. @@ -52505,8 +52507,6 @@ module stdlib_linalg_lapack_z !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 !> respectively. - - subroutine stdlib_zcposv( uplo, n, nrhs, a, lda, b, ldb, x, ldx, work,swork, rwork, iter, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52664,12 +52664,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zcposv - !> ZGBBRD: reduces a complex general m-by-n band matrix A to real upper + + pure subroutine stdlib_zgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & + !> ZGBBRD 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. - - pure subroutine stdlib_zgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & ldc, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52941,11 +52941,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgbbrd - !> ZGBRFS: 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. pure subroutine stdlib_zgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, x, & + !> ZGBRFS 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. ldx, ferr, berr, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53147,7 +53147,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgbrfs - !> ZGBSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_zgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) + !> ZGBSV 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 @@ -53155,8 +53157,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53199,14 +53199,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgbsv - !> ZGBSVX: uses the LU factorization to compute the solution to a complex + + subroutine stdlib_zgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & + !> ZGBSVX uses the LU factorization to compute the solution to a complex !> system of linear equations A * X = B, A**T * X = B, or A**H * 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. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_zgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & c, b, ldb, x, ldx,rcond, ferr, berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53426,11 +53426,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgbsvx - !> ZGEBRD: 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. pure subroutine stdlib_zgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) + !> ZGEBRD 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53533,10 +53533,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgebrd - !> ZGEHRD: reduces a complex general matrix A to upper Hessenberg form H by - !> an unitary similarity transformation: Q**H * A * Q = H . pure subroutine stdlib_zgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info ) + !> ZGEHRD reduces a complex general matrix A to upper Hessenberg form H by + !> an unitary similarity transformation: Q**H * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53663,10 +53663,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgehrd - !> ZGELQT: computes a blocked LQ factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. pure subroutine stdlib_zgelqt( m, n, mb, a, lda, t, ldt, work, info ) + !> ZGELQT computes a blocked LQ factorization of a complex M-by-N matrix A + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53714,7 +53714,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelqt - !> ZGELS: solves overdetermined or underdetermined complex linear systems + + subroutine stdlib_zgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) + !> ZGELS 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: @@ -53732,8 +53734,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53932,10 +53932,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgels - !> ZGEQP3: computes a QR factorization with column pivoting of a - !> matrix A: A*P = Q*R using Level 3 BLAS. pure subroutine stdlib_zgeqp3( m, n, a, lda, jpvt, tau, work, lwork, rwork,info ) + !> ZGEQP3 computes a QR factorization with column pivoting of a + !> matrix A: A*P = Q*R using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54084,10 +54084,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeqp3 - !> ZGEQRT: computes a blocked QR factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. pure subroutine stdlib_zgeqrt( m, n, nb, a, lda, t, ldt, work, info ) + !> ZGEQRT computes a blocked QR factorization of a complex M-by-N matrix A + !> using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54141,11 +54141,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeqrt - !> ZGERFS: improves the computed solution to a system of linear - !> equations and provides error bounds and backward error estimates for - !> the solution. pure subroutine stdlib_zgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & + !> ZGERFS improves the computed solution to a system of linear + !> equations and provides error bounds and backward error estimates for + !> the solution. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54338,7 +54338,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgerfs - !> ZGETRF: computes an LU factorization of a general M-by-N matrix A + + pure subroutine stdlib_zgetrf( m, n, a, lda, ipiv, info ) + !> ZGETRF 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 @@ -54346,8 +54348,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zgetrf( m, n, a, lda, ipiv, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54416,7 +54416,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgetrf - !> ZGGGLM: solves a general Gauss-Markov linear model (GLM) problem: + + pure subroutine stdlib_zggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) + !> ZGGGLM 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 @@ -54434,8 +54436,6 @@ module stdlib_linalg_lapack_z !> minimize || inv(B)*(d-A*x) ||_2 !> x !> where inv(B) denotes the inverse of B. - - pure subroutine stdlib_zggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54552,7 +54552,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zggglm - !> ZGGHD3: reduces a pair of complex matrices (A,B) to generalized upper + + pure subroutine stdlib_zgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & + !> ZGGHD3 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 @@ -54577,8 +54579,6 @@ module stdlib_linalg_lapack_z !> problem to generalized Hessenberg form. !> This is a blocked variant of CGGHRD, using matrix-matrix !> multiplications for parts of the computation to enhance performance. - - pure subroutine stdlib_zgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55082,7 +55082,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgghd3 - !> ZGGLSE: solves the linear equality-constrained least squares (LSE) + + pure subroutine stdlib_zgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) + !> ZGGLSE 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 @@ -55094,8 +55096,6 @@ module stdlib_linalg_lapack_z !> which is obtained using a generalized RQ factorization of the !> matrices (B, A) given by !> B = (0 R)*Q, A = Z*T*Q. - - pure subroutine stdlib_zgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55214,13 +55214,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgglse - !> ZGTCON: estimates the reciprocal of the condition number of a complex + + pure subroutine stdlib_zgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, info ) + !> ZGTCON estimates the reciprocal of the condition number of a complex !> tridiagonal matrix A using the LU factorization as computed by !> ZGTTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_zgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55298,11 +55298,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgtcon - !> ZGTRFS: 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. pure subroutine stdlib_zgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, x, & + !> ZGTRFS 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. ldx, ferr, berr, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55505,14 +55505,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgtrfs - !> ZGTSVX: uses the LU factorization to compute the solution to a complex + + pure subroutine stdlib_zgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & + !> ZGTSVX uses the LU factorization to compute the solution to a complex !> system of linear equations A * X = B, A**T * X = B, or A**H * X = B, !> where A is a tridiagonal matrix of order N and X and B are N-by-NRHS !> matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - pure subroutine stdlib_zgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & ldb, x, ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55593,15 +55593,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgtsvx - !> ZHBGST: reduces a complex Hermitian-definite banded generalized + + pure subroutine stdlib_zhbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, rwork,& + !> ZHBGST 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 ZPBSTF, 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. - - pure subroutine stdlib_zhbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, rwork,& info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56525,11 +56525,11 @@ module stdlib_linalg_lapack_z go to 490 end subroutine stdlib_zhbgst - !> ZHBTRD: reduces a complex Hermitian band matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. pure subroutine stdlib_zhbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) + !> ZHBTRD reduces a complex Hermitian band matrix A to real symmetric + !> tridiagonal form T by a unitary similarity transformation: + !> Q**H * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56889,13 +56889,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhbtrd - !> ZHECON: estimates the reciprocal of the condition number of a complex + + pure subroutine stdlib_zhecon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) + !> ZHECON 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 ZHETRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_zhecon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56970,13 +56970,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhecon - !> ZHECON_ROOK: estimates the reciprocal of the condition number of a complex + + pure subroutine stdlib_zhecon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) + !> ZHECON_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))). - - pure subroutine stdlib_zhecon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57051,10 +57051,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhecon_rook - !> ZHEEV: computes all eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix A. subroutine stdlib_zheev( jobz, uplo, n, a, lda, w, work, lwork, rwork,info ) + !> ZHEEV computes all eigenvalues and, optionally, eigenvectors of a + !> complex Hermitian matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57162,7 +57162,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zheev - !> ZHEEVR: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_zheevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> ZHEEVR 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. @@ -57212,8 +57214,6 @@ module stdlib_linalg_lapack_z !> hence may abort due to a floating point exception in environments !> which do not handle NaNs and infinities in the ieee standard default !> manner. - - subroutine stdlib_zheevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & isuppz, work, lwork,rwork, lrwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57501,12 +57501,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zheevr - !> ZHEEVX: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_zheevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> ZHEEVX 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. - - subroutine stdlib_zheevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & work, lwork, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57748,13 +57748,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zheevx - !> ZHEGV: computes all the eigenvalues, and optionally, the eigenvectors + + subroutine stdlib_zhegv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, info ) + !> ZHEGV 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. - - subroutine stdlib_zhegv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57849,14 +57849,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhegv - !> ZHEGVX: computes selected eigenvalues, and optionally, eigenvectors + + subroutine stdlib_zhegvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& + !> ZHEGVX computes selected eigenvalues, and optionally, 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. !> Eigenvalues and eigenvectors can be selected by specifying either a !> range of values or a range of indices for the desired eigenvalues. - - subroutine stdlib_zhegvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& m, w, z, ldz, work,lwork, rwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57977,11 +57977,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhegvx - !> ZHERFS: 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. pure subroutine stdlib_zherfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & + !> ZHERFS 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. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58170,7 +58170,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zherfs - !> ZHESV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_zhesv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) + !> ZHESV 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. @@ -58181,8 +58183,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zhesv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58248,7 +58248,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhesv - !> ZHESV_RK: computes the solution to a complex system of linear + + pure subroutine stdlib_zhesv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) + !> ZHESV_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 @@ -58262,8 +58264,6 @@ module stdlib_linalg_lapack_z !> ZHETRF_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 ZHETRS_3. - - pure subroutine stdlib_zhesv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58325,7 +58325,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhesv_rk - !> ZHESV_ROOK: computes the solution to a complex system of linear equations + + pure subroutine stdlib_zhesv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) + !> ZHESV_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. @@ -58341,8 +58343,6 @@ module stdlib_linalg_lapack_z !> pivoting method. !> The factored form of A is then used to solve the system !> of equations A * X = B by calling ZHETRS_ROOK (uses BLAS 2). - - pure subroutine stdlib_zhesv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58404,14 +58404,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhesv_rook - !> ZHESVX: uses the diagonal pivoting factorization to compute the + + subroutine stdlib_zhesvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & + !> ZHESVX uses the diagonal pivoting factorization to compute 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. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_zhesvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & ferr, berr, work, lwork,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58501,7 +58501,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhesvx - !> ZHGEQZ: computes the eigenvalues of a complex matrix pair (H,T), + + subroutine stdlib_zhgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alpha, beta, q, ldq,& + !> ZHGEQZ 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 @@ -58534,8 +58536,6 @@ module stdlib_linalg_lapack_z !> Ref: C.B. Moler !> Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973), !> pp. 241--256. - - subroutine stdlib_zhgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alpha, beta, q, ldq,& z, ldz, work, lwork,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59001,13 +59001,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhgeqz - !> ZHPCON: estimates the reciprocal of the condition number of a complex + + pure subroutine stdlib_zhpcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) + !> ZHPCON 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 ZHPTRF. !> An estimate is obtained for norm(inv(A)), and the reciprocal of the !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). - - pure subroutine stdlib_zhpcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59082,10 +59082,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpcon - !> ZHPEV: computes all the eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix in packed storage. subroutine stdlib_zhpev( jobz, uplo, n, ap, w, z, ldz, work, rwork,info ) + !> ZHPEV computes all the eigenvalues and, optionally, eigenvectors of a + !> complex Hermitian matrix in packed storage. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59179,12 +59179,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpev - !> ZHPEVX: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_zhpevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> ZHPEVX computes selected eigenvalues and, optionally, eigenvectors !> of a complex Hermitian matrix A in packed storage. !> Eigenvalues/vectors can be selected by specifying either a range of !> values or a range of indices for the desired eigenvalues. - - subroutine stdlib_zhpevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & work, rwork, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59396,13 +59396,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpevx - !> ZHPGV: computes all the eigenvalues and, optionally, the eigenvectors + + subroutine stdlib_zhpgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,rwork, info ) + !> ZHPGV 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. - - subroutine stdlib_zhpgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59481,15 +59481,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpgv - !> ZHPGVX: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_zhpgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & + !> ZHPGVX computes selected eigenvalues and, optionally, 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. Eigenvalues and eigenvectors can be selected by !> specifying either a range of values or a range of indices for the !> desired eigenvalues. - - subroutine stdlib_zhpgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & z, ldz, work, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59593,12 +59593,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpgvx - !> ZHPRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_zhprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& + !> ZHPRFS 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. - - pure subroutine stdlib_zhprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59790,7 +59790,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhprfs - !> ZHPSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_zhpsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) + !> ZHPSV 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. @@ -59801,8 +59803,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zhpsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59841,14 +59841,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpsv - !> ZHPSVX: uses the diagonal pivoting factorization A = U*D*U**H or + + subroutine stdlib_zhpsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & + !> ZHPSVX uses the diagonal pivoting factorization A = U*D*U**H or !> A = L*D*L**H to compute 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. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_zhpsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59919,14 +59919,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpsvx - !> ZHSEIN: uses inverse iteration to find specified right and/or left + + subroutine stdlib_zhsein( side, eigsrc, initv, select, n, h, ldh, w, vl,ldvl, vr, ldvr, mm, & + !> ZHSEIN 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. - - subroutine stdlib_zhsein( side, eigsrc, initv, select, n, h, ldh, w, vl,ldvl, vr, ldvr, mm, & m, work, rwork, ifaill,ifailr, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60093,12 +60093,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhsein + + pure subroutine stdlib_zlaed0( qsiz, n, d, e, q, ldq, qstore, ldqs, rwork,iwork, info ) !> Using the divide and conquer method, ZLAED0: 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. - - pure subroutine stdlib_zlaed0( qsiz, n, d, e, q, ldq, qstore, ldqs, rwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60271,15 +60271,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaed0 - !> ZLAMSWLQ: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_zlamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & + !> ZLAMSWLQ 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 short wide LQ !> factorization (ZLASWLQ) - - pure subroutine stdlib_zlamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60429,15 +60429,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlamswlq - !> ZLAMTSQR: overwrites the general complex M-by-N matrix C with + + pure subroutine stdlib_zlamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & + !> ZLAMTSQR 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 (ZLATSQR) - - pure subroutine stdlib_zlamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60591,7 +60591,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlamtsqr - !> ZLAQR2: is identical to ZLAQR3 except that it avoids + + pure subroutine stdlib_zlaqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & + !> ZLAQR2 is identical to ZLAQR3 except that it avoids !> recursion by calling ZLAHQR instead of ZLAQR4. !> Aggressive early deflation: !> ZLAQR2 accepts as input an upper Hessenberg matrix @@ -60602,8 +60604,6 @@ module stdlib_linalg_lapack_z !> an unitary similarity transformation of H. It is to be !> hoped that the final version of H has many zero subdiagonal !> entries. - - pure subroutine stdlib_zlaqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & ns, nd, sh, v, ldv, nh, t, ldt,nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60805,7 +60805,9 @@ module stdlib_linalg_lapack_z work( 1 ) = cmplx( lwkopt, 0,KIND=dp) end subroutine stdlib_zlaqr2 - !> ZLASWLQ: computes a blocked Tall-Skinny LQ factorization of + + pure subroutine stdlib_zlaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) + !> ZLASWLQ computes a blocked Tall-Skinny LQ factorization of !> a complexx M-by-N matrix A for M <= N: !> A = ( L 0 ) * Q, !> where: @@ -60815,8 +60817,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zlaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -60889,7 +60889,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaswlq - !> ZLATSQR: computes a blocked Tall-Skinny QR factorization of + + pure subroutine stdlib_zlatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) + !> ZLATSQR computes a blocked Tall-Skinny QR factorization of !> a complex M-by-N matrix A for M >= N: !> A = Q * ( R ), !> ( 0 ) @@ -60900,8 +60902,6 @@ module stdlib_linalg_lapack_z !> R is an upper-triangular N-by-N matrix, stored on exit in !> the elements on and above the diagonal of the array A. !> 0 is a (M-N)-by-N zero matrix, and is not stored. - - pure subroutine stdlib_zlatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -60974,7 +60974,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlatsqr - !> ZPBSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_zpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) + !> ZPBSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite band matrix and X !> and B are N-by-NRHS matrices. @@ -60985,8 +60987,6 @@ module stdlib_linalg_lapack_z !> triangular band matrix, with the same number of superdiagonals or !> subdiagonals as A. The factored form of A is then used to solve the !> system of equations A * X = B. - - pure subroutine stdlib_zpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61028,15 +61028,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpbsv - !> ZPBSVX: uses the Cholesky factorization A = U**H*U or A = L*L**H to + + subroutine stdlib_zpbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & + !> ZPBSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to !> compute the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite band matrix and X !> and B are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_zpbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61185,15 +61185,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpbsvx - !> ZPFTRF: computes the Cholesky factorization of a complex Hermitian + + pure subroutine stdlib_zpftrf( transr, uplo, n, a, info ) + !> ZPFTRF computes the Cholesky factorization of a complex Hermitian !> positive definite matrix A. !> The factorization has the form !> A = U**H * U, if UPLO = 'U', or !> A = L * L**H, if UPLO = 'L', !> where U is an upper triangular matrix and L is lower triangular. !> This is the block version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_zpftrf( transr, uplo, n, a, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61361,11 +61361,11 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpftrf - !> ZPFTRI: computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by ZPFTRF. pure subroutine stdlib_zpftri( transr, uplo, n, a, info ) + !> ZPFTRI computes the inverse of a complex Hermitian positive definite + !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !> computed by ZPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61520,7 +61520,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpftri - !> ZPOSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_zposv( uplo, n, nrhs, a, lda, b, ldb, info ) + !> ZPOSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite matrix and X and B !> are N-by-NRHS matrices. @@ -61530,8 +61532,6 @@ module stdlib_linalg_lapack_z !> where U is an upper triangular matrix and L is a lower triangular !> matrix. The factored form of A is then used to solve the system of !> equations A * X = B. - - pure subroutine stdlib_zposv( uplo, n, nrhs, a, lda, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61571,15 +61571,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zposv - !> ZPOSVX: uses the Cholesky factorization A = U**H*U or A = L*L**H to + + subroutine stdlib_zposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & + !> ZPOSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to !> compute the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N Hermitian positive definite matrix and X and B !> are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_zposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & rcond, ferr, berr, work,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61715,12 +61715,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zposvx - !> ZPTRFS: improves the computed solution to a system of linear + + pure subroutine stdlib_zptrfs( uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx,ferr, berr, work, & + !> ZPTRFS improves the computed solution to a system of linear !> equations when the coefficient matrix is Hermitian positive definite !> and tridiagonal, and provides error bounds and backward error !> estimates for the solution. - - pure subroutine stdlib_zptrfs( uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx,ferr, berr, work, & rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61933,13 +61933,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zptrfs - !> ZPTSV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_zptsv( n, nrhs, d, e, b, ldb, info ) + !> ZPTSV computes the solution to a complex system of linear equations !> A*X = B, where A is an N-by-N Hermitian positive definite tridiagonal !> matrix, and X and B are N-by-NRHS matrices. !> A is factored as A = L*D*L**H, and the factored form of A is then !> used to solve the system of equations. - - pure subroutine stdlib_zptsv( n, nrhs, d, e, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61975,14 +61975,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zptsv - !> ZPTSVX: uses the factorization A = L*D*L**H to compute the solution + + pure subroutine stdlib_zptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& + !> ZPTSVX uses the factorization A = L*D*L**H to compute the solution !> to a complex system of linear equations A*X = B, where A is an !> N-by-N Hermitian positive definite tridiagonal matrix and X and B !> are N-by-NRHS matrices. !> Error bounds on the solution and a condition estimate are also !> provided. - - pure subroutine stdlib_zptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62052,7 +62052,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zptsvx - !> ZSTEDC: computes all eigenvalues and, optionally, eigenvectors of a + + pure subroutine stdlib_zstedc( compz, n, d, e, z, ldz, work, lwork, rwork,lrwork, iwork, & + !> ZSTEDC computes all eigenvalues and, optionally, eigenvectors of a !> symmetric tridiagonal matrix using the divide and conquer method. !> The eigenvectors of a full or band complex Hermitian matrix can also !> be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this @@ -62063,8 +62065,6 @@ module stdlib_linalg_lapack_z !> 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 DLAED3 for details. - - pure subroutine stdlib_zstedc( compz, n, d, e, z, ldz, work, lwork, rwork,lrwork, iwork, & liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62266,7 +62266,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zstedc - !> ZSTEGR: computes selected eigenvalues and, optionally, eigenvectors + + pure subroutine stdlib_zstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & + !> ZSTEGR computes selected eigenvalues and, optionally, eigenvectors !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has !> a well defined set of pairwise different real eigenvalues, the corresponding !> real eigenvectors are pairwise orthogonal. @@ -62282,8 +62284,6 @@ module stdlib_linalg_lapack_z !> NaNs. Normal execution may create these exceptiona values and hence !> may abort due to a floating point exception in environments which !> do not conform to the IEEE-754 standard. - - pure subroutine stdlib_zstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62308,7 +62308,9 @@ module stdlib_linalg_lapack_z tryrac, work, lwork,iwork, liwork, info ) end subroutine stdlib_zstegr - !> ZTGSEN: reorders the generalized Schur decomposition of a complex + + pure subroutine stdlib_ztgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alpha, beta, q, & + !> ZTGSEN reorders the generalized Schur decomposition of a complex !> matrix pair (A, B) (in terms of an unitary equivalence trans- !> formation Q**H * (A, B) * Z), so that a selected cluster of eigenvalues !> appears in the leading diagonal blocks of the pair (A,B). The leading @@ -62326,8 +62328,6 @@ module stdlib_linalg_lapack_z !> the selected cluster and the eigenvalues outside the cluster, resp., !> and norms of "projections" onto left and right eigenspaces w.r.t. !> the selected cluster in the (1,1)-block. - - pure subroutine stdlib_ztgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alpha, beta, q, & ldq, z, ldz, m, pl, pr, dif,work, lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62587,12 +62587,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztgsen - !> ZTGSNA: estimates reciprocal condition numbers for specified + + pure subroutine stdlib_ztgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & + !> ZTGSNA estimates reciprocal condition numbers for specified !> eigenvalues and/or eigenvectors of a matrix pair (A, B). !> (A, B) must be in generalized Schur canonical form, that is, A and !> B are both upper triangular. - - pure subroutine stdlib_ztgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & dif, mm, m, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62744,15 +62744,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztgsna - !> ZTRSEN: reorders the Schur factorization of a complex matrix + + subroutine stdlib_ztrsen( job, compq, select, n, t, ldt, q, ldq, w, m, s,sep, work, lwork, & + !> ZTRSEN reorders the Schur factorization of a complex matrix !> A = Q*T*Q**H, so that a selected cluster of eigenvalues appears in !> the leading positions on the diagonal of the upper triangular matrix !> T, and the leading columns of Q form an orthonormal basis of the !> corresponding right invariant subspace. !> Optionally the routine computes the reciprocal condition numbers of !> the cluster of eigenvalues and/or the invariant subspace. - - subroutine stdlib_ztrsen( job, compq, select, n, t, ldt, q, ldq, w, m, s,sep, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62881,7 +62881,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrsen - !> ZUNBDB1: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_zunbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> ZUNBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -62896,8 +62898,6 @@ module stdlib_linalg_lapack_z !> Householder vectors. !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by !> angles THETA, PHI. - - subroutine stdlib_zunbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62986,7 +62986,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunbdb1 - !> ZUNBDB2: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_zunbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> ZUNBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -63001,8 +63003,6 @@ module stdlib_linalg_lapack_z !> Householder vectors. !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by !> angles THETA, PHI. - - subroutine stdlib_zunbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63101,7 +63101,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunbdb2 - !> ZUNBDB3: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_zunbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> ZUNBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -63116,8 +63118,6 @@ module stdlib_linalg_lapack_z !> Householder vectors. !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_zunbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63215,7 +63215,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunbdb3 - !> ZUNBDB4: simultaneously bidiagonalizes the blocks of a tall and skinny + + subroutine stdlib_zunbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & + !> ZUNBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny !> matrix X with orthonomal columns: !> [ B11 ] !> [ X11 ] [ P1 | ] [ 0 ] @@ -63230,8 +63232,6 @@ module stdlib_linalg_lapack_z !> Householder vectors. !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented !> implicitly by angles THETA, PHI. - - subroutine stdlib_zunbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63364,7 +63364,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunbdb4 - !> ZUNCSD2BY1: computes the CS decomposition of an M-by-Q matrix X with + + subroutine stdlib_zuncsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & + !> ZUNCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with !> orthonormal columns that has been partitioned into a 2-by-1 block !> structure: !> [ I1 0 0 ] @@ -63379,8 +63381,6 @@ module stdlib_linalg_lapack_z !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). - - subroutine stdlib_zuncsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, rwork, lrwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63801,7 +63801,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zuncsd2by1 - !> ZUNGBR: generates one of the complex unitary matrices Q or P**H + + pure subroutine stdlib_zungbr( vect, m, n, k, a, lda, tau, work, lwork, info ) + !> ZUNGBR generates one of the complex unitary matrices Q or P**H !> determined by ZGEBRD when reducing a complex matrix A to bidiagonal !> form: A = Q * B * P**H. Q and P**H are defined as products of !> elementary reflectors H(i) or G(i) respectively. @@ -63817,8 +63819,6 @@ module stdlib_linalg_lapack_z !> rows of P**H, where n >= m >= k; !> if k >= n, P**H = G(n-1) . . . G(2) G(1) and ZUNGBR returns P**H as !> an N-by-N matrix. - - pure subroutine stdlib_zungbr( vect, m, n, k, a, lda, tau, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63950,13 +63950,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungbr - !> ZUNGTSQR: generates an M-by-N complex matrix Q_out with orthonormal + + pure subroutine stdlib_zungtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) + !> ZUNGTSQR generates an M-by-N complex matrix Q_out with orthonormal !> columns, which are the first N columns of a product of comlpex unitary !> matrices of order M which are returned by ZLATSQR !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). !> See the documentation for ZLATSQR. - - pure subroutine stdlib_zungtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64048,6 +64048,8 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungtsqr + + pure subroutine stdlib_zunmbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & !> If VECT = 'Q', ZUNMBR: overwrites the general complex M-by-N matrix C !> with !> SIDE = 'L' SIDE = 'R' @@ -64070,8 +64072,6 @@ module stdlib_linalg_lapack_z !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: !> if k < nq, P = G(1) G(2) . . . G(k); !> if k >= nq, P = G(1) G(2) . . . G(nq-1). - - pure subroutine stdlib_zunmbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64209,7 +64209,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmbr - !> ZCGESV: computes the solution to a complex system of linear equations + + subroutine stdlib_zcgesv( n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work,swork, rwork, iter, & + !> ZCGESV 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. !> ZCGESV first attempts to factorize the matrix in COMPLEX and use this @@ -64236,8 +64238,6 @@ module stdlib_linalg_lapack_z !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 !> respectively. - - subroutine stdlib_zcgesv( n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work,swork, rwork, iter, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64395,14 +64395,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zcgesv - !> ZGELQ: computes an LQ factorization of a complex M-by-N matrix A: + + pure subroutine stdlib_zgelq( m, n, a, lda, t, tsize, work, lwork,info ) + !> ZGELQ 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. - - pure subroutine stdlib_zgelq( m, n, a, lda, t, tsize, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -64520,7 +64520,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelq - !> ZGELSD: computes the minimum-norm solution to a real linear least + + subroutine stdlib_zgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & + !> ZGELSD 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 @@ -64545,8 +64547,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64858,7 +64858,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelsd - !> ZGELSS: computes the minimum norm solution to a complex linear + + subroutine stdlib_zgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & + !> ZGELSS 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 @@ -64870,8 +64872,6 @@ module stdlib_linalg_lapack_z !> The effective rank of A is determined by treating as zero those !> singular values which are less than RCOND times the largest singular !> value. - - subroutine stdlib_zgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65316,7 +65316,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelss - !> ZGELSY: computes the minimum-norm solution to a complex linear least + + subroutine stdlib_zgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, rwork, & + !> ZGELSY 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 @@ -65348,8 +65350,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, rwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65541,15 +65541,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelsy - !> ZGEMLQ: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_zgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & + !> ZGEMLQ 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 (ZGELQ) - - pure subroutine stdlib_zgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65638,15 +65638,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgemlq - !> ZGEMQR: overwrites the general real M-by-N matrix C with + + pure subroutine stdlib_zgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & + !> ZGEMQR 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 (ZGEQR) - - pure subroutine stdlib_zgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65735,15 +65735,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgemqr - !> ZGEQR: computes a QR factorization of a complex M-by-N matrix A: + + pure subroutine stdlib_zgeqr( m, n, a, lda, t, tsize, work, lwork,info ) + !> ZGEQR 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. - - pure subroutine stdlib_zgeqr( m, n, a, lda, t, tsize, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -65850,7 +65850,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeqr - !> ZGESDD: computes the singular value decomposition (SVD) of a complex + + subroutine stdlib_zgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, iwork, & + !> ZGESDD 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) @@ -65867,8 +65869,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, iwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67345,7 +67345,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgesdd - !> ZGESV: computes the solution to a complex system of linear equations + + pure subroutine stdlib_zgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) + !> ZGESV 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 @@ -67354,8 +67356,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67393,7 +67393,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgesv - !> ZGESVD: computes the singular value decomposition (SVD) of a complex + + subroutine stdlib_zgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,vt, ldvt, work, lwork, rwork, & + !> ZGESVD 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) @@ -67404,8 +67406,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,vt, ldvt, work, lwork, rwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69839,6 +69839,8 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgesvd + + subroutine stdlib_zgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & !> ZCGESVDQ 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] @@ -69848,8 +69850,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & numrank, iwork, liwork,cwork, lcwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -70717,14 +70717,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgesvdq - !> ZGESVX: uses the LU factorization to compute the solution to a complex + + subroutine stdlib_zgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & + !> ZGESVX uses the LU factorization to compute 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. !> Error bounds on the solution and a condition estimate are also !> provided. - - subroutine stdlib_zgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & x, ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70922,7 +70922,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgesvx - !> ZGETSLS: solves overdetermined or underdetermined complex linear systems + + subroutine stdlib_zgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) + !> ZGETSLS 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: @@ -70940,8 +70942,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -71159,7 +71159,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgetsls - !> ZGETSQRHRT: computes a NB2-sized column blocked QR-factorization + + pure subroutine stdlib_zgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) + !> ZGETSQRHRT 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 @@ -71171,8 +71173,6 @@ module stdlib_linalg_lapack_z !> The output Q and R factors are stored in the same format as in ZGEQRT !> (Q is in blocked compact WY-representation). See the documentation !> of ZGEQRT for more details on the format. - - pure subroutine stdlib_zgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71292,7 +71292,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgetsqrhrt - !> ZGGES: computes for a pair of N-by-N complex nonsymmetric matrices + + subroutine stdlib_zgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alpha, beta, & + !> ZGGES 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 @@ -71312,8 +71314,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alpha, beta, & vsl, ldvsl, vsr, ldvsr, work,lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71544,7 +71544,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgges - !> ZGGESX: computes for a pair of N-by-N complex nonsymmetric matrices + + subroutine stdlib_zggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, alpha,& + !> ZGGESX computes for a pair of N-by-N complex nonsymmetric matrices !> (A,B), the generalized eigenvalues, the complex Schur form (S,T), !> and, optionally, the left and/or right matrices of Schur vectors (VSL !> and VSR). This gives the generalized Schur factorization @@ -71566,8 +71568,6 @@ module stdlib_linalg_lapack_z !> A pair of matrices (S,T) is in generalized complex Schur form if T is !> upper triangular with non-negative diagonal and S is upper !> triangular. - - subroutine stdlib_zggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, alpha,& beta, vsl, ldvsl, vsr,ldvsr, rconde, rcondv, work, lwork, rwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- @@ -71854,7 +71854,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zggesx - !> ZGGEV: computes for a pair of N-by-N complex nonsymmetric matrices + + subroutine stdlib_zggev( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & + !> ZGGEV 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 @@ -71869,8 +71871,6 @@ module stdlib_linalg_lapack_z !> 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). - - subroutine stdlib_zggev( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72124,7 +72124,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zggev - !> ZGGEVX: computes for a pair of N-by-N complex nonsymmetric matrices + + subroutine stdlib_zggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alpha, beta, vl, & + !> ZGGEVX 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. !> Optionally, it also computes a balancing transformation to improve @@ -72144,8 +72146,6 @@ module stdlib_linalg_lapack_z !> 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). - - subroutine stdlib_zggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alpha, beta, vl, & ldvl, vr, ldvr, ilo, ihi,lscale, rscale, abnrm, bbnrm, rconde, rcondv,work, lwork, rwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -72472,10 +72472,10 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zggevx - !> ZHBEV: computes all the eigenvalues and, optionally, eigenvectors of - !> a complex Hermitian band matrix A. subroutine stdlib_zhbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,rwork, info ) + !> ZHBEV computes all the eigenvalues and, optionally, eigenvectors of + !> a complex Hermitian band matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72576,7 +72576,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhbev - !> ZHBEVD: computes all the eigenvalues and, optionally, eigenvectors of + + subroutine stdlib_zhbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, rwork, lrwork, & + !> ZHBEVD 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 @@ -72585,8 +72587,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zhbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, rwork, lrwork, & iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72726,12 +72726,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhbevd - !> ZHBEVX: computes selected eigenvalues and, optionally, eigenvectors + + subroutine stdlib_zhbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & + !> ZHBEVX computes selected eigenvalues and, optionally, eigenvectors !> of a complex Hermitian band matrix A. Eigenvalues and eigenvectors !> can be selected by specifying either a range of values or a range of !> indices for the desired eigenvalues. - - subroutine stdlib_zhbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & m, w, z, ldz, work, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72957,12 +72957,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhbevx - !> ZHBGV: computes all the eigenvalues, and optionally, the eigenvectors + + pure subroutine stdlib_zhbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & + !> ZHBGV 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. - - pure subroutine stdlib_zhbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73037,7 +73037,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhbgv - !> ZHBGVD: computes all the eigenvalues, and optionally, the eigenvectors + + pure subroutine stdlib_zhbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & + !> ZHBGVD 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 @@ -73048,8 +73050,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zhbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & lwork, rwork, lrwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73164,14 +73164,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhbgvd - !> ZHBGVX: computes all the eigenvalues, and optionally, the eigenvectors + + pure subroutine stdlib_zhbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & + !> ZHBGVX 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. Eigenvalues and !> eigenvectors can be selected by specifying either all eigenvalues, !> a range of values or a range of indices for the desired eigenvalues. - - pure subroutine stdlib_zhbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & vu, il, iu, abstol, m, w, z,ldz, work, rwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73353,7 +73353,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhbgvx - !> ZHEEVD: computes all eigenvalues and, optionally, eigenvectors of a + + subroutine stdlib_zheevd( jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, liwork,& + !> ZHEEVD 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 @@ -73362,8 +73364,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zheevd( jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, liwork,& info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73506,7 +73506,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zheevd - !> ZHEGVD: computes all the eigenvalues, and optionally, the eigenvectors + + subroutine stdlib_zhegvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, lrwork,& + !> ZHEGVD 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. @@ -73517,8 +73519,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zhegvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, lrwork,& iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73638,7 +73638,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhegvd - !> ZHPEVD: computes all the eigenvalues and, optionally, eigenvectors of + + subroutine stdlib_zhpevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,rwork, lrwork, iwork, & + !> ZHPEVD 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 @@ -73647,8 +73649,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zhpevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,rwork, lrwork, iwork, & liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73780,7 +73780,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpevd - !> ZHPGVD: computes all the eigenvalues and, optionally, the eigenvectors + + subroutine stdlib_zhpgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, rwork, lrwork,& + !> ZHPGVD 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 @@ -73792,8 +73794,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zhpgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, rwork, lrwork,& iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73913,7 +73913,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpgvd - !> ZGEES: computes for an N-by-N complex nonsymmetric matrix A, the + + subroutine stdlib_zgees( jobvs, sort, select, n, a, lda, sdim, w, vs,ldvs, work, lwork, & + !> ZGEES 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 @@ -73921,8 +73923,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zgees( jobvs, sort, select, n, a, lda, sdim, w, vs,ldvs, work, lwork, & rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74084,7 +74084,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgees - !> ZGEESX: computes for an N-by-N complex nonsymmetric matrix A, the + + subroutine stdlib_zgeesx( jobvs, sort, select, sense, n, a, lda, sdim, w,vs, ldvs, rconde, & + !> ZGEESX 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 @@ -74098,8 +74100,6 @@ module stdlib_linalg_lapack_z !> and RCONDV, see Section 4.10_dp of the LAPACK Users' Guide (where !> these quantities are called s and sep respectively). !> A complex matrix is in Schur form if it is upper triangular. - - subroutine stdlib_zgeesx( jobvs, sort, select, sense, n, a, lda, sdim, w,vs, ldvs, rconde, & rcondv, work, lwork, rwork,bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74286,7 +74286,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeesx - !> ZGEEV: computes for an N-by-N complex nonsymmetric matrix A, the + + subroutine stdlib_zgeev( jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr,work, lwork, rwork, & + !> ZGEEV 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) @@ -74296,8 +74298,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zgeev( jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr,work, lwork, rwork, & info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74535,7 +74535,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeev - !> ZGEEVX: computes for an N-by-N complex nonsymmetric matrix A, the + + subroutine stdlib_zgeevx( balanc, jobvl, jobvr, sense, n, a, lda, w, vl,ldvl, vr, ldvr, ilo, & + !> ZGEEVX computes for an N-by-N complex nonsymmetric matrix A, the !> eigenvalues and, optionally, the left and/or right eigenvectors. !> Optionally also, it computes a balancing transformation to improve !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, @@ -74560,8 +74562,6 @@ module stdlib_linalg_lapack_z !> (in exact arithmetic) but diagonal scaling will. For further !> explanation of balancing, see section 4.10.2_dp of the LAPACK !> Users' Guide. - - subroutine stdlib_zgeevx( balanc, jobvl, jobvr, sense, n, a, lda, w, vl,ldvl, vr, ldvr, ilo, & ihi, scale, abnrm, rconde,rcondv, work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74837,7 +74837,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeevx - !> ZGEJSV: computes the singular value decomposition (SVD) of a complex M-by-N + + pure subroutine stdlib_zgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & + !> ZGEJSV 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 @@ -74847,8 +74849,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & v, ldv,cwork, lwork, rwork, lrwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76242,7 +76242,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgejsv - !> ZGESVJ: computes the singular value decomposition (SVD) of a complex + + pure subroutine stdlib_zgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, cwork, lwork, & + !> ZGESVJ 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] @@ -76251,8 +76253,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, cwork, lwork, & rwork, lrwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77094,7 +77094,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgesvj - !> ZGGES3: computes for a pair of N-by-N complex nonsymmetric matrices + + subroutine stdlib_zgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alpha, beta, & + !> ZGGES3 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 @@ -77114,8 +77116,6 @@ module stdlib_linalg_lapack_z !> 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. - - subroutine stdlib_zgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alpha, beta, & vsl, ldvsl, vsr, ldvsr,work, lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77345,7 +77345,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgges3 - !> ZGGEV3: computes for a pair of N-by-N complex nonsymmetric matrices + + subroutine stdlib_zggev3( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & + !> ZGGEV3 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 @@ -77360,8 +77362,6 @@ module stdlib_linalg_lapack_z !> 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). - - subroutine stdlib_zggev3( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77617,12 +77617,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zggev3 - !> ZGSVJ0: is called from ZGESVJ as a pre-processor and that is its main + + pure subroutine stdlib_zgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & + !> ZGSVJ0 is called from ZGESVJ as a pre-processor and that is its main !> purpose. It applies Jacobi rotations in the same way as ZGESVJ does, but !> it does not check convergence (stopping criterion). Few tuning !> parameters (marked by [TP]) are available for the implementer. - - pure subroutine stdlib_zgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78158,7 +78158,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgsvj0 - !> ZGSVJ1: is called from ZGESVJ as a pre-processor and that is its main + + pure subroutine stdlib_zgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & + !> ZGSVJ1 is called from ZGESVJ as a pre-processor and that is its main !> purpose. It applies Jacobi rotations in the same way as ZGESVJ does, but !> it targets only particular pivots and it does not check convergence !> (stopping criterion). Few tuning parameters (marked by [TP]) are @@ -78182,8 +78184,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78531,7 +78531,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgsvj1 - !> ZHESV_AA: computes the solution to a complex system of linear equations + + pure subroutine stdlib_zhesv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) + !> ZHESV_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. @@ -78541,8 +78543,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zhesv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78603,14 +78603,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhesv_aa - !> ZHETRF_AA: computes the factorization of a complex hermitian matrix A + + pure subroutine stdlib_zhetrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) + !> ZHETRF_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. - - pure subroutine stdlib_zhetrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78832,7 +78832,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrf_aa - !> ZHSEQR: computes the eigenvalues of a Hessenberg matrix H + + pure subroutine stdlib_zhseqr( job, compz, n, ilo, ihi, h, ldh, w, z, ldz,work, lwork, info ) + !> ZHSEQR 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. @@ -78840,8 +78842,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zhseqr( job, compz, n, ilo, ihi, h, ldh, w, z, ldz,work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78977,6 +78977,8 @@ module stdlib_linalg_lapack_z end if end subroutine stdlib_zhseqr + + pure subroutine stdlib_zlahef_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) !> DLAHEF_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. @@ -78987,8 +78989,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zlahef_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79221,7 +79221,9 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlahef_aa - !> ZLAQR0: computes the eigenvalues of a Hessenberg matrix H + + pure subroutine stdlib_zlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& + !> ZLAQR0 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. @@ -79229,8 +79231,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79568,8 +79568,10 @@ module stdlib_linalg_lapack_z work( 1 ) = cmplx( lwkopt, 0,KIND=dp) end subroutine stdlib_zlaqr0 + + pure subroutine stdlib_zlaqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & !> Aggressive early deflation: - !> ZLAQR3: accepts as input an upper Hessenberg matrix + !> ZLAQR3 accepts as input an upper Hessenberg matrix !> H and performs an unitary similarity transformation !> designed to detect and deflate fully converged eigenvalues from !> a trailing principal submatrix. On output H has been over- @@ -79577,8 +79579,6 @@ module stdlib_linalg_lapack_z !> an unitary similarity transformation of H. It is to be !> hoped that the final version of H has many zero subdiagonal !> entries. - - pure subroutine stdlib_zlaqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & ns, nd, sh, v, ldv, nh, t, ldt,nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79790,7 +79790,9 @@ module stdlib_linalg_lapack_z work( 1 ) = cmplx( lwkopt, 0,KIND=dp) end subroutine stdlib_zlaqr3 - !> ZLAQR4: implements one level of recursion for ZLAQR0. + + pure subroutine stdlib_zlaqr4( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& + !> ZLAQR4 implements one level of recursion for ZLAQR0. !> It is a complete implementation of the small bulge multi-shift !> QR algorithm. It may be called by ZLAQR0 and, for large enough !> deflation window size, it may be called by ZLAQR3. This @@ -79804,8 +79806,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zlaqr4( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80138,7 +80138,9 @@ module stdlib_linalg_lapack_z work( 1 ) = cmplx( lwkopt, 0,KIND=dp) end subroutine stdlib_zlaqr4 - !> ZLAQZ0: computes the eigenvalues of a real matrix pair (H,T), + + recursive subroutine stdlib_zlaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alpha, & + !> ZLAQZ0 computes the eigenvalues of a real 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 @@ -80178,8 +80180,6 @@ module stdlib_linalg_lapack_z !> 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" - - recursive subroutine stdlib_zlaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alpha, & beta, q, ldq, z,ldz, work, lwork, rwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -80491,9 +80491,9 @@ module stdlib_linalg_lapack_z info = norm_info end subroutine stdlib_zlaqz0 - !> ZLAQZ2: performs AED recursive subroutine stdlib_zlaqz2( ilschur, ilq, ilz, n, ilo, ihi, nw,a, lda, b, ldb, q, & + !> ZLAQZ2 performs AED ldq, z, ldz, ns,nd, alpha, beta, qc, ldqc, zc, ldzc,work, lwork, rwork, rec, info ) ! arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -80680,6 +80680,8 @@ module stdlib_linalg_lapack_z end if end subroutine stdlib_zlaqz2 + + pure subroutine stdlib_zlasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) !> 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. @@ -80690,8 +80692,6 @@ module stdlib_linalg_lapack_z !> 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. - - pure subroutine stdlib_zlasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -80916,6 +80916,8 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlasyf_aa + + pure subroutine stdlib_zsysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) !> ZSYSV computes the solution to a complex system of linear equations !> A * X = B, !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS @@ -80926,8 +80928,6 @@ module stdlib_linalg_lapack_z !> where U (or L) is a product of permutation and unit upper (lower) !> triangular matrices, and T is symmetric tridiagonal. The factored !> form of A is then used to solve the system of equations A * X = B. - - pure subroutine stdlib_zsysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80988,14 +80988,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsysv_aa - !> ZSYTRF_AA: computes the factorization of a complex symmetric matrix A + + pure subroutine stdlib_zsytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) + !> ZSYTRF_AA computes the factorization of a complex symmetric matrix A !> using the Aasen's algorithm. The form of the factorization is !> A = U**T*T*U or A = L*T*L**T !> where U (or L) is a product of permutation and unit upper (lower) !> triangular matrices, and T is a complex symmetric tridiagonal matrix. !> This is the blocked version of the algorithm, calling Level 3 BLAS. - - pure subroutine stdlib_zsytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- From 5735af92cdf9aeb683a9b7939f487138cf33be4e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 Apr 2024 10:34:53 +0200 Subject: [PATCH 2/3] replace `!>` with `!!` --- src/refactor_interfaces.py | 115 + src/stdlib_linalg_blas.fypp | 458 +- src/stdlib_linalg_blas_aux.fypp | 64 +- src/stdlib_linalg_blas_c.fypp | 320 +- src/stdlib_linalg_blas_d.fypp | 350 +- src/stdlib_linalg_blas_q.fypp | 350 +- src/stdlib_linalg_blas_s.fypp | 352 +- src/stdlib_linalg_blas_w.fypp | 320 +- src/stdlib_linalg_blas_z.fypp | 320 +- src/stdlib_linalg_lapack.fypp | 8538 ++++++++++++++--------------- src/stdlib_linalg_lapack_aux.fypp | 246 +- src/stdlib_linalg_lapack_c.fypp | 7296 ++++++++++++------------ src/stdlib_linalg_lapack_d.fypp | 8222 ++++++++++++++------------- src/stdlib_linalg_lapack_q.fypp | 8222 ++++++++++++++------------- src/stdlib_linalg_lapack_s.fypp | 8088 ++++++++++++++------------- src/stdlib_linalg_lapack_w.fypp | 7428 +++++++++++++------------ src/stdlib_linalg_lapack_z.fypp | 7428 +++++++++++++------------ 17 files changed, 29076 insertions(+), 29041 deletions(-) create mode 100644 src/refactor_interfaces.py diff --git a/src/refactor_interfaces.py b/src/refactor_interfaces.py new file mode 100644 index 000000000..a07c709a3 --- /dev/null +++ b/src/refactor_interfaces.py @@ -0,0 +1,115 @@ + +import re +import copy +from platform import os + +def refactor_interfaces(file_name,interface_module): + + # Parse whole file + file_body = [] + comment_block = False + comment_body = [] + is_sub = False + is_fun = False + is_interface = False + + # FiLoad whole file; split by lines; join concatenation lines + with open(os.path.join(file_name), 'r') as file: + # Create an empty list to store the lines + + # Iterate over the lines of the file + for line in file: + + lsl = line.strip() + + is_comment = lsl.startswith('!>') + if not interface_module: + is_sub = bool(re.match(r'(?:.)*subroutine\s+stdlib_(\w+)',line)) + is_fun = bool(re.match(r'(?:.)*function stdlib_(\w+)',line)) + + + + else: + is_interface = lsl.startswith('interface') + + if is_comment: + # Start saving this new comment block + if not comment_block: comment_body = [] + + + # At the beginnging of a comment block, do not include empty comments + if lsl=='!> !' or lsl=='!>': + comment_block = False + line = '' + else: + comment_block = True + comment_body.append(line) + + elif is_interface or is_sub or is_fun: + # Comment is over and we're now at an interface: append interface line, follow + # documentaion + file_body.append(line) + + if is_interface: + interface_name = re.search(r'interface (\w+)',line).group(1) + elif is_sub: + print(line) + interface_name = re.search(r'(?:.)*subroutine\s+stdlib_(\w+)',line).group(1) + elif is_fun: + print(line) + + interface_name = re.search(r'(?:.)*function stdlib_(\w+)',line).group(1) + + axpy = interface_name.strip().upper() + search_label = r'!> '+axpy+r':\s*' + + if not comment_body is None: + for k in range(len(comment_body)): + + nointerf = re.sub(search_label,r'!> '+axpy+' ',comment_body[k]) + nointerf = re.sub(r'!> ',r'!! ',nointerf) + file_body.append(nointerf) + + comment_body = [] + + else: + # Regular body: just append line + file_body.append(line) + + + + # print file out + fid = open(file_name,"w") + + # Header + fid.write(''.join(file_body)) + fid.close() + + + +# Run refactor +refactor_interfaces('stdlib_linalg_blas.fypp',True) +refactor_interfaces('stdlib_linalg_blas_aux.fypp',False) +refactor_interfaces('stdlib_linalg_blas_s.fypp',False) +refactor_interfaces('stdlib_linalg_blas_d.fypp',False) +refactor_interfaces('stdlib_linalg_blas_q.fypp',False) +refactor_interfaces('stdlib_linalg_blas_c.fypp',False) +refactor_interfaces('stdlib_linalg_blas_z.fypp',False) +refactor_interfaces('stdlib_linalg_blas_w.fypp',False) +refactor_interfaces('stdlib_linalg_lapack.fypp',True) +refactor_interfaces('stdlib_linalg_lapack_aux.fypp',False) +refactor_interfaces('stdlib_linalg_lapack_s.fypp',False) +refactor_interfaces('stdlib_linalg_lapack_d.fypp',False) +refactor_interfaces('stdlib_linalg_lapack_q.fypp',False) +refactor_interfaces('stdlib_linalg_lapack_c.fypp',False) +refactor_interfaces('stdlib_linalg_lapack_z.fypp',False) +refactor_interfaces('stdlib_linalg_lapack_w.fypp',False) + + + + + + + + + diff --git a/src/stdlib_linalg_blas.fypp b/src/stdlib_linalg_blas.fypp index e7327830c..0bec4e6d3 100644 --- a/src/stdlib_linalg_blas.fypp +++ b/src/stdlib_linalg_blas.fypp @@ -16,7 +16,7 @@ module stdlib_linalg_blas public interface axpy - !> AXPY constant times a vector plus a vector. + !! AXPY constant times a vector plus a vector. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine caxpy(n,ca,cx,incx,cy,incy) import sp,dp,qp,ilp,lk @@ -72,7 +72,7 @@ module stdlib_linalg_blas interface copy - !> COPY copies a vector x to a vector y. + !! COPY copies a vector x to a vector y. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ccopy(n,cx,incx,cy,incy) import sp,dp,qp,ilp,lk @@ -128,8 +128,8 @@ module stdlib_linalg_blas interface dot - !> DOT forms the dot product of two vectors. - !> uses unrolled loops for increments equal to one. + !! DOT forms the dot product of two vectors. + !! uses unrolled loops for increments equal to one. #ifdef STDLIB_EXTERNAL_BLAS pure real(dp) function ddot(n,dx,incx,dy,incy) import sp,dp,qp,ilp,lk @@ -158,8 +158,8 @@ module stdlib_linalg_blas interface dotc - !> DOTC forms the dot product of two complex vectors - !> DOTC = X^H * Y + !! DOTC forms the dot product of two complex vectors + !! DOTC = X^H * Y #ifdef STDLIB_EXTERNAL_BLAS pure complex(sp) function cdotc(n,cx,incx,cy,incy) import sp,dp,qp,ilp,lk @@ -188,8 +188,8 @@ module stdlib_linalg_blas interface dotu - !> DOTU forms the dot product of two complex vectors - !> DOTU = X^T * Y + !! DOTU forms the dot product of two complex vectors + !! DOTU = X^T * Y #ifdef STDLIB_EXTERNAL_BLAS pure complex(sp) function cdotu(n,cx,incx,cy,incy) import sp,dp,qp,ilp,lk @@ -218,11 +218,11 @@ module stdlib_linalg_blas interface gbmv - !> GBMV performs one of the matrix-vector operations - !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or - !> y := alpha*A**H*x + beta*y, - !> where alpha and beta are scalars, x and y are vectors and A is an - !> m by n band matrix, with kl sub-diagonals and ku super-diagonals. + !! GBMV performs one of the matrix-vector operations + !! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or + !! y := alpha*A**H*x + beta*y, + !! where alpha and beta are scalars, x and y are vectors and A is an + !! m by n band matrix, with kl sub-diagonals and ku super-diagonals. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -282,12 +282,12 @@ module stdlib_linalg_blas interface gemm - !> GEMM performs one of the matrix-matrix operations - !> C := alpha*op( A )*op( B ) + beta*C, - !> where op( X ) is one of - !> op( X ) = X or op( X ) = X**T or op( X ) = X**H, - !> alpha and beta are scalars, and A, B and C are matrices, with op( A ) - !> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. + !! GEMM performs one of the matrix-matrix operations + !! C := alpha*op( A )*op( B ) + beta*C, + !! where op( X ) is one of + !! op( X ) = X or op( X ) = X**T or op( X ) = X**H, + !! alpha and beta are scalars, and A, B and C are matrices, with op( A ) + !! an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) import sp,dp,qp,ilp,lk @@ -347,11 +347,11 @@ module stdlib_linalg_blas interface gemv - !> GEMV performs one of the matrix-vector operations - !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or - !> y := alpha*A**H*x + beta*y, - !> where alpha and beta are scalars, x and y are vectors and A is an - !> m by n matrix. + !! GEMV performs one of the matrix-vector operations + !! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or + !! y := alpha*A**H*x + beta*y, + !! where alpha and beta are scalars, x and y are vectors and A is an + !! m by n matrix. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -411,10 +411,10 @@ module stdlib_linalg_blas interface ger - !> GER performs the rank 1 operation - !> A := alpha*x*y**T + A, - !> where alpha is a scalar, x is an m element vector, y is an n element - !> vector and A is an m by n matrix. + !! GER performs the rank 1 operation + !! A := alpha*x*y**T + A, + !! where alpha is a scalar, x is an m element vector, y is an n element + !! vector and A is an m by n matrix. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dger(m,n,alpha,x,incx,y,incy,a,lda) import sp,dp,qp,ilp,lk @@ -445,10 +445,10 @@ module stdlib_linalg_blas interface gerc - !> GERC performs the rank 1 operation - !> A := alpha*x*y**H + A, - !> where alpha is a scalar, x is an m element vector, y is an n element - !> vector and A is an m by n matrix. + !! GERC performs the rank 1 operation + !! A := alpha*x*y**H + A, + !! where alpha is a scalar, x is an m element vector, y is an n element + !! vector and A is an m by n matrix. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cgerc(m,n,alpha,x,incx,y,incy,a,lda) import sp,dp,qp,ilp,lk @@ -479,10 +479,10 @@ module stdlib_linalg_blas interface geru - !> GERU performs the rank 1 operation - !> A := alpha*x*y**T + A, - !> where alpha is a scalar, x is an m element vector, y is an n element - !> vector and A is an m by n matrix. + !! GERU performs the rank 1 operation + !! A := alpha*x*y**T + A, + !! where alpha is a scalar, x is an m element vector, y is an n element + !! vector and A is an m by n matrix. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cgeru(m,n,alpha,x,incx,y,incy,a,lda) import sp,dp,qp,ilp,lk @@ -513,10 +513,10 @@ module stdlib_linalg_blas interface hbmv - !> HBMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n hermitian band matrix, with k super-diagonals. + !! HBMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n hermitian band matrix, with k super-diagonals. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine chbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -549,12 +549,12 @@ module stdlib_linalg_blas interface hemm - !> HEMM performs one of the matrix-matrix operations - !> C := alpha*A*B + beta*C, - !> or - !> C := alpha*B*A + beta*C, - !> where alpha and beta are scalars, A is an hermitian matrix and B and - !> C are m by n matrices. + !! HEMM performs one of the matrix-matrix operations + !! C := alpha*A*B + beta*C, + !! or + !! C := alpha*B*A + beta*C, + !! where alpha and beta are scalars, A is an hermitian matrix and B and + !! C are m by n matrices. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine chemm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) import sp,dp,qp,ilp,lk @@ -587,10 +587,10 @@ module stdlib_linalg_blas interface hemv - !> HEMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n hermitian matrix. + !! HEMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n hermitian matrix. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine chemv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -623,10 +623,10 @@ module stdlib_linalg_blas interface her - !> HER performs the hermitian rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n hermitian matrix. + !! HER performs the hermitian rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n hermitian matrix. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cher(uplo,n,alpha,x,incx,a,lda) import sp,dp,qp,ilp,lk @@ -661,10 +661,10 @@ module stdlib_linalg_blas interface her2 - !> HER2 performs the hermitian rank 2 operation - !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, - !> where alpha is a scalar, x and y are n element vectors and A is an n - !> by n hermitian matrix. + !! HER2 performs the hermitian rank 2 operation + !! A := alpha*x*y**H + conjg( alpha )*y*x**H + A, + !! where alpha is a scalar, x and y are n element vectors and A is an n + !! by n hermitian matrix. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cher2(uplo,n,alpha,x,incx,y,incy,a,lda) import sp,dp,qp,ilp,lk @@ -697,13 +697,13 @@ module stdlib_linalg_blas interface her2k - !> HER2K performs one of the hermitian rank 2k operations - !> C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C, - !> or - !> C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C, - !> where alpha and beta are scalars with beta real, C is an n by n - !> hermitian matrix and A and B are n by k matrices in the first case - !> and k by n matrices in the second case. + !! HER2K performs one of the hermitian rank 2k operations + !! C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C, + !! or + !! C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C, + !! where alpha and beta are scalars with beta real, C is an n by n + !! hermitian matrix and A and B are n by k matrices in the first case + !! and k by n matrices in the second case. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cher2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) import sp,dp,qp,ilp,lk @@ -738,13 +738,13 @@ module stdlib_linalg_blas interface herk - !> HERK performs one of the hermitian rank k operations - !> C := alpha*A*A**H + beta*C, - !> or - !> C := alpha*A**H*A + beta*C, - !> where alpha and beta are real scalars, C is an n by n hermitian - !> matrix and A is an n by k matrix in the first case and a k by n - !> matrix in the second case. + !! HERK performs one of the hermitian rank k operations + !! C := alpha*A*A**H + beta*C, + !! or + !! C := alpha*A**H*A + beta*C, + !! where alpha and beta are real scalars, C is an n by n hermitian + !! matrix and A is an n by k matrix in the first case and a k by n + !! matrix in the second case. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cherk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) import sp,dp,qp,ilp,lk @@ -779,10 +779,10 @@ module stdlib_linalg_blas interface hpmv - !> HPMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n hermitian matrix, supplied in packed form. + !! HPMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n hermitian matrix, supplied in packed form. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine chpmv(uplo,n,alpha,ap,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -815,10 +815,10 @@ module stdlib_linalg_blas interface hpr - !> HPR performs the hermitian rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n hermitian matrix, supplied in packed form. + !! HPR performs the hermitian rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n hermitian matrix, supplied in packed form. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine chpr(uplo,n,alpha,x,incx,ap) import sp,dp,qp,ilp,lk @@ -853,10 +853,10 @@ module stdlib_linalg_blas interface hpr2 - !> HPR2 performs the hermitian rank 2 operation - !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, - !> where alpha is a scalar, x and y are n element vectors and A is an - !> n by n hermitian matrix, supplied in packed form. + !! HPR2 performs the hermitian rank 2 operation + !! A := alpha*x*y**H + conjg( alpha )*y*x**H + A, + !! where alpha is a scalar, x and y are n element vectors and A is an + !! n by n hermitian matrix, supplied in packed form. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine chpr2(uplo,n,alpha,x,incx,y,incy,ap) import sp,dp,qp,ilp,lk @@ -889,11 +889,9 @@ module stdlib_linalg_blas interface nrm2 - !> ! - !> - !> NRM2 returns the euclidean norm of a vector via the function - !> name, so that - !> NRM2 := sqrt( x'*x ) + !! NRM2 returns the euclidean norm of a vector via the function + !! name, so that + !! NRM2 := sqrt( x'*x ) #ifdef STDLIB_EXTERNAL_BLAS pure real(dp) function dnrm2( n, x, incx ) import sp,dp,qp,ilp,lk @@ -922,7 +920,7 @@ module stdlib_linalg_blas interface rot - !> ROT applies a plane rotation. + !! ROT applies a plane rotation. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine drot(n,dx,incx,dy,incy,c,s) import sp,dp,qp,ilp,lk @@ -953,21 +951,19 @@ module stdlib_linalg_blas interface rotg - !> ! - !> - !> The computation uses the formulas - !> |x| = sqrt( Re(x)**2 + Im(x)**2 ) - !> sgn(x) = x / |x| if x /= 0 - !> = 1 if x = 0 - !> c = |a| / sqrt(|a|**2 + |b|**2) - !> s = sgn(a) * conjg(b) / sqrt(|a|**2 + |b|**2) - !> When a and b are real and r /= 0, the formulas simplify to - !> r = sgn(a)*sqrt(|a|**2 + |b|**2) - !> c = a / r - !> s = b / r - !> the same as in SROTG when |a| > |b|. When |b| >= |a|, the - !> sign of c and s will be different from those computed by SROTG - !> if the signs of a and b are not the same. + !! The computation uses the formulas + !! |x| = sqrt( Re(x)**2 + Im(x)**2 ) + !! sgn(x) = x / |x| if x /= 0 + !! = 1 if x = 0 + !! c = |a| / sqrt(|a|**2 + |b|**2) + !! s = sgn(a) * conjg(b) / sqrt(|a|**2 + |b|**2) + !! When a and b are real and r /= 0, the formulas simplify to + !! r = sgn(a)*sqrt(|a|**2 + |b|**2) + !! c = a / r + !! s = b / r + !! the same as in SROTG when |a| > |b|. When |b| >= |a|, the + !! sign of c and s will be different from those computed by SROTG + !! if the signs of a and b are not the same. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine crotg( a, b, c, s ) import sp,dp,qp,ilp,lk @@ -1023,17 +1019,17 @@ module stdlib_linalg_blas interface rotm - !> APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX - !> (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN - !> (DY**T) - !> DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX >= 0, ELSE - !> LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. - !> WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. - !> DFLAG=-1._dp DFLAG=0._dp DFLAG=1._dp DFLAG=-2.D0 - !> (DH11 DH12) (1._dp DH12) (DH11 1._dp) (1._dp 0._dp) - !> H=( ) ( ) ( ) ( ) - !> (DH21 DH22), (DH21 1._dp), (-1._dp DH22), (0._dp 1._dp). - !> SEE ROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. + !! APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX + !! (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN + !! (DY**T) + !! DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX >= 0, ELSE + !! LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. + !! WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. + !! DFLAG=-1._dp DFLAG=0._dp DFLAG=1._dp DFLAG=-2.D0 + !! (DH11 DH12) (1._dp DH12) (DH11 1._dp) (1._dp 0._dp) + !! H=( ) ( ) ( ) ( ) + !! (DH21 DH22), (DH21 1._dp), (-1._dp DH22), (0._dp 1._dp). + !! SEE ROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine drotm(n,dx,incx,dy,incy,dparam) import sp,dp,qp,ilp,lk @@ -1064,19 +1060,19 @@ module stdlib_linalg_blas interface rotmg - !> CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS - !> THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(DD1)*DX1,SQRT(DD2) DY2)**T. - !> WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. - !> DFLAG=-1._dp DFLAG=0._dp DFLAG=1._dp DFLAG=-2.D0 - !> (DH11 DH12) (1._dp DH12) (DH11 1._dp) (1._dp 0._dp) - !> H=( ) ( ) ( ) ( ) - !> (DH21 DH22), (DH21 1._dp), (-1._dp DH22), (0._dp 1._dp). - !> LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22 - !> RESPECTIVELY. (VALUES OF 1._dp, -1._dp, OR 0._dp IMPLIED BY THE - !> VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.) - !> THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE - !> INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE - !> OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. + !! CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS + !! THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(DD1)*DX1,SQRT(DD2) DY2)**T. + !! WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. + !! DFLAG=-1._dp DFLAG=0._dp DFLAG=1._dp DFLAG=-2.D0 + !! (DH11 DH12) (1._dp DH12) (DH11 1._dp) (1._dp 0._dp) + !! H=( ) ( ) ( ) ( ) + !! (DH21 DH22), (DH21 1._dp), (-1._dp DH22), (0._dp 1._dp). + !! LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22 + !! RESPECTIVELY. (VALUES OF 1._dp, -1._dp, OR 0._dp IMPLIED BY THE + !! VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.) + !! THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE + !! INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE + !! OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine drotmg(dd1,dd2,dx1,dy1,dparam) import sp,dp,qp,ilp,lk @@ -1107,10 +1103,10 @@ module stdlib_linalg_blas interface sbmv - !> SBMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric band matrix, with k super-diagonals. + !! SBMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric band matrix, with k super-diagonals. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dsbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -1143,7 +1139,7 @@ module stdlib_linalg_blas interface scal - !> SCAL scales a vector by a constant. + !! SCAL scales a vector by a constant. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cscal(n,ca,cx,incx) import sp,dp,qp,ilp,lk @@ -1199,12 +1195,12 @@ module stdlib_linalg_blas interface sdot - !> Compute the inner product of two vectors with extended - !> precision accumulation and result. - !> Returns D.P. dot product accumulated in D.P., for S.P. SX and SY - !> SDOT = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY), - !> where LX = 1 if INCX >= 0, else LX = 1+(1-N)*INCX, and LY is - !> defined in a similar way using INCY. + !! Compute the inner product of two vectors with extended + !! precision accumulation and result. + !! Returns D.P. dot product accumulated in D.P., for S.P. SX and SY + !! SDOT = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY), + !! where LX = 1 if INCX >= 0, else LX = 1+(1-N)*INCX, and LY is + !! defined in a similar way using INCY. #ifdef STDLIB_EXTERNAL_BLAS pure real(dp) function dsdot(n,sx,incx,sy,incy) import sp,dp,qp,ilp,lk @@ -1223,10 +1219,10 @@ module stdlib_linalg_blas interface spmv - !> SPMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix, supplied in packed form. + !! SPMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix, supplied in packed form. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dspmv(uplo,n,alpha,ap,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -1259,10 +1255,10 @@ module stdlib_linalg_blas interface spr - !> SPR performs the symmetric rank 1 operation - !> A := alpha*x*x**T + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n symmetric matrix, supplied in packed form. + !! SPR performs the symmetric rank 1 operation + !! A := alpha*x*x**T + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n symmetric matrix, supplied in packed form. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dspr(uplo,n,alpha,x,incx,ap) import sp,dp,qp,ilp,lk @@ -1295,10 +1291,10 @@ module stdlib_linalg_blas interface spr2 - !> SPR2 performs the symmetric rank 2 operation - !> A := alpha*x*y**T + alpha*y*x**T + A, - !> where alpha is a scalar, x and y are n element vectors and A is an - !> n by n symmetric matrix, supplied in packed form. + !! SPR2 performs the symmetric rank 2 operation + !! A := alpha*x*y**T + alpha*y*x**T + A, + !! where alpha is a scalar, x and y are n element vectors and A is an + !! n by n symmetric matrix, supplied in packed form. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dspr2(uplo,n,alpha,x,incx,y,incy,ap) import sp,dp,qp,ilp,lk @@ -1331,9 +1327,9 @@ module stdlib_linalg_blas interface srot - !> SROT applies a plane rotation, where the cos and sin (c and s) are real - !> and the vectors cx and cy are complex. - !> jack dongarra, linpack, 3/11/78. + !! SROT applies a plane rotation, where the cos and sin (c and s) are real + !! and the vectors cx and cy are complex. + !! jack dongarra, linpack, 3/11/78. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine csrot( n, cx, incx, cy, incy, c, s ) import sp,dp,qp,ilp,lk @@ -1350,7 +1346,7 @@ module stdlib_linalg_blas interface sscal - !> SSCAL scales a complex vector by a real constant. + !! SSCAL scales a complex vector by a real constant. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine csscal(n,sa,cx,incx) import sp,dp,qp,ilp,lk @@ -1367,7 +1363,7 @@ module stdlib_linalg_blas interface swap - !> SWAP interchanges two vectors. + !! SWAP interchanges two vectors. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine cswap(n,cx,incx,cy,incy) import sp,dp,qp,ilp,lk @@ -1419,12 +1415,12 @@ module stdlib_linalg_blas interface symm - !> SYMM performs one of the matrix-matrix operations - !> C := alpha*A*B + beta*C, - !> or - !> C := alpha*B*A + beta*C, - !> where alpha and beta are scalars, A is a symmetric matrix and B and - !> C are m by n matrices. + !! SYMM performs one of the matrix-matrix operations + !! C := alpha*A*B + beta*C, + !! or + !! C := alpha*B*A + beta*C, + !! where alpha and beta are scalars, A is a symmetric matrix and B and + !! C are m by n matrices. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine csymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) import sp,dp,qp,ilp,lk @@ -1484,10 +1480,10 @@ module stdlib_linalg_blas interface symv - !> SYMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix. + !! SYMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dsymv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) import sp,dp,qp,ilp,lk @@ -1520,10 +1516,10 @@ module stdlib_linalg_blas interface syr - !> SYR performs the symmetric rank 1 operation - !> A := alpha*x*x**T + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n symmetric matrix. + !! SYR performs the symmetric rank 1 operation + !! A := alpha*x*x**T + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n symmetric matrix. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dsyr(uplo,n,alpha,x,incx,a,lda) import sp,dp,qp,ilp,lk @@ -1556,10 +1552,10 @@ module stdlib_linalg_blas interface syr2 - !> SYR2 performs the symmetric rank 2 operation - !> A := alpha*x*y**T + alpha*y*x**T + A, - !> where alpha is a scalar, x and y are n element vectors and A is an n - !> by n symmetric matrix. + !! SYR2 performs the symmetric rank 2 operation + !! A := alpha*x*y**T + alpha*y*x**T + A, + !! where alpha is a scalar, x and y are n element vectors and A is an n + !! by n symmetric matrix. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine dsyr2(uplo,n,alpha,x,incx,y,incy,a,lda) import sp,dp,qp,ilp,lk @@ -1592,13 +1588,13 @@ module stdlib_linalg_blas interface syr2k - !> SYR2K performs one of the symmetric rank 2k operations - !> C := alpha*A*B**T + alpha*B*A**T + beta*C, - !> or - !> C := alpha*A**T*B + alpha*B**T*A + beta*C, - !> where alpha and beta are scalars, C is an n by n symmetric matrix - !> and A and B are n by k matrices in the first case and k by n - !> matrices in the second case. + !! SYR2K performs one of the symmetric rank 2k operations + !! C := alpha*A*B**T + alpha*B*A**T + beta*C, + !! or + !! C := alpha*A**T*B + alpha*B**T*A + beta*C, + !! where alpha and beta are scalars, C is an n by n symmetric matrix + !! and A and B are n by k matrices in the first case and k by n + !! matrices in the second case. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine csyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) import sp,dp,qp,ilp,lk @@ -1658,13 +1654,13 @@ module stdlib_linalg_blas interface syrk - !> SYRK performs one of the symmetric rank k operations - !> C := alpha*A*A**T + beta*C, - !> or - !> C := alpha*A**T*A + beta*C, - !> where alpha and beta are scalars, C is an n by n symmetric matrix - !> and A is an n by k matrix in the first case and a k by n matrix - !> in the second case. + !! SYRK performs one of the symmetric rank k operations + !! C := alpha*A*A**T + beta*C, + !! or + !! C := alpha*A**T*A + beta*C, + !! where alpha and beta are scalars, C is an n by n symmetric matrix + !! and A is an n by k matrix in the first case and a k by n matrix + !! in the second case. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine csyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) import sp,dp,qp,ilp,lk @@ -1724,10 +1720,10 @@ module stdlib_linalg_blas interface tbmv - !> TBMV performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, or x := A**H*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular band matrix, with ( k + 1 ) diagonals. + !! TBMV performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, or x := A**H*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular band matrix, with ( k + 1 ) diagonals. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctbmv(uplo,trans,diag,n,k,a,lda,x,incx) import sp,dp,qp,ilp,lk @@ -1787,13 +1783,13 @@ module stdlib_linalg_blas interface tbsv - !> TBSV solves one of the systems of equations - !> A*x = b, or A**T*x = b, or A**H*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular band matrix, with ( k + 1 ) - !> diagonals. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! TBSV solves one of the systems of equations + !! A*x = b, or A**T*x = b, or A**H*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular band matrix, with ( k + 1 ) + !! diagonals. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctbsv(uplo,trans,diag,n,k,a,lda,x,incx) import sp,dp,qp,ilp,lk @@ -1853,10 +1849,10 @@ module stdlib_linalg_blas interface tpmv - !> TPMV performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, or x := A**H*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular matrix, supplied in packed form. + !! TPMV performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, or x := A**H*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular matrix, supplied in packed form. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctpmv(uplo,trans,diag,n,ap,x,incx) import sp,dp,qp,ilp,lk @@ -1916,12 +1912,12 @@ module stdlib_linalg_blas interface tpsv - !> TPSV solves one of the systems of equations - !> A*x = b, or A**T*x = b, or A**H*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular matrix, supplied in packed form. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! TPSV solves one of the systems of equations + !! A*x = b, or A**T*x = b, or A**H*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular matrix, supplied in packed form. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctpsv(uplo,trans,diag,n,ap,x,incx) import sp,dp,qp,ilp,lk @@ -1981,11 +1977,11 @@ module stdlib_linalg_blas interface trmm - !> TRMM performs one of the matrix-matrix operations - !> B := alpha*op( A )*B, or B := alpha*B*op( A ) - !> where alpha is a scalar, B is an m by n matrix, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. + !! TRMM performs one of the matrix-matrix operations + !! B := alpha*op( A )*B, or B := alpha*B*op( A ) + !! where alpha is a scalar, B is an m by n matrix, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T or op( A ) = A**H. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) import sp,dp,qp,ilp,lk @@ -2045,10 +2041,10 @@ module stdlib_linalg_blas interface trmv - !> TRMV performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, or x := A**H*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular matrix. + !! TRMV performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, or x := A**H*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular matrix. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctrmv(uplo,trans,diag,n,a,lda,x,incx) import sp,dp,qp,ilp,lk @@ -2108,12 +2104,12 @@ module stdlib_linalg_blas interface trsm - !> TRSM solves one of the matrix equations - !> op( A )*X = alpha*B, or X*op( A ) = alpha*B, - !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. - !> The matrix X is overwritten on B. + !! TRSM solves one of the matrix equations + !! op( A )*X = alpha*B, or X*op( A ) = alpha*B, + !! where alpha is a scalar, X and B are m by n matrices, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T or op( A ) = A**H. + !! The matrix X is overwritten on B. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) import sp,dp,qp,ilp,lk @@ -2173,12 +2169,12 @@ module stdlib_linalg_blas interface trsv - !> TRSV solves one of the systems of equations - !> A*x = b, or A**T*x = b, or A**H*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular matrix. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! TRSV solves one of the systems of equations + !! A*x = b, or A**T*x = b, or A**H*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular matrix. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine ctrsv(uplo,trans,diag,n,a,lda,x,incx) import sp,dp,qp,ilp,lk diff --git a/src/stdlib_linalg_blas_aux.fypp b/src/stdlib_linalg_blas_aux.fypp index 52703829d..10ce0e7cd 100644 --- a/src/stdlib_linalg_blas_aux.fypp +++ b/src/stdlib_linalg_blas_aux.fypp @@ -30,7 +30,7 @@ module stdlib_linalg_blas_aux pure real(dp) function stdlib_dcabs1(z) - !> DCABS1 computes |Re(.)| + |Im(.)| of a double complex number + !! DCABS1 computes |Re(.)| + |Im(.)| of a double complex number ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45,7 +45,7 @@ module stdlib_linalg_blas_aux pure integer(ilp) function stdlib_isamax(n,sx,incx) - !> ISAMAX finds the index of the first element having maximum absolute value. + !! ISAMAX finds the index of the first element having maximum absolute value. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -90,7 +90,7 @@ module stdlib_linalg_blas_aux pure integer(ilp) function stdlib_izamax(n,zx,incx) - !> IZAMAX finds the index of the first element having maximum |Re(.)| + |Im(.)| + !! IZAMAX finds the index of the first element having maximum |Re(.)| + |Im(.)| ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -133,8 +133,8 @@ module stdlib_linalg_blas_aux pure logical(lk) function stdlib_lsame(ca,cb) - !> LSAME returns .TRUE. if CA is the same letter as CB regardless of - !> case. + !! LSAME returns .TRUE. if CA is the same letter as CB regardless of + !! case. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -180,7 +180,7 @@ module stdlib_linalg_blas_aux pure real(sp) function stdlib_scabs1(z) - !> SCABS1 computes |Re(.)| + |Im(.)| of a complex number + !! SCABS1 computes |Re(.)| + |Im(.)| of a complex number ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -195,11 +195,11 @@ module stdlib_linalg_blas_aux pure subroutine stdlib_xerbla( srname, info ) - !> XERBLA is an error handler for the LAPACK routines. - !> It is called by an LAPACK routine if an input parameter has an - !> invalid value. A message is printed and execution stops. - !> Installers may consider modifying the STOP statement in order to - !> call system-specific exception-handling facilities. + !! XERBLA is an error handler for the LAPACK routines. + !! It is called by an LAPACK routine if an input parameter has an + !! invalid value. A message is printed and execution stops. + !! Installers may consider modifying the STOP statement in order to + !! call system-specific exception-handling facilities. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -216,22 +216,22 @@ module stdlib_linalg_blas_aux pure subroutine stdlib_xerbla_array(srname_array, srname_len, info) - !> XERBLA_ARRAY assists other languages in calling XERBLA, the LAPACK - !> and BLAS error handler. Rather than taking a Fortran string argument - !> as the function's name, XERBLA_ARRAY takes an array of single - !> characters along with the array's length. XERBLA_ARRAY then copies - !> up to 32 characters of that array into a Fortran string and passes - !> that to XERBLA. If called with a non-positive SRNAME_LEN, - !> XERBLA_ARRAY will call XERBLA with a string of all blank characters. - !> Say some macro or other device makes XERBLA_ARRAY available to C99 - !> by a name lapack_xerbla and with a common Fortran calling convention. - !> Then a C99 program could invoke XERBLA via: - !> { - !> int flen = strlen(__func__); - !> lapack_xerbla(__func__, - !> } - !> Providing XERBLA_ARRAY is not necessary for intercepting LAPACK - !> errors. XERBLA_ARRAY calls XERBLA. + !! XERBLA_ARRAY assists other languages in calling XERBLA, the LAPACK + !! and BLAS error handler. Rather than taking a Fortran string argument + !! as the function's name, XERBLA_ARRAY takes an array of single + !! characters along with the array's length. XERBLA_ARRAY then copies + !! up to 32 characters of that array into a Fortran string and passes + !! that to XERBLA. If called with a non-positive SRNAME_LEN, + !! XERBLA_ARRAY will call XERBLA with a string of all blank characters. + !! Say some macro or other device makes XERBLA_ARRAY available to C99 + !! by a name lapack_xerbla and with a common Fortran calling convention. + !! Then a C99 program could invoke XERBLA via: + !! { + !! int flen = strlen(__func__); + !! lapack_xerbla(__func__, + !! } + !! Providing XERBLA_ARRAY is not necessary for intercepting LAPACK + !! errors. XERBLA_ARRAY calls XERBLA. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -259,7 +259,7 @@ module stdlib_linalg_blas_aux pure real(qp) function stdlib_qcabs1(z) - !> DCABS1: computes |Re(.)| + |Im(.)| of a double complex number + !! DCABS1: computes |Re(.)| + |Im(.)| of a double complex number ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -277,7 +277,7 @@ module stdlib_linalg_blas_aux pure integer(ilp) function stdlib_iqamax(n,dx,incx) - !> IDAMAX: finds the index of the first element having maximum absolute value. + !! IDAMAX: finds the index of the first element having maximum absolute value. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -325,7 +325,7 @@ module stdlib_linalg_blas_aux pure integer(ilp) function stdlib_iwamax(n,zx,incx) - !> IZAMAX: finds the index of the first element having maximum |Re(.)| + |Im(.)| + !! IZAMAX: finds the index of the first element having maximum |Re(.)| + |Im(.)| ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -369,7 +369,7 @@ module stdlib_linalg_blas_aux pure integer(ilp) function stdlib_icamax(n,cx,incx) - !> ICAMAX finds the index of the first element having maximum |Re(.)| + |Im(.)| + !! ICAMAX finds the index of the first element having maximum |Re(.)| + |Im(.)| ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -412,7 +412,7 @@ module stdlib_linalg_blas_aux pure integer(ilp) function stdlib_idamax(n,dx,incx) - !> IDAMAX finds the index of the first element having maximum absolute value. + !! IDAMAX finds the index of the first element having maximum absolute value. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_blas_c.fypp b/src/stdlib_linalg_blas_c.fypp index 8a0be884a..7a6145506 100644 --- a/src/stdlib_linalg_blas_c.fypp +++ b/src/stdlib_linalg_blas_c.fypp @@ -86,7 +86,7 @@ module stdlib_linalg_blas_c pure subroutine stdlib_caxpy(n,ca,cx,incx,cy,incy) - !> CAXPY constant times a vector plus a vector. + !! CAXPY constant times a vector plus a vector. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -124,7 +124,7 @@ module stdlib_linalg_blas_c pure subroutine stdlib_ccopy(n,cx,incx,cy,incy) - !> CCOPY copies a vector x to a vector y. + !! CCOPY copies a vector x to a vector y. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -160,8 +160,8 @@ module stdlib_linalg_blas_c pure complex(sp) function stdlib_cdotc(n,cx,incx,cy,incy) - !> CDOTC forms the dot product of two complex vectors - !> CDOTC = X^H * Y + !! CDOTC forms the dot product of two complex vectors + !! CDOTC = X^H * Y ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -202,8 +202,8 @@ module stdlib_linalg_blas_c pure complex(sp) function stdlib_cdotu(n,cx,incx,cy,incy) - !> CDOTU forms the dot product of two complex vectors - !> CDOTU = X^T * Y + !! CDOTU forms the dot product of two complex vectors + !! CDOTU = X^T * Y ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -242,11 +242,11 @@ module stdlib_linalg_blas_c pure subroutine stdlib_cgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) - !> CGBMV performs one of the matrix-vector operations - !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or - !> y := alpha*A**H*x + beta*y, - !> where alpha and beta are scalars, x and y are vectors and A is an - !> m by n band matrix, with kl sub-diagonals and ku super-diagonals. + !! CGBMV performs one of the matrix-vector operations + !! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or + !! y := alpha*A**H*x + beta*y, + !! where alpha and beta are scalars, x and y are vectors and A is an + !! m by n band matrix, with kl sub-diagonals and ku super-diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -414,12 +414,12 @@ module stdlib_linalg_blas_c pure subroutine stdlib_cgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) - !> CGEMM performs one of the matrix-matrix operations - !> C := alpha*op( A )*op( B ) + beta*C, - !> where op( X ) is one of - !> op( X ) = X or op( X ) = X**T or op( X ) = X**H, - !> alpha and beta are scalars, and A, B and C are matrices, with op( A ) - !> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. + !! CGEMM performs one of the matrix-matrix operations + !! C := alpha*op( A )*op( B ) + beta*C, + !! where op( X ) is one of + !! op( X ) = X or op( X ) = X**T or op( X ) = X**H, + !! alpha and beta are scalars, and A, B and C are matrices, with op( A ) + !! an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -663,11 +663,11 @@ module stdlib_linalg_blas_c pure subroutine stdlib_cgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) - !> CGEMV performs one of the matrix-vector operations - !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or - !> y := alpha*A**H*x + beta*y, - !> where alpha and beta are scalars, x and y are vectors and A is an - !> m by n matrix. + !! CGEMV performs one of the matrix-vector operations + !! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or + !! y := alpha*A**H*x + beta*y, + !! where alpha and beta are scalars, x and y are vectors and A is an + !! m by n matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -824,10 +824,10 @@ module stdlib_linalg_blas_c pure subroutine stdlib_cgerc(m,n,alpha,x,incx,y,incy,a,lda) - !> CGERC performs the rank 1 operation - !> A := alpha*x*y**H + A, - !> where alpha is a scalar, x is an m element vector, y is an n element - !> vector and A is an m by n matrix. + !! CGERC performs the rank 1 operation + !! A := alpha*x*y**H + A, + !! where alpha is a scalar, x is an m element vector, y is an n element + !! vector and A is an m by n matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -903,10 +903,10 @@ module stdlib_linalg_blas_c pure subroutine stdlib_cgeru(m,n,alpha,x,incx,y,incy,a,lda) - !> CGERU performs the rank 1 operation - !> A := alpha*x*y**T + A, - !> where alpha is a scalar, x is an m element vector, y is an n element - !> vector and A is an m by n matrix. + !! CGERU performs the rank 1 operation + !! A := alpha*x*y**T + A, + !! where alpha is a scalar, x is an m element vector, y is an n element + !! vector and A is an m by n matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -982,10 +982,10 @@ module stdlib_linalg_blas_c pure subroutine stdlib_chbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) - !> CHBMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n hermitian band matrix, with k super-diagonals. + !! CHBMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n hermitian band matrix, with k super-diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1145,12 +1145,12 @@ module stdlib_linalg_blas_c pure subroutine stdlib_chemm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) - !> CHEMM performs one of the matrix-matrix operations - !> C := alpha*A*B + beta*C, - !> or - !> C := alpha*B*A + beta*C, - !> where alpha and beta are scalars, A is an hermitian matrix and B and - !> C are m by n matrices. + !! CHEMM performs one of the matrix-matrix operations + !! C := alpha*A*B + beta*C, + !! or + !! C := alpha*B*A + beta*C, + !! where alpha and beta are scalars, A is an hermitian matrix and B and + !! C are m by n matrices. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1295,10 +1295,10 @@ module stdlib_linalg_blas_c pure subroutine stdlib_chemv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) - !> CHEMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n hermitian matrix. + !! CHEMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n hermitian matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1448,10 +1448,10 @@ module stdlib_linalg_blas_c pure subroutine stdlib_cher(uplo,n,alpha,x,incx,a,lda) - !> CHER performs the hermitian rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n hermitian matrix. + !! CHER performs the hermitian rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n hermitian matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1563,10 +1563,10 @@ module stdlib_linalg_blas_c pure subroutine stdlib_cher2(uplo,n,alpha,x,incx,y,incy,a,lda) - !> CHER2 performs the hermitian rank 2 operation - !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, - !> where alpha is a scalar, x and y are n element vectors and A is an n - !> by n hermitian matrix. + !! CHER2 performs the hermitian rank 2 operation + !! A := alpha*x*y**H + conjg( alpha )*y*x**H + A, + !! where alpha is a scalar, x and y are n element vectors and A is an n + !! by n hermitian matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1702,13 +1702,13 @@ module stdlib_linalg_blas_c pure subroutine stdlib_cher2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) - !> CHER2K performs one of the hermitian rank 2k operations - !> C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C, - !> or - !> C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C, - !> where alpha and beta are scalars with beta real, C is an n by n - !> hermitian matrix and A and B are n by k matrices in the first case - !> and k by n matrices in the second case. + !! CHER2K performs one of the hermitian rank 2k operations + !! C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C, + !! or + !! C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C, + !! where alpha and beta are scalars with beta real, C is an n by n + !! hermitian matrix and A and B are n by k matrices in the first case + !! and k by n matrices in the second case. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1911,13 +1911,13 @@ module stdlib_linalg_blas_c pure subroutine stdlib_cherk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) - !> CHERK 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. + !! CHERK 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. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2107,10 +2107,10 @@ module stdlib_linalg_blas_c pure subroutine stdlib_chpmv(uplo,n,alpha,ap,x,incx,beta,y,incy) - !> CHPMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n hermitian matrix, supplied in packed form. + !! CHPMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n hermitian matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2266,10 +2266,10 @@ module stdlib_linalg_blas_c pure subroutine stdlib_chpr(uplo,n,alpha,x,incx,ap) - !> CHPR performs the hermitian rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n hermitian matrix, supplied in packed form. + !! CHPR performs the hermitian rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n hermitian matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2388,10 +2388,10 @@ module stdlib_linalg_blas_c pure subroutine stdlib_chpr2(uplo,n,alpha,x,incx,y,incy,ap) - !> CHPR2 performs the hermitian rank 2 operation - !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, - !> where alpha is a scalar, x and y are n element vectors and A is an - !> n by n hermitian matrix, supplied in packed form. + !! CHPR2 performs the hermitian rank 2 operation + !! A := alpha*x*y**H + conjg( alpha )*y*x**H + A, + !! where alpha is a scalar, x and y are n element vectors and A is an + !! n by n hermitian matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2533,21 +2533,19 @@ module stdlib_linalg_blas_c pure subroutine stdlib_crotg( a, b, c, s ) - !> ! - !> - !> The computation uses the formulas - !> |x| = sqrt( Re(x)**2 + Im(x)**2 ) - !> sgn(x) = x / |x| if x /= 0 - !> = 1 if x = 0 - !> c = |a| / sqrt(|a|**2 + |b|**2) - !> s = sgn(a) * conjg(b) / sqrt(|a|**2 + |b|**2) - !> When a and b are real and r /= 0, the formulas simplify to - !> r = sgn(a)*sqrt(|a|**2 + |b|**2) - !> c = a / r - !> s = b / r - !> the same as in SROTG when |a| > |b|. When |b| >= |a|, the - !> sign of c and s will be different from those computed by SROTG - !> if the signs of a and b are not the same. + !! The computation uses the formulas + !! |x| = sqrt( Re(x)**2 + Im(x)**2 ) + !! sgn(x) = x / |x| if x /= 0 + !! = 1 if x = 0 + !! c = |a| / sqrt(|a|**2 + |b|**2) + !! s = sgn(a) * conjg(b) / sqrt(|a|**2 + |b|**2) + !! When a and b are real and r /= 0, the formulas simplify to + !! r = sgn(a)*sqrt(|a|**2 + |b|**2) + !! c = a / r + !! s = b / r + !! the same as in SROTG when |a| > |b|. When |b| >= |a|, the + !! sign of c and s will be different from those computed by SROTG + !! if the signs of a and b are not the same. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2650,7 +2648,7 @@ module stdlib_linalg_blas_c pure subroutine stdlib_cscal(n,ca,cx,incx) - !> CSCAL scales a vector by a constant. + !! CSCAL scales a vector by a constant. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2680,9 +2678,9 @@ module stdlib_linalg_blas_c pure subroutine stdlib_csrot( n, cx, incx, cy, incy, c, s ) - !> CSROT applies a plane rotation, where the cos and sin (c and s) are real - !> and the vectors cx and cy are complex. - !> jack dongarra, linpack, 3/11/78. + !! CSROT applies a plane rotation, where the cos and sin (c and s) are real + !! and the vectors cx and cy are complex. + !! jack dongarra, linpack, 3/11/78. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2724,7 +2722,7 @@ module stdlib_linalg_blas_c pure subroutine stdlib_csscal(n,sa,cx,incx) - !> CSSCAL scales a complex vector by a real constant. + !! CSSCAL scales a complex vector by a real constant. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2756,7 +2754,7 @@ module stdlib_linalg_blas_c pure subroutine stdlib_cswap(n,cx,incx,cy,incy) - !> CSWAP interchanges two vectors. + !! CSWAP interchanges two vectors. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2796,12 +2794,12 @@ module stdlib_linalg_blas_c pure subroutine stdlib_csymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) - !> CSYMM performs one of the matrix-matrix operations - !> C := alpha*A*B + beta*C, - !> or - !> C := alpha*B*A + beta*C, - !> where alpha and beta are scalars, A is a symmetric matrix and B and - !> C are m by n matrices. + !! CSYMM performs one of the matrix-matrix operations + !! C := alpha*A*B + beta*C, + !! or + !! C := alpha*B*A + beta*C, + !! where alpha and beta are scalars, A is a symmetric matrix and B and + !! C are m by n matrices. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2944,13 +2942,13 @@ module stdlib_linalg_blas_c pure subroutine stdlib_csyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) - !> CSYR2K performs one of the symmetric rank 2k operations - !> C := alpha*A*B**T + alpha*B*A**T + beta*C, - !> or - !> C := alpha*A**T*B + alpha*B**T*A + beta*C, - !> where alpha and beta are scalars, C is an n by n symmetric matrix - !> and A and B are n by k matrices in the first case and k by n - !> matrices in the second case. + !! CSYR2K performs one of the symmetric rank 2k operations + !! C := alpha*A*B**T + alpha*B*A**T + beta*C, + !! or + !! C := alpha*A**T*B + alpha*B**T*A + beta*C, + !! where alpha and beta are scalars, C is an n by n symmetric matrix + !! and A and B are n by k matrices in the first case and k by n + !! matrices in the second case. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3120,13 +3118,13 @@ module stdlib_linalg_blas_c pure subroutine stdlib_csyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) - !> CSYRK performs one of the symmetric rank k operations - !> C := alpha*A*A**T + beta*C, - !> or - !> C := alpha*A**T*A + beta*C, - !> where alpha and beta are scalars, C is an n by n symmetric matrix - !> and A is an n by k matrix in the first case and a k by n matrix - !> in the second case. + !! CSYRK performs one of the symmetric rank k operations + !! C := alpha*A*A**T + beta*C, + !! or + !! C := alpha*A**T*A + beta*C, + !! where alpha and beta are scalars, C is an n by n symmetric matrix + !! and A is an n by k matrix in the first case and a k by n matrix + !! in the second case. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3288,10 +3286,10 @@ module stdlib_linalg_blas_c pure subroutine stdlib_ctbmv(uplo,trans,diag,n,k,a,lda,x,incx) - !> CTBMV performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, or x := A**H*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular band matrix, with ( k + 1 ) diagonals. + !! CTBMV performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, or x := A**H*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular band matrix, with ( k + 1 ) diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3502,13 +3500,13 @@ module stdlib_linalg_blas_c pure subroutine stdlib_ctbsv(uplo,trans,diag,n,k,a,lda,x,incx) - !> CTBSV solves one of the systems of equations - !> A*x = b, or A**T*x = b, or A**H*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular band matrix, with ( k + 1 ) - !> diagonals. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! CTBSV solves one of the systems of equations + !! A*x = b, or A**T*x = b, or A**H*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular band matrix, with ( k + 1 ) + !! diagonals. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3719,10 +3717,10 @@ module stdlib_linalg_blas_c pure subroutine stdlib_ctpmv(uplo,trans,diag,n,ap,x,incx) - !> CTPMV performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, or x := A**H*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular matrix, supplied in packed form. + !! CTPMV performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, or x := A**H*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3936,12 +3934,12 @@ module stdlib_linalg_blas_c pure subroutine stdlib_ctpsv(uplo,trans,diag,n,ap,x,incx) - !> CTPSV solves one of the systems of equations - !> A*x = b, or A**T*x = b, or A**H*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular matrix, supplied in packed form. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! CTPSV solves one of the systems of equations + !! A*x = b, or A**T*x = b, or A**H*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular matrix, supplied in packed form. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4155,11 +4153,11 @@ module stdlib_linalg_blas_c pure subroutine stdlib_ctrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) - !> CTRMM performs one of the matrix-matrix operations - !> B := alpha*op( A )*B, or B := alpha*B*op( A ) - !> where alpha is a scalar, B is an m by n matrix, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. + !! CTRMM performs one of the matrix-matrix operations + !! B := alpha*op( A )*B, or B := alpha*B*op( A ) + !! where alpha is a scalar, B is an m by n matrix, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T or op( A ) = A**H. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4397,10 +4395,10 @@ module stdlib_linalg_blas_c pure subroutine stdlib_ctrmv(uplo,trans,diag,n,a,lda,x,incx) - !> CTRMV performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, or x := A**H*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular matrix. + !! CTRMV performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, or x := A**H*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4594,12 +4592,12 @@ module stdlib_linalg_blas_c pure subroutine stdlib_ctrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) - !> CTRSM solves one of the matrix equations - !> op( A )*X = alpha*B, or X*op( A ) = alpha*B, - !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. - !> The matrix X is overwritten on B. + !! CTRSM solves one of the matrix equations + !! op( A )*X = alpha*B, or X*op( A ) = alpha*B, + !! where alpha is a scalar, X and B are m by n matrices, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T or op( A ) = A**H. + !! The matrix X is overwritten on B. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4859,12 +4857,12 @@ module stdlib_linalg_blas_c pure subroutine stdlib_ctrsv(uplo,trans,diag,n,a,lda,x,incx) - !> CTRSV solves one of the systems of equations - !> A*x = b, or A**T*x = b, or A**H*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular matrix. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! CTRSV solves one of the systems of equations + !! A*x = b, or A**T*x = b, or A**H*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular matrix. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_blas_d.fypp b/src/stdlib_linalg_blas_d.fypp index 7812c89af..13942ba09 100644 --- a/src/stdlib_linalg_blas_d.fypp +++ b/src/stdlib_linalg_blas_d.fypp @@ -88,7 +88,7 @@ module stdlib_linalg_blas_d pure real(dp) function stdlib_dasum(n,dx,incx) - !> DASUM takes the sum of the absolute values. + !! DASUM takes the sum of the absolute values. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -136,8 +136,8 @@ module stdlib_linalg_blas_d pure subroutine stdlib_daxpy(n,da,dx,incx,dy,incy) - !> DAXPY constant times a vector plus a vector. - !> uses unrolled loops for increments equal to one. + !! DAXPY constant times a vector plus a vector. + !! uses unrolled loops for increments equal to one. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -189,8 +189,8 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dcopy(n,dx,incx,dy,incy) - !> DCOPY copies a vector, x, to a vector, y. - !> uses unrolled loops for increments equal to 1. + !! DCOPY copies a vector, x, to a vector, y. + !! uses unrolled loops for increments equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -243,8 +243,8 @@ module stdlib_linalg_blas_d pure real(dp) function stdlib_ddot(n,dx,incx,dy,incy) - !> DDOT forms the dot product of two vectors. - !> uses unrolled loops for increments equal to one. + !! DDOT forms the dot product of two vectors. + !! uses unrolled loops for increments equal to one. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -298,10 +298,10 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) - !> DGBMV performs one of the matrix-vector operations - !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, - !> where alpha and beta are scalars, x and y are vectors and A is an - !> m by n band matrix, with kl sub-diagonals and ku super-diagonals. + !! DGBMV performs one of the matrix-vector operations + !! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, + !! where alpha and beta are scalars, x and y are vectors and A is an + !! m by n band matrix, with kl sub-diagonals and ku super-diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -453,12 +453,12 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) - !> DGEMM performs one of the matrix-matrix operations - !> C := alpha*op( A )*op( B ) + beta*C, - !> where op( X ) is one of - !> op( X ) = X or op( X ) = X**T, - !> alpha and beta are scalars, and A, B and C are matrices, with op( A ) - !> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. + !! DGEMM performs one of the matrix-matrix operations + !! C := alpha*op( A )*op( B ) + beta*C, + !! where op( X ) is one of + !! op( X ) = X or op( X ) = X**T, + !! alpha and beta are scalars, and A, B and C are matrices, with op( A ) + !! an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -616,10 +616,10 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) - !> DGEMV performs one of the matrix-vector operations - !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, - !> where alpha and beta are scalars, x and y are vectors and A is an - !> m by n matrix. + !! DGEMV performs one of the matrix-vector operations + !! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, + !! where alpha and beta are scalars, x and y are vectors and A is an + !! m by n matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -760,10 +760,10 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dger(m,n,alpha,x,incx,y,incy,a,lda) - !> DGER performs the rank 1 operation - !> A := alpha*x*y**T + A, - !> where alpha is a scalar, x is an m element vector, y is an n element - !> vector and A is an m by n matrix. + !! DGER performs the rank 1 operation + !! A := alpha*x*y**T + A, + !! where alpha is a scalar, x is an m element vector, y is an n element + !! vector and A is an m by n matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -839,11 +839,9 @@ module stdlib_linalg_blas_d pure function stdlib_dnrm2( n, x, incx ) - !> ! - !> - !> DNRM2 returns the euclidean norm of a vector via the function - !> name, so that - !> DNRM2 := sqrt( x'*x ) + !! DNRM2 returns the euclidean norm of a vector via the function + !! name, so that + !! DNRM2 := sqrt( x'*x ) real(dp) :: stdlib_dnrm2 ! -- reference blas level1 routine (version 3.9.1_dp) -- ! -- reference blas is a software package provided by univ. of tennessee, -- @@ -929,7 +927,7 @@ module stdlib_linalg_blas_d pure subroutine stdlib_drot(n,dx,incx,dy,incy,c,s) - !> DROT applies a plane rotation. + !! DROT applies a plane rotation. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -970,22 +968,20 @@ module stdlib_linalg_blas_d pure subroutine stdlib_drotg( a, b, c, s ) - !> ! - !> - !> The computation uses the formulas - !> sigma = sgn(a) if |a| > |b| - !> = sgn(b) if |b| >= |a| - !> r = sigma*sqrt( a**2 + b**2 ) - !> c = 1; s = 0 if r = 0 - !> c = a/r; s = b/r if r != 0 - !> The subroutine also computes - !> z = s if |a| > |b|, - !> = 1/c if |b| >= |a| and c != 0 - !> = 1 if c = 0 - !> This allows c and s to be reconstructed from z as follows: - !> If z = 1, set c = 0, s = 1. - !> If |z| < 1, set c = sqrt(1 - z**2) and s = z. - !> If |z| > 1, set c = 1/z and s = sqrt( 1 - c**2). + !! The computation uses the formulas + !! sigma = sgn(a) if |a| > |b| + !! = sgn(b) if |b| >= |a| + !! r = sigma*sqrt( a**2 + b**2 ) + !! c = 1; s = 0 if r = 0 + !! c = a/r; s = b/r if r != 0 + !! The subroutine also computes + !! z = s if |a| > |b|, + !! = 1/c if |b| >= |a| and c != 0 + !! = 1 if c = 0 + !! This allows c and s to be reconstructed from z as follows: + !! If z = 1, set c = 0, s = 1. + !! If |z| < 1, set c = sqrt(1 - z**2) and s = z. + !! If |z| > 1, set c = 1/z and s = sqrt( 1 - c**2). ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1033,17 +1029,17 @@ module stdlib_linalg_blas_d pure subroutine stdlib_drotm(n,dx,incx,dy,incy,dparam) - !> APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX - !> (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN - !> (DY**T) - !> DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX >= 0, ELSE - !> LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. - !> WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. - !> DFLAG=-1._dp DFLAG=0._dp DFLAG=1._dp DFLAG=-2.D0 - !> (DH11 DH12) (1._dp DH12) (DH11 1._dp) (1._dp 0._dp) - !> H=( ) ( ) ( ) ( ) - !> (DH21 DH22), (DH21 1._dp), (-1._dp DH22), (0._dp 1._dp). - !> SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. + !! APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX + !! (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN + !! (DY**T) + !! DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX >= 0, ELSE + !! LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. + !! WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. + !! DFLAG=-1._dp DFLAG=0._dp DFLAG=1._dp DFLAG=-2.D0 + !! (DH11 DH12) (1._dp DH12) (DH11 1._dp) (1._dp 0._dp) + !! H=( ) ( ) ( ) ( ) + !! (DH21 DH22), (DH21 1._dp), (-1._dp DH22), (0._dp 1._dp). + !! SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1140,19 +1136,19 @@ module stdlib_linalg_blas_d pure subroutine stdlib_drotmg(dd1,dd2,dx1,dy1,dparam) - !> CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS - !> THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(DD1)*DX1,SQRT(DD2) DY2)**T. - !> WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. - !> DFLAG=-1._dp DFLAG=0._dp DFLAG=1._dp DFLAG=-2.D0 - !> (DH11 DH12) (1._dp DH12) (DH11 1._dp) (1._dp 0._dp) - !> H=( ) ( ) ( ) ( ) - !> (DH21 DH22), (DH21 1._dp), (-1._dp DH22), (0._dp 1._dp). - !> LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22 - !> RESPECTIVELY. (VALUES OF 1._dp, -1._dp, OR 0._dp IMPLIED BY THE - !> VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.) - !> THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE - !> INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE - !> OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. + !! CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS + !! THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(DD1)*DX1,SQRT(DD2) DY2)**T. + !! WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. + !! DFLAG=-1._dp DFLAG=0._dp DFLAG=1._dp DFLAG=-2.D0 + !! (DH11 DH12) (1._dp DH12) (DH11 1._dp) (1._dp 0._dp) + !! H=( ) ( ) ( ) ( ) + !! (DH21 DH22), (DH21 1._dp), (-1._dp DH22), (0._dp 1._dp). + !! LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22 + !! RESPECTIVELY. (VALUES OF 1._dp, -1._dp, OR 0._dp IMPLIED BY THE + !! VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.) + !! THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE + !! INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE + !! OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1306,10 +1302,10 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dsbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) - !> DSBMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric band matrix, with k super-diagonals. + !! DSBMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric band matrix, with k super-diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1468,8 +1464,8 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dscal(n,da,dx,incx) - !> DSCAL scales a vector by a constant. - !> uses unrolled loops for increment equal to 1. + !! DSCAL scales a vector by a constant. + !! uses unrolled loops for increment equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1514,12 +1510,12 @@ module stdlib_linalg_blas_d pure real(dp) function stdlib_dsdot(n,sx,incx,sy,incy) - !> Compute the inner product of two vectors with extended - !> precision accumulation and result. - !> Returns D.P. dot product accumulated in D.P., for S.P. SX and SY - !> DSDOT = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY), - !> where LX = 1 if INCX >= 0, else LX = 1+(1-N)*INCX, and LY is - !> defined in a similar way using INCY. + !! Compute the inner product of two vectors with extended + !! precision accumulation and result. + !! Returns D.P. dot product accumulated in D.P., for S.P. SX and SY + !! DSDOT = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY), + !! where LX = 1 if INCX >= 0, else LX = 1+(1-N)*INCX, and LY is + !! defined in a similar way using INCY. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1561,10 +1557,10 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dspmv(uplo,n,alpha,ap,x,incx,beta,y,incy) - !> DSPMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix, supplied in packed form. + !! DSPMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1717,10 +1713,10 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dspr(uplo,n,alpha,x,incx,ap) - !> DSPR performs the symmetric rank 1 operation - !> A := alpha*x*x**T + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n symmetric matrix, supplied in packed form. + !! DSPR performs the symmetric rank 1 operation + !! A := alpha*x*x**T + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n symmetric matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1824,10 +1820,10 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dspr2(uplo,n,alpha,x,incx,y,incy,ap) - !> DSPR2 performs the symmetric rank 2 operation - !> A := alpha*x*y**T + alpha*y*x**T + A, - !> where alpha is a scalar, x and y are n element vectors and A is an - !> n by n symmetric matrix, supplied in packed form. + !! DSPR2 performs the symmetric rank 2 operation + !! A := alpha*x*y**T + alpha*y*x**T + A, + !! where alpha is a scalar, x and y are n element vectors and A is an + !! n by n symmetric matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1951,8 +1947,8 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dswap(n,dx,incx,dy,incy) - !> DSWAP interchanges two vectors. - !> uses unrolled loops for increments equal to 1. + !! DSWAP interchanges two vectors. + !! uses unrolled loops for increments equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2011,12 +2007,12 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dsymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) - !> DSYMM performs one of the matrix-matrix operations - !> C := alpha*A*B + beta*C, - !> or - !> C := alpha*B*A + beta*C, - !> where alpha and beta are scalars, A is a symmetric matrix and B and - !> C are m by n matrices. + !! DSYMM performs one of the matrix-matrix operations + !! C := alpha*A*B + beta*C, + !! or + !! C := alpha*B*A + beta*C, + !! where alpha and beta are scalars, A is a symmetric matrix and B and + !! C are m by n matrices. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2158,10 +2154,10 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dsymv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) - !> DSYMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix. + !! DSYMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2310,10 +2306,10 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dsyr(uplo,n,alpha,x,incx,a,lda) - !> DSYR performs the symmetric rank 1 operation - !> A := alpha*x*x**T + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n symmetric matrix. + !! DSYR performs the symmetric rank 1 operation + !! A := alpha*x*x**T + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n symmetric matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2413,10 +2409,10 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dsyr2(uplo,n,alpha,x,incx,y,incy,a,lda) - !> DSYR2 performs the symmetric rank 2 operation - !> A := alpha*x*y**T + alpha*y*x**T + A, - !> where alpha is a scalar, x and y are n element vectors and A is an n - !> by n symmetric matrix. + !! DSYR2 performs the symmetric rank 2 operation + !! A := alpha*x*y**T + alpha*y*x**T + A, + !! where alpha is a scalar, x and y are n element vectors and A is an n + !! by n symmetric matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2536,13 +2532,13 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dsyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) - !> DSYR2K performs one of the symmetric rank 2k operations - !> C := alpha*A*B**T + alpha*B*A**T + beta*C, - !> or - !> C := alpha*A**T*B + alpha*B**T*A + beta*C, - !> where alpha and beta are scalars, C is an n by n symmetric matrix - !> and A and B are n by k matrices in the first case and k by n - !> matrices in the second case. + !! DSYR2K performs one of the symmetric rank 2k operations + !! C := alpha*A*B**T + alpha*B*A**T + beta*C, + !! or + !! C := alpha*A**T*B + alpha*B**T*A + beta*C, + !! where alpha and beta are scalars, C is an n by n symmetric matrix + !! and A and B are n by k matrices in the first case and k by n + !! matrices in the second case. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2711,13 +2707,13 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dsyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) - !> DSYRK performs one of the symmetric rank k operations - !> C := alpha*A*A**T + beta*C, - !> or - !> C := alpha*A**T*A + beta*C, - !> where alpha and beta are scalars, C is an n by n symmetric matrix - !> and A is an n by k matrix in the first case and a k by n matrix - !> in the second case. + !! DSYRK performs one of the symmetric rank k operations + !! C := alpha*A*A**T + beta*C, + !! or + !! C := alpha*A**T*A + beta*C, + !! where alpha and beta are scalars, C is an n by n symmetric matrix + !! and A is an n by k matrix in the first case and a k by n matrix + !! in the second case. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2878,10 +2874,10 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dtbmv(uplo,trans,diag,n,k,a,lda,x,incx) - !> DTBMV performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular band matrix, with ( k + 1 ) diagonals. + !! DTBMV performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular band matrix, with ( k + 1 ) diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3061,13 +3057,13 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dtbsv(uplo,trans,diag,n,k,a,lda,x,incx) - !> DTBSV solves one of the systems of equations - !> A*x = b, or A**T*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular band matrix, with ( k + 1 ) - !> diagonals. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! DTBSV solves one of the systems of equations + !! A*x = b, or A**T*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular band matrix, with ( k + 1 ) + !! diagonals. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3247,10 +3243,10 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dtpmv(uplo,trans,diag,n,ap,x,incx) - !> DTPMV performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular matrix, supplied in packed form. + !! DTPMV performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3429,12 +3425,12 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dtpsv(uplo,trans,diag,n,ap,x,incx) - !> DTPSV solves one of the systems of equations - !> A*x = b, or A**T*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular matrix, supplied in packed form. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! DTPSV solves one of the systems of equations + !! A*x = b, or A**T*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular matrix, supplied in packed form. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3613,11 +3609,11 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dtrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) - !> DTRMM performs one of the matrix-matrix operations - !> B := alpha*op( A )*B, or B := alpha*B*op( A ), - !> where alpha is a scalar, B is an m by n matrix, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T. + !! DTRMM performs one of the matrix-matrix operations + !! B := alpha*op( A )*B, or B := alpha*B*op( A ), + !! where alpha is a scalar, B is an m by n matrix, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3819,10 +3815,10 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dtrmv(uplo,trans,diag,n,a,lda,x,incx) - !> DTRMV performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular matrix. + !! DTRMV performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3985,12 +3981,12 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dtrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) - !> DTRSM solves one of the matrix equations - !> op( A )*X = alpha*B, or X*op( A ) = alpha*B, - !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T. - !> The matrix X is overwritten on B. + !! DTRSM solves one of the matrix equations + !! op( A )*X = alpha*B, or X*op( A ) = alpha*B, + !! where alpha is a scalar, X and B are m by n matrices, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T. + !! The matrix X is overwritten on B. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4216,12 +4212,12 @@ module stdlib_linalg_blas_d pure subroutine stdlib_dtrsv(uplo,trans,diag,n,a,lda,x,incx) - !> DTRSV solves one of the systems of equations - !> A*x = b, or A**T*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular matrix. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! DTRSV solves one of the systems of equations + !! A*x = b, or A**T*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular matrix. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4384,8 +4380,8 @@ module stdlib_linalg_blas_d pure real(dp) function stdlib_dzasum(n,zx,incx) - !> DZASUM takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and - !> returns a double precision result. + !! DZASUM takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and + !! returns a double precision result. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4418,11 +4414,9 @@ module stdlib_linalg_blas_d pure function stdlib_dznrm2( n, x, incx ) - !> ! - !> - !> DZNRM2 returns the euclidean norm of a vector via the function - !> name, so that - !> DZNRM2 := sqrt( x**H*x ) + !! DZNRM2 returns the euclidean norm of a vector via the function + !! name, so that + !! DZNRM2 := sqrt( x**H*x ) real(dp) :: stdlib_dznrm2 ! -- reference blas level1 routine (version 3.9.1_dp) -- ! -- reference blas is a software package provided by univ. of tennessee, -- diff --git a/src/stdlib_linalg_blas_q.fypp b/src/stdlib_linalg_blas_q.fypp index 94b0b6750..647636ef0 100644 --- a/src/stdlib_linalg_blas_q.fypp +++ b/src/stdlib_linalg_blas_q.fypp @@ -91,7 +91,7 @@ module stdlib_linalg_blas_q pure real(qp) function stdlib_qasum(n,dx,incx) - !> DASUM: takes the sum of the absolute values. + !! DASUM: takes the sum of the absolute values. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -139,8 +139,8 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qaxpy(n,da,dx,incx,dy,incy) - !> DAXPY: constant times a vector plus a vector. - !> uses unrolled loops for increments equal to one. + !! DAXPY: constant times a vector plus a vector. + !! uses unrolled loops for increments equal to one. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -192,8 +192,8 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qcopy(n,dx,incx,dy,incy) - !> DCOPY: copies a vector, x, to a vector, y. - !> uses unrolled loops for increments equal to 1. + !! DCOPY: copies a vector, x, to a vector, y. + !! uses unrolled loops for increments equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -246,8 +246,8 @@ module stdlib_linalg_blas_q pure real(qp) function stdlib_qdot(n,dx,incx,dy,incy) - !> DDOT: forms the dot product of two vectors. - !> uses unrolled loops for increments equal to one. + !! DDOT: forms the dot product of two vectors. + !! uses unrolled loops for increments equal to one. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -301,10 +301,10 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) - !> DGBMV: performs one of the matrix-vector operations - !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, - !> where alpha and beta are scalars, x and y are vectors and A is an - !> m by n band matrix, with kl sub-diagonals and ku super-diagonals. + !! DGBMV: performs one of the matrix-vector operations + !! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, + !! where alpha and beta are scalars, x and y are vectors and A is an + !! m by n band matrix, with kl sub-diagonals and ku super-diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -456,12 +456,12 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) - !> DGEMM: performs one of the matrix-matrix operations - !> C := alpha*op( A )*op( B ) + beta*C, - !> where op( X ) is one of - !> op( X ) = X or op( X ) = X**T, - !> alpha and beta are scalars, and A, B and C are matrices, with op( A ) - !> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. + !! DGEMM: performs one of the matrix-matrix operations + !! C := alpha*op( A )*op( B ) + beta*C, + !! where op( X ) is one of + !! op( X ) = X or op( X ) = X**T, + !! alpha and beta are scalars, and A, B and C are matrices, with op( A ) + !! an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -619,10 +619,10 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) - !> DGEMV: performs one of the matrix-vector operations - !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, - !> where alpha and beta are scalars, x and y are vectors and A is an - !> m by n matrix. + !! DGEMV: performs one of the matrix-vector operations + !! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, + !! where alpha and beta are scalars, x and y are vectors and A is an + !! m by n matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -763,10 +763,10 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qger(m,n,alpha,x,incx,y,incy,a,lda) - !> DGER: performs the rank 1 operation - !> A := alpha*x*y**T + A, - !> where alpha is a scalar, x is an m element vector, y is an n element - !> vector and A is an m by n matrix. + !! DGER: performs the rank 1 operation + !! A := alpha*x*y**T + A, + !! where alpha is a scalar, x is an m element vector, y is an n element + !! vector and A is an m by n matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -842,11 +842,9 @@ module stdlib_linalg_blas_q pure function stdlib_qnrm2( n, x, incx ) - !> ! - !> - !> DNRM2: returns the euclidean norm of a vector via the function - !> name, so that - !> DNRM2 := sqrt( x'*x ) + !! DNRM2: returns the euclidean norm of a vector via the function + !! name, so that + !! DNRM2 := sqrt( x'*x ) real(qp) :: stdlib_qnrm2 ! -- reference blas level1 routine (version 3.9.1_qp) -- ! -- reference blas is a software package provided by univ. of tennessee, -- @@ -932,7 +930,7 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qrot(n,dx,incx,dy,incy,c,s) - !> DROT: applies a plane rotation. + !! DROT: applies a plane rotation. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -973,22 +971,20 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qrotg( a, b, c, s ) - !> ! - !> - !> The computation uses the formulas - !> sigma = sgn(a) if |a| > |b| - !> = sgn(b) if |b| >= |a| - !> r = sigma*sqrt( a**2 + b**2 ) - !> c = 1; s = 0 if r = 0 - !> c = a/r; s = b/r if r != 0 - !> The subroutine also computes - !> z = s if |a| > |b|, - !> = 1/c if |b| >= |a| and c != 0 - !> = 1 if c = 0 - !> This allows c and s to be reconstructed from z as follows: - !> If z = 1, set c = 0, s = 1. - !> If |z| < 1, set c = sqrt(1 - z**2) and s = z. - !> If |z| > 1, set c = 1/z and s = sqrt( 1 - c**2). + !! The computation uses the formulas + !! sigma = sgn(a) if |a| > |b| + !! = sgn(b) if |b| >= |a| + !! r = sigma*sqrt( a**2 + b**2 ) + !! c = 1; s = 0 if r = 0 + !! c = a/r; s = b/r if r != 0 + !! The subroutine also computes + !! z = s if |a| > |b|, + !! = 1/c if |b| >= |a| and c != 0 + !! = 1 if c = 0 + !! This allows c and s to be reconstructed from z as follows: + !! If z = 1, set c = 0, s = 1. + !! If |z| < 1, set c = sqrt(1 - z**2) and s = z. + !! If |z| > 1, set c = 1/z and s = sqrt( 1 - c**2). ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1036,17 +1032,17 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qrotm(n,dx,incx,dy,incy,dparam) - !> APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX - !> (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN - !> (DY**T) - !> DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX >= 0, ELSE - !> LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. - !> WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. - !> DFLAG=-1._qp DFLAG=0._qp DFLAG=1._qp DFLAG=-2.D0 - !> (DH11 DH12) (1._qp DH12) (DH11 1._qp) (1._qp 0._qp) - !> H=( ) ( ) ( ) ( ) - !> (DH21 DH22), (DH21 1._qp), (-1._qp DH22), (0._qp 1._qp). - !> SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. + !! APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX + !! (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN + !! (DY**T) + !! DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX >= 0, ELSE + !! LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. + !! WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. + !! DFLAG=-1._qp DFLAG=0._qp DFLAG=1._qp DFLAG=-2.D0 + !! (DH11 DH12) (1._qp DH12) (DH11 1._qp) (1._qp 0._qp) + !! H=( ) ( ) ( ) ( ) + !! (DH21 DH22), (DH21 1._qp), (-1._qp DH22), (0._qp 1._qp). + !! SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1143,19 +1139,19 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qrotmg(dd1,dd2,dx1,dy1,dparam) - !> CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS - !> THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(DD1)*DX1,SQRT(DD2) DY2)**T. - !> WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. - !> DFLAG=-1._qp DFLAG=0._qp DFLAG=1._qp DFLAG=-2.D0 - !> (DH11 DH12) (1._qp DH12) (DH11 1._qp) (1._qp 0._qp) - !> H=( ) ( ) ( ) ( ) - !> (DH21 DH22), (DH21 1._qp), (-1._qp DH22), (0._qp 1._qp). - !> LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22 - !> RESPECTIVELY. (VALUES OF 1._qp, -1._qp, OR 0._qp IMPLIED BY THE - !> VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.) - !> THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE - !> INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE - !> OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. + !! CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS + !! THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(DD1)*DX1,SQRT(DD2) DY2)**T. + !! WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. + !! DFLAG=-1._qp DFLAG=0._qp DFLAG=1._qp DFLAG=-2.D0 + !! (DH11 DH12) (1._qp DH12) (DH11 1._qp) (1._qp 0._qp) + !! H=( ) ( ) ( ) ( ) + !! (DH21 DH22), (DH21 1._qp), (-1._qp DH22), (0._qp 1._qp). + !! LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22 + !! RESPECTIVELY. (VALUES OF 1._qp, -1._qp, OR 0._qp IMPLIED BY THE + !! VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.) + !! THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE + !! INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE + !! OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1309,10 +1305,10 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qsbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) - !> DSBMV: performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric band matrix, with k super-diagonals. + !! DSBMV: performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric band matrix, with k super-diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1471,8 +1467,8 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qscal(n,da,dx,incx) - !> DSCAL: scales a vector by a constant. - !> uses unrolled loops for increment equal to 1. + !! DSCAL: scales a vector by a constant. + !! uses unrolled loops for increment equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1517,12 +1513,12 @@ module stdlib_linalg_blas_q pure real(qp) function stdlib_qsdot(n,sx,incx,sy,incy) - !> Compute the inner product of two vectors with extended - !> precision accumulation and result. - !> Returns D.P. dot product accumulated in D.P., for S.P. SX and SY - !> DSDOT: = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY), - !> where LX = 1 if INCX >= 0, else LX = 1+(1-N)*INCX, and LY is - !> defined in a similar way using INCY. + !! Compute the inner product of two vectors with extended + !! precision accumulation and result. + !! Returns D.P. dot product accumulated in D.P., for S.P. SX and SY + !! DSDOT: = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY), + !! where LX = 1 if INCX >= 0, else LX = 1+(1-N)*INCX, and LY is + !! defined in a similar way using INCY. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1564,10 +1560,10 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qspmv(uplo,n,alpha,ap,x,incx,beta,y,incy) - !> DSPMV: performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix, supplied in packed form. + !! DSPMV: performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1720,10 +1716,10 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qspr(uplo,n,alpha,x,incx,ap) - !> DSPR: performs the symmetric rank 1 operation - !> A := alpha*x*x**T + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n symmetric matrix, supplied in packed form. + !! DSPR: performs the symmetric rank 1 operation + !! A := alpha*x*x**T + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n symmetric matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1827,10 +1823,10 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qspr2(uplo,n,alpha,x,incx,y,incy,ap) - !> DSPR2: performs the symmetric rank 2 operation - !> A := alpha*x*y**T + alpha*y*x**T + A, - !> where alpha is a scalar, x and y are n element vectors and A is an - !> n by n symmetric matrix, supplied in packed form. + !! DSPR2: performs the symmetric rank 2 operation + !! A := alpha*x*y**T + alpha*y*x**T + A, + !! where alpha is a scalar, x and y are n element vectors and A is an + !! n by n symmetric matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1954,8 +1950,8 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qswap(n,dx,incx,dy,incy) - !> DSWAP: interchanges two vectors. - !> uses unrolled loops for increments equal to 1. + !! DSWAP: interchanges two vectors. + !! uses unrolled loops for increments equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2014,12 +2010,12 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qsymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) - !> DSYMM: performs one of the matrix-matrix operations - !> C := alpha*A*B + beta*C, - !> or - !> C := alpha*B*A + beta*C, - !> where alpha and beta are scalars, A is a symmetric matrix and B and - !> C are m by n matrices. + !! DSYMM: performs one of the matrix-matrix operations + !! C := alpha*A*B + beta*C, + !! or + !! C := alpha*B*A + beta*C, + !! where alpha and beta are scalars, A is a symmetric matrix and B and + !! C are m by n matrices. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2161,10 +2157,10 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qsymv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) - !> DSYMV: performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix. + !! DSYMV: performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2313,10 +2309,10 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qsyr(uplo,n,alpha,x,incx,a,lda) - !> DSYR: performs the symmetric rank 1 operation - !> A := alpha*x*x**T + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n symmetric matrix. + !! DSYR: performs the symmetric rank 1 operation + !! A := alpha*x*x**T + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n symmetric matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2416,10 +2412,10 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qsyr2(uplo,n,alpha,x,incx,y,incy,a,lda) - !> DSYR2: performs the symmetric rank 2 operation - !> A := alpha*x*y**T + alpha*y*x**T + A, - !> where alpha is a scalar, x and y are n element vectors and A is an n - !> by n symmetric matrix. + !! DSYR2: performs the symmetric rank 2 operation + !! A := alpha*x*y**T + alpha*y*x**T + A, + !! where alpha is a scalar, x and y are n element vectors and A is an n + !! by n symmetric matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2539,13 +2535,13 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qsyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) - !> DSYR2K: performs one of the symmetric rank 2k operations - !> C := alpha*A*B**T + alpha*B*A**T + beta*C, - !> or - !> C := alpha*A**T*B + alpha*B**T*A + beta*C, - !> where alpha and beta are scalars, C is an n by n symmetric matrix - !> and A and B are n by k matrices in the first case and k by n - !> matrices in the second case. + !! DSYR2K: performs one of the symmetric rank 2k operations + !! C := alpha*A*B**T + alpha*B*A**T + beta*C, + !! or + !! C := alpha*A**T*B + alpha*B**T*A + beta*C, + !! where alpha and beta are scalars, C is an n by n symmetric matrix + !! and A and B are n by k matrices in the first case and k by n + !! matrices in the second case. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2714,13 +2710,13 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qsyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) - !> DSYRK: performs one of the symmetric rank k operations - !> C := alpha*A*A**T + beta*C, - !> or - !> C := alpha*A**T*A + beta*C, - !> where alpha and beta are scalars, C is an n by n symmetric matrix - !> and A is an n by k matrix in the first case and a k by n matrix - !> in the second case. + !! DSYRK: performs one of the symmetric rank k operations + !! C := alpha*A*A**T + beta*C, + !! or + !! C := alpha*A**T*A + beta*C, + !! where alpha and beta are scalars, C is an n by n symmetric matrix + !! and A is an n by k matrix in the first case and a k by n matrix + !! in the second case. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2881,10 +2877,10 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qtbmv(uplo,trans,diag,n,k,a,lda,x,incx) - !> DTBMV: performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular band matrix, with ( k + 1 ) diagonals. + !! DTBMV: performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular band matrix, with ( k + 1 ) diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3064,13 +3060,13 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qtbsv(uplo,trans,diag,n,k,a,lda,x,incx) - !> DTBSV: solves one of the systems of equations - !> A*x = b, or A**T*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular band matrix, with ( k + 1 ) - !> diagonals. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! DTBSV: solves one of the systems of equations + !! A*x = b, or A**T*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular band matrix, with ( k + 1 ) + !! diagonals. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3250,10 +3246,10 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qtpmv(uplo,trans,diag,n,ap,x,incx) - !> DTPMV: performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular matrix, supplied in packed form. + !! DTPMV: performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3432,12 +3428,12 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qtpsv(uplo,trans,diag,n,ap,x,incx) - !> DTPSV: solves one of the systems of equations - !> A*x = b, or A**T*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular matrix, supplied in packed form. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! DTPSV: solves one of the systems of equations + !! A*x = b, or A**T*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular matrix, supplied in packed form. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3616,11 +3612,11 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qtrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) - !> DTRMM: performs one of the matrix-matrix operations - !> B := alpha*op( A )*B, or B := alpha*B*op( A ), - !> where alpha is a scalar, B is an m by n matrix, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T. + !! DTRMM: performs one of the matrix-matrix operations + !! B := alpha*op( A )*B, or B := alpha*B*op( A ), + !! where alpha is a scalar, B is an m by n matrix, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3822,10 +3818,10 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qtrmv(uplo,trans,diag,n,a,lda,x,incx) - !> DTRMV: performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular matrix. + !! DTRMV: performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3988,12 +3984,12 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qtrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) - !> DTRSM: solves one of the matrix equations - !> op( A )*X = alpha*B, or X*op( A ) = alpha*B, - !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T. - !> The matrix X is overwritten on B. + !! DTRSM: solves one of the matrix equations + !! op( A )*X = alpha*B, or X*op( A ) = alpha*B, + !! where alpha is a scalar, X and B are m by n matrices, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T. + !! The matrix X is overwritten on B. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4219,12 +4215,12 @@ module stdlib_linalg_blas_q pure subroutine stdlib_qtrsv(uplo,trans,diag,n,a,lda,x,incx) - !> DTRSV: solves one of the systems of equations - !> A*x = b, or A**T*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular matrix. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! DTRSV: solves one of the systems of equations + !! A*x = b, or A**T*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular matrix. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4387,8 +4383,8 @@ module stdlib_linalg_blas_q pure real(qp) function stdlib_qzasum(n,zx,incx) - !> DZASUM: takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and - !> returns a quad precision result. + !! DZASUM: takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and + !! returns a quad precision result. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4421,11 +4417,9 @@ module stdlib_linalg_blas_q pure function stdlib_qznrm2( n, x, incx ) - !> ! - !> - !> DZNRM2: returns the euclidean norm of a vector via the function - !> name, so that - !> DZNRM2 := sqrt( x**H*x ) + !! DZNRM2: returns the euclidean norm of a vector via the function + !! name, so that + !! DZNRM2 := sqrt( x**H*x ) real(qp) :: stdlib_qznrm2 ! -- reference blas level1 routine (version 3.9.1_qp) -- ! -- reference blas is a software package provided by univ. of tennessee, -- diff --git a/src/stdlib_linalg_blas_s.fypp b/src/stdlib_linalg_blas_s.fypp index e94087a05..9270500b1 100644 --- a/src/stdlib_linalg_blas_s.fypp +++ b/src/stdlib_linalg_blas_s.fypp @@ -86,8 +86,8 @@ module stdlib_linalg_blas_s pure real(sp) function stdlib_sasum(n,sx,incx) - !> SASUM takes the sum of the absolute values. - !> uses unrolled loops for increment equal to one. + !! SASUM takes the sum of the absolute values. + !! uses unrolled loops for increment equal to one. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -135,8 +135,8 @@ module stdlib_linalg_blas_s pure subroutine stdlib_saxpy(n,sa,sx,incx,sy,incy) - !> SAXPY constant times a vector plus a vector. - !> uses unrolled loops for increments equal to one. + !! SAXPY constant times a vector plus a vector. + !! uses unrolled loops for increments equal to one. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -188,8 +188,8 @@ module stdlib_linalg_blas_s pure real(sp) function stdlib_scasum(n,cx,incx) - !> SCASUM takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and - !> returns a single precision result. + !! SCASUM takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and + !! returns a single precision result. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -224,11 +224,9 @@ module stdlib_linalg_blas_s pure function stdlib_scnrm2( n, x, incx ) - !> ! - !> - !> SCNRM2 returns the euclidean norm of a vector via the function - !> name, so that - !> SCNRM2 := sqrt( x**H*x ) + !! SCNRM2 returns the euclidean norm of a vector via the function + !! name, so that + !! SCNRM2 := sqrt( x**H*x ) real(sp) :: stdlib_scnrm2 ! -- reference blas level1 routine (version 3.9.1_sp) -- ! -- reference blas is a software package provided by univ. of tennessee, -- @@ -323,8 +321,8 @@ module stdlib_linalg_blas_s pure subroutine stdlib_scopy(n,sx,incx,sy,incy) - !> SCOPY copies a vector, x, to a vector, y. - !> uses unrolled loops for increments equal to 1. + !! SCOPY copies a vector, x, to a vector, y. + !! uses unrolled loops for increments equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -377,8 +375,8 @@ module stdlib_linalg_blas_s pure real(sp) function stdlib_sdot(n,sx,incx,sy,incy) - !> SDOT forms the dot product of two vectors. - !> uses unrolled loops for increments equal to one. + !! SDOT forms the dot product of two vectors. + !! uses unrolled loops for increments equal to one. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -432,12 +430,12 @@ module stdlib_linalg_blas_s pure real(sp) function stdlib_sdsdot(n,sb,sx,incx,sy,incy) - !> Compute the inner product of two vectors with extended - !> precision accumulation. - !> Returns S.P. result with dot product accumulated in D.P. - !> SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY), - !> where LX = 1 if INCX >= 0, else LX = 1+(1-N)*INCX, and LY is - !> defined in a similar way using INCY. + !! Compute the inner product of two vectors with extended + !! precision accumulation. + !! Returns S.P. result with dot product accumulated in D.P. + !! SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY), + !! where LX = 1 if INCX >= 0, else LX = 1+(1-N)*INCX, and LY is + !! defined in a similar way using INCY. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -480,10 +478,10 @@ module stdlib_linalg_blas_s pure subroutine stdlib_sgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) - !> SGBMV performs one of the matrix-vector operations - !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, - !> where alpha and beta are scalars, x and y are vectors and A is an - !> m by n band matrix, with kl sub-diagonals and ku super-diagonals. + !! SGBMV performs one of the matrix-vector operations + !! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, + !! where alpha and beta are scalars, x and y are vectors and A is an + !! m by n band matrix, with kl sub-diagonals and ku super-diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -635,12 +633,12 @@ module stdlib_linalg_blas_s pure subroutine stdlib_sgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) - !> SGEMM performs one of the matrix-matrix operations - !> C := alpha*op( A )*op( B ) + beta*C, - !> where op( X ) is one of - !> op( X ) = X or op( X ) = X**T, - !> alpha and beta are scalars, and A, B and C are matrices, with op( A ) - !> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. + !! SGEMM performs one of the matrix-matrix operations + !! C := alpha*op( A )*op( B ) + beta*C, + !! where op( X ) is one of + !! op( X ) = X or op( X ) = X**T, + !! alpha and beta are scalars, and A, B and C are matrices, with op( A ) + !! an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -798,10 +796,10 @@ module stdlib_linalg_blas_s pure subroutine stdlib_sgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) - !> SGEMV performs one of the matrix-vector operations - !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, - !> where alpha and beta are scalars, x and y are vectors and A is an - !> m by n matrix. + !! SGEMV performs one of the matrix-vector operations + !! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, + !! where alpha and beta are scalars, x and y are vectors and A is an + !! m by n matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -942,10 +940,10 @@ module stdlib_linalg_blas_s pure subroutine stdlib_sger(m,n,alpha,x,incx,y,incy,a,lda) - !> SGER performs the rank 1 operation - !> A := alpha*x*y**T + A, - !> where alpha is a scalar, x is an m element vector, y is an n element - !> vector and A is an m by n matrix. + !! SGER performs the rank 1 operation + !! A := alpha*x*y**T + A, + !! where alpha is a scalar, x is an m element vector, y is an n element + !! vector and A is an m by n matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1021,11 +1019,9 @@ module stdlib_linalg_blas_s pure function stdlib_snrm2( n, x, incx ) - !> ! - !> - !> SNRM2 returns the euclidean norm of a vector via the function - !> name, so that - !> SNRM2 := sqrt( x'*x ). + !! SNRM2 returns the euclidean norm of a vector via the function + !! name, so that + !! SNRM2 := sqrt( x'*x ). real(sp) :: stdlib_snrm2 ! -- reference blas level1 routine (version 3.9.1_sp) -- ! -- reference blas is a software package provided by univ. of tennessee, -- @@ -1111,7 +1107,7 @@ module stdlib_linalg_blas_s pure subroutine stdlib_srot(n,sx,incx,sy,incy,c,s) - !> applies a plane rotation. + !! applies a plane rotation. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1152,22 +1148,20 @@ module stdlib_linalg_blas_s pure subroutine stdlib_srotg( a, b, c, s ) - !> ! - !> - !> The computation uses the formulas - !> sigma = sgn(a) if |a| > |b| - !> = sgn(b) if |b| >= |a| - !> r = sigma*sqrt( a**2 + b**2 ) - !> c = 1; s = 0 if r = 0 - !> c = a/r; s = b/r if r != 0 - !> The subroutine also computes - !> z = s if |a| > |b|, - !> = 1/c if |b| >= |a| and c != 0 - !> = 1 if c = 0 - !> This allows c and s to be reconstructed from z as follows: - !> If z = 1, set c = 0, s = 1. - !> If |z| < 1, set c = sqrt(1 - z**2) and s = z. - !> If |z| > 1, set c = 1/z and s = sqrt( 1 - c**2). + !! The computation uses the formulas + !! sigma = sgn(a) if |a| > |b| + !! = sgn(b) if |b| >= |a| + !! r = sigma*sqrt( a**2 + b**2 ) + !! c = 1; s = 0 if r = 0 + !! c = a/r; s = b/r if r != 0 + !! The subroutine also computes + !! z = s if |a| > |b|, + !! = 1/c if |b| >= |a| and c != 0 + !! = 1 if c = 0 + !! This allows c and s to be reconstructed from z as follows: + !! If z = 1, set c = 0, s = 1. + !! If |z| < 1, set c = sqrt(1 - z**2) and s = z. + !! If |z| > 1, set c = 1/z and s = sqrt( 1 - c**2). ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1215,17 +1209,17 @@ module stdlib_linalg_blas_s pure subroutine stdlib_srotm(n,sx,incx,sy,incy,sparam) - !> APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX - !> (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN - !> (SX**T) - !> SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX >= 0, ELSE - !> LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY. - !> WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. - !> SFLAG=-1._sp SFLAG=0._sp SFLAG=1._sp SFLAG=-2.E0 - !> (SH11 SH12) (1._sp SH12) (SH11 1._sp) (1._sp 0._sp) - !> H=( ) ( ) ( ) ( ) - !> (SH21 SH22), (SH21 1._sp), (-1._sp SH22), (0._sp 1._sp). - !> SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM. + !! APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX + !! (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN + !! (SX**T) + !! SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX >= 0, ELSE + !! LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY. + !! WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. + !! SFLAG=-1._sp SFLAG=0._sp SFLAG=1._sp SFLAG=-2.E0 + !! (SH11 SH12) (1._sp SH12) (SH11 1._sp) (1._sp 0._sp) + !! H=( ) ( ) ( ) ( ) + !! (SH21 SH22), (SH21 1._sp), (-1._sp SH22), (0._sp 1._sp). + !! SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1322,19 +1316,19 @@ module stdlib_linalg_blas_s pure subroutine stdlib_srotmg(sd1,sd2,sx1,sy1,sparam) - !> CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS - !> THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(SD1)*SX1,SQRT(SD2) SY2)**T. - !> WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. - !> SFLAG=-1._sp SFLAG=0._sp SFLAG=1._sp SFLAG=-2.E0 - !> (SH11 SH12) (1._sp SH12) (SH11 1._sp) (1._sp 0._sp) - !> H=( ) ( ) ( ) ( ) - !> (SH21 SH22), (SH21 1._sp), (-1._sp SH22), (0._sp 1._sp). - !> LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22 - !> RESPECTIVELY. (VALUES OF 1._sp, -1._sp, OR 0._sp IMPLIED BY THE - !> VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.) - !> THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE - !> INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE - !> OF SD1 AND SD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. + !! CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS + !! THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(SD1)*SX1,SQRT(SD2) SY2)**T. + !! WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. + !! SFLAG=-1._sp SFLAG=0._sp SFLAG=1._sp SFLAG=-2.E0 + !! (SH11 SH12) (1._sp SH12) (SH11 1._sp) (1._sp 0._sp) + !! H=( ) ( ) ( ) ( ) + !! (SH21 SH22), (SH21 1._sp), (-1._sp SH22), (0._sp 1._sp). + !! LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22 + !! RESPECTIVELY. (VALUES OF 1._sp, -1._sp, OR 0._sp IMPLIED BY THE + !! VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.) + !! THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE + !! INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE + !! OF SD1 AND SD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1488,10 +1482,10 @@ module stdlib_linalg_blas_s pure subroutine stdlib_ssbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) - !> SSBMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric band matrix, with k super-diagonals. + !! SSBMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric band matrix, with k super-diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1650,8 +1644,8 @@ module stdlib_linalg_blas_s pure subroutine stdlib_sscal(n,sa,sx,incx) - !> SSCAL scales a vector by a constant. - !> uses unrolled loops for increment equal to 1. + !! SSCAL scales a vector by a constant. + !! uses unrolled loops for increment equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1696,10 +1690,10 @@ module stdlib_linalg_blas_s pure subroutine stdlib_sspmv(uplo,n,alpha,ap,x,incx,beta,y,incy) - !> SSPMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix, supplied in packed form. + !! SSPMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1852,10 +1846,10 @@ module stdlib_linalg_blas_s pure subroutine stdlib_sspr(uplo,n,alpha,x,incx,ap) - !> SSPR performs the symmetric rank 1 operation - !> A := alpha*x*x**T + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n symmetric matrix, supplied in packed form. + !! SSPR performs the symmetric rank 1 operation + !! A := alpha*x*x**T + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n symmetric matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1959,10 +1953,10 @@ module stdlib_linalg_blas_s pure subroutine stdlib_sspr2(uplo,n,alpha,x,incx,y,incy,ap) - !> SSPR2 performs the symmetric rank 2 operation - !> A := alpha*x*y**T + alpha*y*x**T + A, - !> where alpha is a scalar, x and y are n element vectors and A is an - !> n by n symmetric matrix, supplied in packed form. + !! SSPR2 performs the symmetric rank 2 operation + !! A := alpha*x*y**T + alpha*y*x**T + A, + !! where alpha is a scalar, x and y are n element vectors and A is an + !! n by n symmetric matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2086,8 +2080,8 @@ module stdlib_linalg_blas_s pure subroutine stdlib_sswap(n,sx,incx,sy,incy) - !> SSWAP interchanges two vectors. - !> uses unrolled loops for increments equal to 1. + !! SSWAP interchanges two vectors. + !! uses unrolled loops for increments equal to 1. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2146,12 +2140,12 @@ module stdlib_linalg_blas_s pure subroutine stdlib_ssymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) - !> SSYMM performs one of the matrix-matrix operations - !> C := alpha*A*B + beta*C, - !> or - !> C := alpha*B*A + beta*C, - !> where alpha and beta are scalars, A is a symmetric matrix and B and - !> C are m by n matrices. + !! SSYMM performs one of the matrix-matrix operations + !! C := alpha*A*B + beta*C, + !! or + !! C := alpha*B*A + beta*C, + !! where alpha and beta are scalars, A is a symmetric matrix and B and + !! C are m by n matrices. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2293,10 +2287,10 @@ module stdlib_linalg_blas_s pure subroutine stdlib_ssymv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) - !> SSYMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix. + !! SSYMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2445,10 +2439,10 @@ module stdlib_linalg_blas_s pure subroutine stdlib_ssyr(uplo,n,alpha,x,incx,a,lda) - !> SSYR performs the symmetric rank 1 operation - !> A := alpha*x*x**T + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n symmetric matrix. + !! SSYR performs the symmetric rank 1 operation + !! A := alpha*x*x**T + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n symmetric matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2548,10 +2542,10 @@ module stdlib_linalg_blas_s pure subroutine stdlib_ssyr2(uplo,n,alpha,x,incx,y,incy,a,lda) - !> SSYR2 performs the symmetric rank 2 operation - !> A := alpha*x*y**T + alpha*y*x**T + A, - !> where alpha is a scalar, x and y are n element vectors and A is an n - !> by n symmetric matrix. + !! SSYR2 performs the symmetric rank 2 operation + !! A := alpha*x*y**T + alpha*y*x**T + A, + !! where alpha is a scalar, x and y are n element vectors and A is an n + !! by n symmetric matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2671,13 +2665,13 @@ module stdlib_linalg_blas_s pure subroutine stdlib_ssyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) - !> SSYR2K performs one of the symmetric rank 2k operations - !> C := alpha*A*B**T + alpha*B*A**T + beta*C, - !> or - !> C := alpha*A**T*B + alpha*B**T*A + beta*C, - !> where alpha and beta are scalars, C is an n by n symmetric matrix - !> and A and B are n by k matrices in the first case and k by n - !> matrices in the second case. + !! SSYR2K performs one of the symmetric rank 2k operations + !! C := alpha*A*B**T + alpha*B*A**T + beta*C, + !! or + !! C := alpha*A**T*B + alpha*B**T*A + beta*C, + !! where alpha and beta are scalars, C is an n by n symmetric matrix + !! and A and B are n by k matrices in the first case and k by n + !! matrices in the second case. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2846,13 +2840,13 @@ module stdlib_linalg_blas_s pure subroutine stdlib_ssyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) - !> SSYRK performs one of the symmetric rank k operations - !> C := alpha*A*A**T + beta*C, - !> or - !> C := alpha*A**T*A + beta*C, - !> where alpha and beta are scalars, C is an n by n symmetric matrix - !> and A is an n by k matrix in the first case and a k by n matrix - !> in the second case. + !! SSYRK performs one of the symmetric rank k operations + !! C := alpha*A*A**T + beta*C, + !! or + !! C := alpha*A**T*A + beta*C, + !! where alpha and beta are scalars, C is an n by n symmetric matrix + !! and A is an n by k matrix in the first case and a k by n matrix + !! in the second case. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3013,10 +3007,10 @@ module stdlib_linalg_blas_s pure subroutine stdlib_stbmv(uplo,trans,diag,n,k,a,lda,x,incx) - !> STBMV performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular band matrix, with ( k + 1 ) diagonals. + !! STBMV performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular band matrix, with ( k + 1 ) diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3196,13 +3190,13 @@ module stdlib_linalg_blas_s pure subroutine stdlib_stbsv(uplo,trans,diag,n,k,a,lda,x,incx) - !> STBSV solves one of the systems of equations - !> A*x = b, or A**T*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular band matrix, with ( k + 1 ) - !> diagonals. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! STBSV solves one of the systems of equations + !! A*x = b, or A**T*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular band matrix, with ( k + 1 ) + !! diagonals. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3382,10 +3376,10 @@ module stdlib_linalg_blas_s pure subroutine stdlib_stpmv(uplo,trans,diag,n,ap,x,incx) - !> STPMV performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular matrix, supplied in packed form. + !! STPMV performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3564,12 +3558,12 @@ module stdlib_linalg_blas_s pure subroutine stdlib_stpsv(uplo,trans,diag,n,ap,x,incx) - !> STPSV solves one of the systems of equations - !> A*x = b, or A**T*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular matrix, supplied in packed form. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! STPSV solves one of the systems of equations + !! A*x = b, or A**T*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular matrix, supplied in packed form. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3748,11 +3742,11 @@ module stdlib_linalg_blas_s pure subroutine stdlib_strmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) - !> STRMM performs one of the matrix-matrix operations - !> B := alpha*op( A )*B, or B := alpha*B*op( A ), - !> where alpha is a scalar, B is an m by n matrix, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T. + !! STRMM performs one of the matrix-matrix operations + !! B := alpha*op( A )*B, or B := alpha*B*op( A ), + !! where alpha is a scalar, B is an m by n matrix, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3954,10 +3948,10 @@ module stdlib_linalg_blas_s pure subroutine stdlib_strmv(uplo,trans,diag,n,a,lda,x,incx) - !> STRMV performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular matrix. + !! STRMV performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4120,12 +4114,12 @@ module stdlib_linalg_blas_s pure subroutine stdlib_strsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) - !> STRSM solves one of the matrix equations - !> op( A )*X = alpha*B, or X*op( A ) = alpha*B, - !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T. - !> The matrix X is overwritten on B. + !! STRSM solves one of the matrix equations + !! op( A )*X = alpha*B, or X*op( A ) = alpha*B, + !! where alpha is a scalar, X and B are m by n matrices, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T. + !! The matrix X is overwritten on B. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4351,12 +4345,12 @@ module stdlib_linalg_blas_s pure subroutine stdlib_strsv(uplo,trans,diag,n,a,lda,x,incx) - !> STRSV solves one of the systems of equations - !> A*x = b, or A**T*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular matrix. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! STRSV solves one of the systems of equations + !! A*x = b, or A**T*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular matrix. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_blas_w.fypp b/src/stdlib_linalg_blas_w.fypp index 3b55f4cab..dafc4a314 100644 --- a/src/stdlib_linalg_blas_w.fypp +++ b/src/stdlib_linalg_blas_w.fypp @@ -91,7 +91,7 @@ module stdlib_linalg_blas_w pure subroutine stdlib_waxpy(n,za,zx,incx,zy,incy) - !> ZAXPY: constant times a vector plus a vector. + !! ZAXPY: constant times a vector plus a vector. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -129,7 +129,7 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wcopy(n,zx,incx,zy,incy) - !> ZCOPY: copies a vector, x, to a vector, y. + !! ZCOPY: copies a vector, x, to a vector, y. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -165,8 +165,8 @@ module stdlib_linalg_blas_w pure complex(qp) function stdlib_wdotc(n,zx,incx,zy,incy) - !> ZDOTC: forms the dot product of two complex vectors - !> ZDOTC = X^H * Y + !! ZDOTC: forms the dot product of two complex vectors + !! ZDOTC = X^H * Y ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -207,8 +207,8 @@ module stdlib_linalg_blas_w pure complex(qp) function stdlib_wdotu(n,zx,incx,zy,incy) - !> ZDOTU: forms the dot product of two complex vectors - !> ZDOTU = X^T * Y + !! ZDOTU: forms the dot product of two complex vectors + !! ZDOTU = X^T * Y ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -247,9 +247,9 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wdrot( n, zx, incx, zy, incy, c, s ) - !> Applies a plane rotation, where the cos and sin (c and s) are real - !> and the vectors cx and cy are complex. - !> jack dongarra, linpack, 3/11/78. + !! Applies a plane rotation, where the cos and sin (c and s) are real + !! and the vectors cx and cy are complex. + !! jack dongarra, linpack, 3/11/78. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -291,7 +291,7 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wdscal(n,da,zx,incx) - !> ZDSCAL: scales a vector by a constant. + !! ZDSCAL: scales a vector by a constant. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -323,11 +323,11 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) - !> ZGBMV: performs one of the matrix-vector operations - !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or - !> y := alpha*A**H*x + beta*y, - !> where alpha and beta are scalars, x and y are vectors and A is an - !> m by n band matrix, with kl sub-diagonals and ku super-diagonals. + !! ZGBMV: performs one of the matrix-vector operations + !! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or + !! y := alpha*A**H*x + beta*y, + !! where alpha and beta are scalars, x and y are vectors and A is an + !! m by n band matrix, with kl sub-diagonals and ku super-diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -495,12 +495,12 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) - !> ZGEMM: performs one of the matrix-matrix operations - !> C := alpha*op( A )*op( B ) + beta*C, - !> where op( X ) is one of - !> op( X ) = X or op( X ) = X**T or op( X ) = X**H, - !> alpha and beta are scalars, and A, B and C are matrices, with op( A ) - !> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. + !! ZGEMM: performs one of the matrix-matrix operations + !! C := alpha*op( A )*op( B ) + beta*C, + !! where op( X ) is one of + !! op( X ) = X or op( X ) = X**T or op( X ) = X**H, + !! alpha and beta are scalars, and A, B and C are matrices, with op( A ) + !! an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -744,11 +744,11 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) - !> ZGEMV: performs one of the matrix-vector operations - !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or - !> y := alpha*A**H*x + beta*y, - !> where alpha and beta are scalars, x and y are vectors and A is an - !> m by n matrix. + !! ZGEMV: performs one of the matrix-vector operations + !! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or + !! y := alpha*A**H*x + beta*y, + !! where alpha and beta are scalars, x and y are vectors and A is an + !! m by n matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -905,10 +905,10 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wgerc(m,n,alpha,x,incx,y,incy,a,lda) - !> ZGERC: performs the rank 1 operation - !> A := alpha*x*y**H + A, - !> where alpha is a scalar, x is an m element vector, y is an n element - !> vector and A is an m by n matrix. + !! ZGERC: performs the rank 1 operation + !! A := alpha*x*y**H + A, + !! where alpha is a scalar, x is an m element vector, y is an n element + !! vector and A is an m by n matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -984,10 +984,10 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wgeru(m,n,alpha,x,incx,y,incy,a,lda) - !> ZGERU: performs the rank 1 operation - !> A := alpha*x*y**T + A, - !> where alpha is a scalar, x is an m element vector, y is an n element - !> vector and A is an m by n matrix. + !! ZGERU: performs the rank 1 operation + !! A := alpha*x*y**T + A, + !! where alpha is a scalar, x is an m element vector, y is an n element + !! vector and A is an m by n matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1063,10 +1063,10 @@ module stdlib_linalg_blas_w pure subroutine stdlib_whbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) - !> ZHBMV: performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n hermitian band matrix, with k super-diagonals. + !! ZHBMV: performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n hermitian band matrix, with k super-diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1226,12 +1226,12 @@ module stdlib_linalg_blas_w pure subroutine stdlib_whemm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) - !> ZHEMM: performs one of the matrix-matrix operations - !> C := alpha*A*B + beta*C, - !> or - !> C := alpha*B*A + beta*C, - !> where alpha and beta are scalars, A is an hermitian matrix and B and - !> C are m by n matrices. + !! ZHEMM: performs one of the matrix-matrix operations + !! C := alpha*A*B + beta*C, + !! or + !! C := alpha*B*A + beta*C, + !! where alpha and beta are scalars, A is an hermitian matrix and B and + !! C are m by n matrices. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1376,10 +1376,10 @@ module stdlib_linalg_blas_w pure subroutine stdlib_whemv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) - !> ZHEMV: performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n hermitian matrix. + !! ZHEMV: performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n hermitian matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1529,10 +1529,10 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wher(uplo,n,alpha,x,incx,a,lda) - !> ZHER: performs the hermitian rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n hermitian matrix. + !! ZHER: performs the hermitian rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n hermitian matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1644,10 +1644,10 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wher2(uplo,n,alpha,x,incx,y,incy,a,lda) - !> ZHER2: performs the hermitian rank 2 operation - !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, - !> where alpha is a scalar, x and y are n element vectors and A is an n - !> by n hermitian matrix. + !! ZHER2: performs the hermitian rank 2 operation + !! A := alpha*x*y**H + conjg( alpha )*y*x**H + A, + !! where alpha is a scalar, x and y are n element vectors and A is an n + !! by n hermitian matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1783,13 +1783,13 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wher2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) - !> ZHER2K: performs one of the hermitian rank 2k operations - !> C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C, - !> or - !> C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C, - !> where alpha and beta are scalars with beta real, C is an n by n - !> hermitian matrix and A and B are n by k matrices in the first case - !> and k by n matrices in the second case. + !! ZHER2K: performs one of the hermitian rank 2k operations + !! C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C, + !! or + !! C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C, + !! where alpha and beta are scalars with beta real, C is an n by n + !! hermitian matrix and A and B are n by k matrices in the first case + !! and k by n matrices in the second case. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1992,13 +1992,13 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wherk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) - !> ZHERK: 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. + !! ZHERK: 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. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2188,10 +2188,10 @@ module stdlib_linalg_blas_w pure subroutine stdlib_whpmv(uplo,n,alpha,ap,x,incx,beta,y,incy) - !> ZHPMV: performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n hermitian matrix, supplied in packed form. + !! ZHPMV: performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n hermitian matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2347,10 +2347,10 @@ module stdlib_linalg_blas_w pure subroutine stdlib_whpr(uplo,n,alpha,x,incx,ap) - !> ZHPR: performs the hermitian rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n hermitian matrix, supplied in packed form. + !! ZHPR: performs the hermitian rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n hermitian matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2469,10 +2469,10 @@ module stdlib_linalg_blas_w pure subroutine stdlib_whpr2(uplo,n,alpha,x,incx,y,incy,ap) - !> ZHPR2: performs the hermitian rank 2 operation - !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, - !> where alpha is a scalar, x and y are n element vectors and A is an - !> n by n hermitian matrix, supplied in packed form. + !! ZHPR2: performs the hermitian rank 2 operation + !! A := alpha*x*y**H + conjg( alpha )*y*x**H + A, + !! where alpha is a scalar, x and y are n element vectors and A is an + !! n by n hermitian matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2614,21 +2614,19 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wrotg( a, b, c, s ) - !> ! - !> - !> The computation uses the formulas - !> |x| = sqrt( Re(x)**2 + Im(x)**2 ) - !> sgn(x) = x / |x| if x /= 0 - !> = 1 if x = 0 - !> c = |a| / sqrt(|a|**2 + |b|**2) - !> s = sgn(a) * conjg(b) / sqrt(|a|**2 + |b|**2) - !> When a and b are real and r /= 0, the formulas simplify to - !> r = sgn(a)*sqrt(|a|**2 + |b|**2) - !> c = a / r - !> s = b / r - !> the same as in DROTG when |a| > |b|. When |b| >= |a|, the - !> sign of c and s will be different from those computed by DROTG - !> if the signs of a and b are not the same. + !! The computation uses the formulas + !! |x| = sqrt( Re(x)**2 + Im(x)**2 ) + !! sgn(x) = x / |x| if x /= 0 + !! = 1 if x = 0 + !! c = |a| / sqrt(|a|**2 + |b|**2) + !! s = sgn(a) * conjg(b) / sqrt(|a|**2 + |b|**2) + !! When a and b are real and r /= 0, the formulas simplify to + !! r = sgn(a)*sqrt(|a|**2 + |b|**2) + !! c = a / r + !! s = b / r + !! the same as in DROTG when |a| > |b|. When |b| >= |a|, the + !! sign of c and s will be different from those computed by DROTG + !! if the signs of a and b are not the same. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2731,7 +2729,7 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wscal(n,za,zx,incx) - !> ZSCAL: scales a vector by a constant. + !! ZSCAL: scales a vector by a constant. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2761,7 +2759,7 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wswap(n,zx,incx,zy,incy) - !> ZSWAP: interchanges two vectors. + !! ZSWAP: interchanges two vectors. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2801,12 +2799,12 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wsymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) - !> ZSYMM: performs one of the matrix-matrix operations - !> C := alpha*A*B + beta*C, - !> or - !> C := alpha*B*A + beta*C, - !> where alpha and beta are scalars, A is a symmetric matrix and B and - !> C are m by n matrices. + !! ZSYMM: performs one of the matrix-matrix operations + !! C := alpha*A*B + beta*C, + !! or + !! C := alpha*B*A + beta*C, + !! where alpha and beta are scalars, A is a symmetric matrix and B and + !! C are m by n matrices. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2949,13 +2947,13 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wsyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) - !> ZSYR2K: performs one of the symmetric rank 2k operations - !> C := alpha*A*B**T + alpha*B*A**T + beta*C, - !> or - !> C := alpha*A**T*B + alpha*B**T*A + beta*C, - !> where alpha and beta are scalars, C is an n by n symmetric matrix - !> and A and B are n by k matrices in the first case and k by n - !> matrices in the second case. + !! ZSYR2K: performs one of the symmetric rank 2k operations + !! C := alpha*A*B**T + alpha*B*A**T + beta*C, + !! or + !! C := alpha*A**T*B + alpha*B**T*A + beta*C, + !! where alpha and beta are scalars, C is an n by n symmetric matrix + !! and A and B are n by k matrices in the first case and k by n + !! matrices in the second case. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3125,13 +3123,13 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wsyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) - !> ZSYRK: performs one of the symmetric rank k operations - !> C := alpha*A*A**T + beta*C, - !> or - !> C := alpha*A**T*A + beta*C, - !> where alpha and beta are scalars, C is an n by n symmetric matrix - !> and A is an n by k matrix in the first case and a k by n matrix - !> in the second case. + !! ZSYRK: performs one of the symmetric rank k operations + !! C := alpha*A*A**T + beta*C, + !! or + !! C := alpha*A**T*A + beta*C, + !! where alpha and beta are scalars, C is an n by n symmetric matrix + !! and A is an n by k matrix in the first case and a k by n matrix + !! in the second case. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3293,10 +3291,10 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wtbmv(uplo,trans,diag,n,k,a,lda,x,incx) - !> ZTBMV: performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, or x := A**H*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular band matrix, with ( k + 1 ) diagonals. + !! ZTBMV: performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, or x := A**H*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular band matrix, with ( k + 1 ) diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3507,13 +3505,13 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wtbsv(uplo,trans,diag,n,k,a,lda,x,incx) - !> ZTBSV: solves one of the systems of equations - !> A*x = b, or A**T*x = b, or A**H*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular band matrix, with ( k + 1 ) - !> diagonals. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! ZTBSV: solves one of the systems of equations + !! A*x = b, or A**T*x = b, or A**H*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular band matrix, with ( k + 1 ) + !! diagonals. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3724,10 +3722,10 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wtpmv(uplo,trans,diag,n,ap,x,incx) - !> ZTPMV: performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, or x := A**H*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular matrix, supplied in packed form. + !! ZTPMV: performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, or x := A**H*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3941,12 +3939,12 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wtpsv(uplo,trans,diag,n,ap,x,incx) - !> ZTPSV: solves one of the systems of equations - !> A*x = b, or A**T*x = b, or A**H*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular matrix, supplied in packed form. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! ZTPSV: solves one of the systems of equations + !! A*x = b, or A**T*x = b, or A**H*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular matrix, supplied in packed form. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4160,11 +4158,11 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wtrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) - !> ZTRMM: performs one of the matrix-matrix operations - !> B := alpha*op( A )*B, or B := alpha*B*op( A ) - !> where alpha is a scalar, B is an m by n matrix, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. + !! ZTRMM: performs one of the matrix-matrix operations + !! B := alpha*op( A )*B, or B := alpha*B*op( A ) + !! where alpha is a scalar, B is an m by n matrix, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T or op( A ) = A**H. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4402,10 +4400,10 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wtrmv(uplo,trans,diag,n,a,lda,x,incx) - !> ZTRMV: performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, or x := A**H*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular matrix. + !! ZTRMV: performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, or x := A**H*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4599,12 +4597,12 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wtrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) - !> ZTRSM: solves one of the matrix equations - !> op( A )*X = alpha*B, or X*op( A ) = alpha*B, - !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. - !> The matrix X is overwritten on B. + !! ZTRSM: solves one of the matrix equations + !! op( A )*X = alpha*B, or X*op( A ) = alpha*B, + !! where alpha is a scalar, X and B are m by n matrices, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T or op( A ) = A**H. + !! The matrix X is overwritten on B. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4864,12 +4862,12 @@ module stdlib_linalg_blas_w pure subroutine stdlib_wtrsv(uplo,trans,diag,n,a,lda,x,incx) - !> ZTRSV: solves one of the systems of equations - !> A*x = b, or A**T*x = b, or A**H*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular matrix. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! ZTRSV: solves one of the systems of equations + !! A*x = b, or A**T*x = b, or A**H*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular matrix. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_blas_z.fypp b/src/stdlib_linalg_blas_z.fypp index d0b344ec2..5711d23b3 100644 --- a/src/stdlib_linalg_blas_z.fypp +++ b/src/stdlib_linalg_blas_z.fypp @@ -88,7 +88,7 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zaxpy(n,za,zx,incx,zy,incy) - !> ZAXPY constant times a vector plus a vector. + !! ZAXPY constant times a vector plus a vector. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -126,7 +126,7 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zcopy(n,zx,incx,zy,incy) - !> ZCOPY copies a vector, x, to a vector, y. + !! ZCOPY copies a vector, x, to a vector, y. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -162,8 +162,8 @@ module stdlib_linalg_blas_z pure complex(dp) function stdlib_zdotc(n,zx,incx,zy,incy) - !> ZDOTC forms the dot product of two complex vectors - !> ZDOTC = X^H * Y + !! ZDOTC forms the dot product of two complex vectors + !! ZDOTC = X^H * Y ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -204,8 +204,8 @@ module stdlib_linalg_blas_z pure complex(dp) function stdlib_zdotu(n,zx,incx,zy,incy) - !> ZDOTU forms the dot product of two complex vectors - !> ZDOTU = X^T * Y + !! ZDOTU forms the dot product of two complex vectors + !! ZDOTU = X^T * Y ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -244,9 +244,9 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zdrot( n, zx, incx, zy, incy, c, s ) - !> Applies a plane rotation, where the cos and sin (c and s) are real - !> and the vectors cx and cy are complex. - !> jack dongarra, linpack, 3/11/78. + !! Applies a plane rotation, where the cos and sin (c and s) are real + !! and the vectors cx and cy are complex. + !! jack dongarra, linpack, 3/11/78. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -288,7 +288,7 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zdscal(n,da,zx,incx) - !> ZDSCAL scales a vector by a constant. + !! ZDSCAL scales a vector by a constant. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -320,11 +320,11 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zgbmv(trans,m,n,kl,ku,alpha,a,lda,x,incx,beta,y,incy) - !> ZGBMV performs one of the matrix-vector operations - !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or - !> y := alpha*A**H*x + beta*y, - !> where alpha and beta are scalars, x and y are vectors and A is an - !> m by n band matrix, with kl sub-diagonals and ku super-diagonals. + !! ZGBMV performs one of the matrix-vector operations + !! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or + !! y := alpha*A**H*x + beta*y, + !! where alpha and beta are scalars, x and y are vectors and A is an + !! m by n band matrix, with kl sub-diagonals and ku super-diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -492,12 +492,12 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zgemm(transa,transb,m,n,k,alpha,a,lda,b,ldb,beta,c,ldc) - !> ZGEMM performs one of the matrix-matrix operations - !> C := alpha*op( A )*op( B ) + beta*C, - !> where op( X ) is one of - !> op( X ) = X or op( X ) = X**T or op( X ) = X**H, - !> alpha and beta are scalars, and A, B and C are matrices, with op( A ) - !> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. + !! ZGEMM performs one of the matrix-matrix operations + !! C := alpha*op( A )*op( B ) + beta*C, + !! where op( X ) is one of + !! op( X ) = X or op( X ) = X**T or op( X ) = X**H, + !! alpha and beta are scalars, and A, B and C are matrices, with op( A ) + !! an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -741,11 +741,11 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zgemv(trans,m,n,alpha,a,lda,x,incx,beta,y,incy) - !> ZGEMV performs one of the matrix-vector operations - !> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or - !> y := alpha*A**H*x + beta*y, - !> where alpha and beta are scalars, x and y are vectors and A is an - !> m by n matrix. + !! ZGEMV performs one of the matrix-vector operations + !! y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or + !! y := alpha*A**H*x + beta*y, + !! where alpha and beta are scalars, x and y are vectors and A is an + !! m by n matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -902,10 +902,10 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zgerc(m,n,alpha,x,incx,y,incy,a,lda) - !> ZGERC performs the rank 1 operation - !> A := alpha*x*y**H + A, - !> where alpha is a scalar, x is an m element vector, y is an n element - !> vector and A is an m by n matrix. + !! ZGERC performs the rank 1 operation + !! A := alpha*x*y**H + A, + !! where alpha is a scalar, x is an m element vector, y is an n element + !! vector and A is an m by n matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -981,10 +981,10 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zgeru(m,n,alpha,x,incx,y,incy,a,lda) - !> ZGERU performs the rank 1 operation - !> A := alpha*x*y**T + A, - !> where alpha is a scalar, x is an m element vector, y is an n element - !> vector and A is an m by n matrix. + !! ZGERU performs the rank 1 operation + !! A := alpha*x*y**T + A, + !! where alpha is a scalar, x is an m element vector, y is an n element + !! vector and A is an m by n matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1060,10 +1060,10 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zhbmv(uplo,n,k,alpha,a,lda,x,incx,beta,y,incy) - !> ZHBMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n hermitian band matrix, with k super-diagonals. + !! ZHBMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n hermitian band matrix, with k super-diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1223,12 +1223,12 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zhemm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) - !> ZHEMM performs one of the matrix-matrix operations - !> C := alpha*A*B + beta*C, - !> or - !> C := alpha*B*A + beta*C, - !> where alpha and beta are scalars, A is an hermitian matrix and B and - !> C are m by n matrices. + !! ZHEMM performs one of the matrix-matrix operations + !! C := alpha*A*B + beta*C, + !! or + !! C := alpha*B*A + beta*C, + !! where alpha and beta are scalars, A is an hermitian matrix and B and + !! C are m by n matrices. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1373,10 +1373,10 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zhemv(uplo,n,alpha,a,lda,x,incx,beta,y,incy) - !> ZHEMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n hermitian matrix. + !! ZHEMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n hermitian matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1526,10 +1526,10 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zher(uplo,n,alpha,x,incx,a,lda) - !> ZHER performs the hermitian rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n hermitian matrix. + !! ZHER performs the hermitian rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n hermitian matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1641,10 +1641,10 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zher2(uplo,n,alpha,x,incx,y,incy,a,lda) - !> ZHER2 performs the hermitian rank 2 operation - !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, - !> where alpha is a scalar, x and y are n element vectors and A is an n - !> by n hermitian matrix. + !! ZHER2 performs the hermitian rank 2 operation + !! A := alpha*x*y**H + conjg( alpha )*y*x**H + A, + !! where alpha is a scalar, x and y are n element vectors and A is an n + !! by n hermitian matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1780,13 +1780,13 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zher2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) - !> ZHER2K performs one of the hermitian rank 2k operations - !> C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C, - !> or - !> C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C, - !> where alpha and beta are scalars with beta real, C is an n by n - !> hermitian matrix and A and B are n by k matrices in the first case - !> and k by n matrices in the second case. + !! ZHER2K performs one of the hermitian rank 2k operations + !! C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C, + !! or + !! C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C, + !! where alpha and beta are scalars with beta real, C is an n by n + !! hermitian matrix and A and B are n by k matrices in the first case + !! and k by n matrices in the second case. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1989,13 +1989,13 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zherk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) - !> ZHERK 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. + !! ZHERK 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. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2185,10 +2185,10 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zhpmv(uplo,n,alpha,ap,x,incx,beta,y,incy) - !> ZHPMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n hermitian matrix, supplied in packed form. + !! ZHPMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n hermitian matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2344,10 +2344,10 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zhpr(uplo,n,alpha,x,incx,ap) - !> ZHPR performs the hermitian rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a real scalar, x is an n element vector and A is an - !> n by n hermitian matrix, supplied in packed form. + !! ZHPR performs the hermitian rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a real scalar, x is an n element vector and A is an + !! n by n hermitian matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2466,10 +2466,10 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zhpr2(uplo,n,alpha,x,incx,y,incy,ap) - !> ZHPR2 performs the hermitian rank 2 operation - !> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, - !> where alpha is a scalar, x and y are n element vectors and A is an - !> n by n hermitian matrix, supplied in packed form. + !! ZHPR2 performs the hermitian rank 2 operation + !! A := alpha*x*y**H + conjg( alpha )*y*x**H + A, + !! where alpha is a scalar, x and y are n element vectors and A is an + !! n by n hermitian matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2611,21 +2611,19 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zrotg( a, b, c, s ) - !> ! - !> - !> The computation uses the formulas - !> |x| = sqrt( Re(x)**2 + Im(x)**2 ) - !> sgn(x) = x / |x| if x /= 0 - !> = 1 if x = 0 - !> c = |a| / sqrt(|a|**2 + |b|**2) - !> s = sgn(a) * conjg(b) / sqrt(|a|**2 + |b|**2) - !> When a and b are real and r /= 0, the formulas simplify to - !> r = sgn(a)*sqrt(|a|**2 + |b|**2) - !> c = a / r - !> s = b / r - !> the same as in DROTG when |a| > |b|. When |b| >= |a|, the - !> sign of c and s will be different from those computed by DROTG - !> if the signs of a and b are not the same. + !! The computation uses the formulas + !! |x| = sqrt( Re(x)**2 + Im(x)**2 ) + !! sgn(x) = x / |x| if x /= 0 + !! = 1 if x = 0 + !! c = |a| / sqrt(|a|**2 + |b|**2) + !! s = sgn(a) * conjg(b) / sqrt(|a|**2 + |b|**2) + !! When a and b are real and r /= 0, the formulas simplify to + !! r = sgn(a)*sqrt(|a|**2 + |b|**2) + !! c = a / r + !! s = b / r + !! the same as in DROTG when |a| > |b|. When |b| >= |a|, the + !! sign of c and s will be different from those computed by DROTG + !! if the signs of a and b are not the same. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2728,7 +2726,7 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zscal(n,za,zx,incx) - !> ZSCAL scales a vector by a constant. + !! ZSCAL scales a vector by a constant. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2758,7 +2756,7 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zswap(n,zx,incx,zy,incy) - !> ZSWAP interchanges two vectors. + !! ZSWAP interchanges two vectors. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2798,12 +2796,12 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zsymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) - !> ZSYMM performs one of the matrix-matrix operations - !> C := alpha*A*B + beta*C, - !> or - !> C := alpha*B*A + beta*C, - !> where alpha and beta are scalars, A is a symmetric matrix and B and - !> C are m by n matrices. + !! ZSYMM performs one of the matrix-matrix operations + !! C := alpha*A*B + beta*C, + !! or + !! C := alpha*B*A + beta*C, + !! where alpha and beta are scalars, A is a symmetric matrix and B and + !! C are m by n matrices. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2946,13 +2944,13 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zsyr2k(uplo,trans,n,k,alpha,a,lda,b,ldb,beta,c,ldc) - !> ZSYR2K performs one of the symmetric rank 2k operations - !> C := alpha*A*B**T + alpha*B*A**T + beta*C, - !> or - !> C := alpha*A**T*B + alpha*B**T*A + beta*C, - !> where alpha and beta are scalars, C is an n by n symmetric matrix - !> and A and B are n by k matrices in the first case and k by n - !> matrices in the second case. + !! ZSYR2K performs one of the symmetric rank 2k operations + !! C := alpha*A*B**T + alpha*B*A**T + beta*C, + !! or + !! C := alpha*A**T*B + alpha*B**T*A + beta*C, + !! where alpha and beta are scalars, C is an n by n symmetric matrix + !! and A and B are n by k matrices in the first case and k by n + !! matrices in the second case. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3122,13 +3120,13 @@ module stdlib_linalg_blas_z pure subroutine stdlib_zsyrk(uplo,trans,n,k,alpha,a,lda,beta,c,ldc) - !> ZSYRK performs one of the symmetric rank k operations - !> C := alpha*A*A**T + beta*C, - !> or - !> C := alpha*A**T*A + beta*C, - !> where alpha and beta are scalars, C is an n by n symmetric matrix - !> and A is an n by k matrix in the first case and a k by n matrix - !> in the second case. + !! ZSYRK performs one of the symmetric rank k operations + !! C := alpha*A*A**T + beta*C, + !! or + !! C := alpha*A**T*A + beta*C, + !! where alpha and beta are scalars, C is an n by n symmetric matrix + !! and A is an n by k matrix in the first case and a k by n matrix + !! in the second case. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3290,10 +3288,10 @@ module stdlib_linalg_blas_z pure subroutine stdlib_ztbmv(uplo,trans,diag,n,k,a,lda,x,incx) - !> ZTBMV performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, or x := A**H*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular band matrix, with ( k + 1 ) diagonals. + !! ZTBMV performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, or x := A**H*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular band matrix, with ( k + 1 ) diagonals. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3504,13 +3502,13 @@ module stdlib_linalg_blas_z pure subroutine stdlib_ztbsv(uplo,trans,diag,n,k,a,lda,x,incx) - !> ZTBSV solves one of the systems of equations - !> A*x = b, or A**T*x = b, or A**H*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular band matrix, with ( k + 1 ) - !> diagonals. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! ZTBSV solves one of the systems of equations + !! A*x = b, or A**T*x = b, or A**H*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular band matrix, with ( k + 1 ) + !! diagonals. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3721,10 +3719,10 @@ module stdlib_linalg_blas_z pure subroutine stdlib_ztpmv(uplo,trans,diag,n,ap,x,incx) - !> ZTPMV performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, or x := A**H*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular matrix, supplied in packed form. + !! ZTPMV performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, or x := A**H*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular matrix, supplied in packed form. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3938,12 +3936,12 @@ module stdlib_linalg_blas_z pure subroutine stdlib_ztpsv(uplo,trans,diag,n,ap,x,incx) - !> ZTPSV solves one of the systems of equations - !> A*x = b, or A**T*x = b, or A**H*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular matrix, supplied in packed form. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! ZTPSV solves one of the systems of equations + !! A*x = b, or A**T*x = b, or A**H*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular matrix, supplied in packed form. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4157,11 +4155,11 @@ module stdlib_linalg_blas_z pure subroutine stdlib_ztrmm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) - !> ZTRMM performs one of the matrix-matrix operations - !> B := alpha*op( A )*B, or B := alpha*B*op( A ) - !> where alpha is a scalar, B is an m by n matrix, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. + !! ZTRMM performs one of the matrix-matrix operations + !! B := alpha*op( A )*B, or B := alpha*B*op( A ) + !! where alpha is a scalar, B is an m by n matrix, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T or op( A ) = A**H. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4399,10 +4397,10 @@ module stdlib_linalg_blas_z pure subroutine stdlib_ztrmv(uplo,trans,diag,n,a,lda,x,incx) - !> ZTRMV performs one of the matrix-vector operations - !> x := A*x, or x := A**T*x, or x := A**H*x, - !> where x is an n element vector and A is an n by n unit, or non-unit, - !> upper or lower triangular matrix. + !! ZTRMV performs one of the matrix-vector operations + !! x := A*x, or x := A**T*x, or x := A**H*x, + !! where x is an n element vector and A is an n by n unit, or non-unit, + !! upper or lower triangular matrix. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4596,12 +4594,12 @@ module stdlib_linalg_blas_z pure subroutine stdlib_ztrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb) - !> ZTRSM solves one of the matrix equations - !> op( A )*X = alpha*B, or X*op( A ) = alpha*B, - !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T or op( A ) = A**H. - !> The matrix X is overwritten on B. + !! ZTRSM solves one of the matrix equations + !! op( A )*X = alpha*B, or X*op( A ) = alpha*B, + !! where alpha is a scalar, X and B are m by n matrices, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T or op( A ) = A**H. + !! The matrix X is overwritten on B. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4861,12 +4859,12 @@ module stdlib_linalg_blas_z pure subroutine stdlib_ztrsv(uplo,trans,diag,n,a,lda,x,incx) - !> ZTRSV solves one of the systems of equations - !> A*x = b, or A**T*x = b, or A**H*x = b, - !> where b and x are n element vectors and A is an n by n unit, or - !> non-unit, upper or lower triangular matrix. - !> No test for singularity or near-singularity is included in this - !> routine. Such tests must be performed before calling this routine. + !! ZTRSV solves one of the systems of equations + !! A*x = b, or A**T*x = b, or A**H*x = b, + !! where b and x are n element vectors and A is an n by n unit, or + !! non-unit, upper or lower triangular matrix. + !! No test for singularity or near-singularity is included in this + !! routine. Such tests must be performed before calling this routine. ! -- reference blas level2 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_lapack.fypp b/src/stdlib_linalg_lapack.fypp index 868647d76..8d0b4ce2c 100644 --- a/src/stdlib_linalg_lapack.fypp +++ b/src/stdlib_linalg_lapack.fypp @@ -17,27 +17,27 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cbbcsd( 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,& @@ -119,22 +119,22 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dbdsdc( uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq,work, iwork, & info ) @@ -171,30 +171,30 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, & rwork, info ) @@ -264,19 +264,19 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ddisna( job, m, n, d, sep, info ) import sp,dp,qp,ilp,lk @@ -311,10 +311,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, & c, ldc, work, rwork, info ) @@ -384,12 +384,12 @@ module stdlib_linalg_lapack 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)) ). + !! 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)) ). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, rwork, & info ) @@ -461,15 +461,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) @@ -533,21 +533,21 @@ module stdlib_linalg_lapack 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). + !! 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) @@ -611,9 +611,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, & x, ldx, ferr, berr, work, rwork,info ) @@ -687,14 +687,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -750,9 +750,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) import sp,dp,qp,ilp,lk @@ -808,10 +808,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) @@ -879,9 +879,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) import sp,dp,qp,ilp,lk @@ -945,14 +945,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgebal( job, n, a, lda, ilo, ihi, scale, info ) import sp,dp,qp,ilp,lk @@ -1016,9 +1016,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -1080,12 +1080,12 @@ module stdlib_linalg_lapack 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)) ). + !! 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)) ). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgecon( norm, n, a, lda, anorm, rcond, work, rwork,info ) import sp,dp,qp,ilp,lk @@ -1155,15 +1155,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) import sp,dp,qp,ilp,lk @@ -1223,21 +1223,21 @@ module stdlib_linalg_lapack 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). + !! 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) import sp,dp,qp,ilp,lk @@ -1297,14 +1297,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgees( jobvs, sort, select, n, a, lda, sdim, w, vs,ldvs, work, lwork, & rwork, bwork, info ) @@ -1382,16 +1382,16 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgeev( jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr,work, lwork, & rwork, info ) @@ -1461,8 +1461,8 @@ module stdlib_linalg_lapack interface gehrd - !> GEHRD reduces a complex general matrix A to upper Hessenberg form H by - !> an unitary similarity transformation: Q**H * A * Q = H . + !! GEHRD reduces a complex general matrix A to upper Hessenberg form H by + !! an unitary similarity transformation: Q**H * A * Q = H . #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -1522,16 +1522,16 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, & ldu, v, ldv,cwork, lwork, rwork, lrwork, iwork, info ) @@ -1601,12 +1601,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgelq( m, n, a, lda, t, tsize, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -1666,12 +1666,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgelqf( m, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -1731,8 +1731,8 @@ module stdlib_linalg_lapack interface gelqt - !> GELQT computes a blocked LQ factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. + !! GELQT computes a blocked LQ factorization of a complex M-by-N matrix A + !! using the compact WY representation of Q. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgelqt( m, n, mb, a, lda, t, ldt, work, info ) import sp,dp,qp,ilp,lk @@ -1792,10 +1792,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure recursive subroutine cgelqt3( m, n, a, lda, t, ldt, info ) import sp,dp,qp,ilp,lk @@ -1855,24 +1855,24 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -1936,31 +1936,31 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & iwork, info ) @@ -2030,18 +2030,18 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & info ) @@ -2111,38 +2111,38 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, & rwork, info ) @@ -2216,13 +2216,13 @@ module stdlib_linalg_lapack 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) + !! 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) #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork,& info ) @@ -2294,15 +2294,15 @@ module stdlib_linalg_lapack 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'. + !! 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, & info ) @@ -2374,13 +2374,13 @@ module stdlib_linalg_lapack 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) + !! 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) #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork,& info ) @@ -2452,15 +2452,15 @@ module stdlib_linalg_lapack 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'. + !! 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, & info ) @@ -2532,8 +2532,8 @@ module stdlib_linalg_lapack interface geqlf - !> GEQLF computes a QL factorization of a complex M-by-N matrix A: - !> A = Q * L. + !! GEQLF computes a QL factorization of a complex M-by-N matrix A: + !! A = Q * L. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeqlf( m, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -2593,13 +2593,13 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeqr( m, n, a, lda, t, tsize, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -2659,14 +2659,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgeqr2p( m, n, a, lda, tau, work, info ) import sp,dp,qp,ilp,lk @@ -2726,13 +2726,13 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeqrf( m, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -2792,14 +2792,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgeqrfp( m, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -2859,8 +2859,8 @@ module stdlib_linalg_lapack interface geqrt - !> GEQRT computes a blocked QR factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. + !! GEQRT computes a blocked QR factorization of a complex M-by-N matrix A + !! using the compact WY representation of Q. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeqrt( m, n, nb, a, lda, t, ldt, work, info ) import sp,dp,qp,ilp,lk @@ -2920,8 +2920,8 @@ module stdlib_linalg_lapack interface geqrt2 - !> GEQRT2 computes a QR factorization of a complex M-by-N matrix A, - !> using the compact WY representation of Q. + !! GEQRT2 computes a QR factorization of a complex M-by-N matrix A, + !! using the compact WY representation of Q. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeqrt2( m, n, a, lda, t, ldt, info ) import sp,dp,qp,ilp,lk @@ -2981,10 +2981,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure recursive subroutine cgeqrt3( m, n, a, lda, t, ldt, info ) import sp,dp,qp,ilp,lk @@ -3044,9 +3044,9 @@ module stdlib_linalg_lapack interface gerfs - !> GERFS improves the computed solution to a system of linear - !> equations and provides error bounds and backward error estimates for - !> the solution. + !! GERFS improves the computed solution to a system of linear + !! equations and provides error bounds and backward error estimates for + !! the solution. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, & ferr, berr, work, rwork, info ) @@ -3120,8 +3120,8 @@ module stdlib_linalg_lapack interface gerqf - !> GERQF computes an RQ factorization of a complex M-by-N matrix A: - !> A = R * Q. + !! GERQF computes an RQ factorization of a complex M-by-N matrix A: + !! A = R * Q. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgerqf( m, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -3181,23 +3181,23 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, & iwork, info ) @@ -3267,15 +3267,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -3331,17 +3331,17 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, & rwork, info ) @@ -3411,15 +3411,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & numrank, iwork, liwork,cwork, lcwork, rwork, lrwork, info ) @@ -3493,15 +3493,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, cwork, & lwork, rwork, lrwork, info ) @@ -3571,14 +3571,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgetrf( m, n, a, lda, ipiv, info ) import sp,dp,qp,ilp,lk @@ -3634,25 +3634,25 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure recursive subroutine cgetrf2( m, n, a, lda, ipiv, info ) import sp,dp,qp,ilp,lk @@ -3708,10 +3708,10 @@ module stdlib_linalg_lapack 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). + !! 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgetri( n, a, lda, ipiv, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -3771,10 +3771,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -3838,24 +3838,24 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) import sp,dp,qp,ilp,lk @@ -3919,18 +3919,18 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) @@ -3994,10 +3994,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) @@ -4065,15 +4065,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, & info ) @@ -4141,26 +4141,26 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alpha, & beta, vsl, ldvsl, vsr, ldvsr, work,lwork, rwork, bwork, info ) @@ -4242,21 +4242,21 @@ module stdlib_linalg_lapack 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). + !! 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). #ifdef STDLIB_EXTERNAL_LAPACK subroutine cggev( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & work, lwork, rwork, info ) @@ -4330,24 +4330,24 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) @@ -4411,29 +4411,29 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & info ) @@ -4497,18 +4497,18 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) @@ -4572,24 +4572,24 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) @@ -4653,24 +4653,24 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) @@ -4734,10 +4734,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & nsweep, work, lwork, info ) @@ -4811,30 +4811,30 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol,& nsweep, work, lwork, info ) @@ -4908,11 +4908,11 @@ module stdlib_linalg_lapack 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))). + !! 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))). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, info ) @@ -4984,9 +4984,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, & x, ldx, ferr, berr, work, rwork,info ) @@ -5064,12 +5064,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgtsv( n, nrhs, dl, d, du, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -5125,13 +5125,13 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgttrf( n, dl, d, du, du2, ipiv, info ) import sp,dp,qp,ilp,lk @@ -5191,10 +5191,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) import sp,dp,qp,ilp,lk @@ -5258,8 +5258,8 @@ module stdlib_linalg_lapack interface hb2st_kernels - !> HB2ST_KERNELS is an internal routine used by the CHETRD_HB2ST - !> subroutine. + !! HB2ST_KERNELS is an internal routine used by the CHETRD_HB2ST + !! subroutine. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, & lda, v, tau, ldvt, work) @@ -5296,8 +5296,8 @@ module stdlib_linalg_lapack interface hbev - !> HBEV computes all the eigenvalues and, optionally, eigenvectors of - !> a complex Hermitian band matrix A. + !! HBEV computes all the eigenvalues and, optionally, eigenvectors of + !! a complex Hermitian band matrix A. #ifdef STDLIB_EXTERNAL_LAPACK subroutine chbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,rwork, info ) @@ -5336,15 +5336,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine chbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, rwork, & lrwork, iwork, liwork, info ) @@ -5383,13 +5383,13 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, & rwork, info ) @@ -5430,10 +5430,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & rwork, info ) @@ -5472,17 +5472,17 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & lwork, rwork, lrwork, iwork,liwork, info ) @@ -5521,9 +5521,9 @@ module stdlib_linalg_lapack 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. + !! HBTRD reduces a complex Hermitian band matrix A to real symmetric + !! tridiagonal form T by a unitary similarity transformation: + !! Q**H * A * Q = T. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) @@ -5562,11 +5562,11 @@ module stdlib_linalg_lapack 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))). + !! 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))). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine checon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) import sp,dp,qp,ilp,lk @@ -5605,11 +5605,11 @@ module stdlib_linalg_lapack 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))). + !! 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))). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine checon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) @@ -5650,13 +5650,13 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cheequb( uplo, n, a, lda, s, scond, amax, work, info ) import sp,dp,qp,ilp,lk @@ -5693,8 +5693,8 @@ module stdlib_linalg_lapack interface heev - !> HEEV computes all eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix A. + !! HEEV computes all eigenvalues and, optionally, eigenvectors of a + !! complex Hermitian matrix A. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cheev( jobz, uplo, n, a, lda, w, work, lwork, rwork,info ) import sp,dp,qp,ilp,lk @@ -5731,15 +5731,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cheevd( jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, & liwork, info ) @@ -5778,56 +5778,56 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -5868,13 +5868,13 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chegst( itype, uplo, n, a, lda, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -5907,11 +5907,11 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine chegv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, info & ) @@ -5950,17 +5950,17 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine chegvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, & lrwork, iwork, liwork, info ) @@ -5999,9 +5999,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cherfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr,& berr, work, rwork, info ) @@ -6042,17 +6042,17 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chesv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -6089,16 +6089,16 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chesv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -6135,20 +6135,20 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chesv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info & ) @@ -6185,22 +6185,22 @@ module stdlib_linalg_lapack 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). + !! 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chesv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -6237,8 +6237,8 @@ module stdlib_linalg_lapack interface heswapr - !> HESWAPR applies an elementary permutation on the rows and the columns of - !> a hermitian matrix. + !! HESWAPR applies an elementary permutation on the rows and the columns of + !! a hermitian matrix. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cheswapr( uplo, n, a, lda, i1, i2) import sp,dp,qp,ilp,lk @@ -6269,15 +6269,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetf2_rk( uplo, n, a, lda, e, ipiv, info ) import sp,dp,qp,ilp,lk @@ -6312,13 +6312,13 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetf2_rook( uplo, n, a, lda, ipiv, info ) import sp,dp,qp,ilp,lk @@ -6351,9 +6351,9 @@ module stdlib_linalg_lapack 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. + !! HETRD reduces a complex Hermitian matrix A to real symmetric + !! tridiagonal form T by a unitary similarity transformation: + !! Q**H * A * Q = T. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -6390,9 +6390,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, & lhous, work, lwork, info ) @@ -6431,9 +6431,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info & ) @@ -6470,14 +6470,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrf( uplo, n, a, lda, ipiv, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -6512,12 +6512,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) import sp,dp,qp,ilp,lk @@ -6552,15 +6552,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -6595,14 +6595,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -6637,9 +6637,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetri( uplo, n, a, lda, ipiv, work, info ) import sp,dp,qp,ilp,lk @@ -6674,9 +6674,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetri_rook( uplo, n, a, lda, ipiv, work, info ) import sp,dp,qp,ilp,lk @@ -6711,9 +6711,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -6748,9 +6748,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) import sp,dp,qp,ilp,lk @@ -6785,15 +6785,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) import sp,dp,qp,ilp,lk @@ -6828,9 +6828,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) @@ -6869,9 +6869,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) import sp,dp,qp,ilp,lk @@ -6906,14 +6906,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) import sp,dp,qp,ilp,lk @@ -6948,39 +6948,39 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine chgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alpha, beta, q, & ldq, z, ldz, work, lwork,rwork, info ) @@ -7050,11 +7050,11 @@ module stdlib_linalg_lapack 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))). + !! 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))). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chpcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) import sp,dp,qp,ilp,lk @@ -7093,8 +7093,8 @@ module stdlib_linalg_lapack interface hpev - !> HPEV computes all the eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix in packed storage. + !! HPEV computes all the eigenvalues and, optionally, eigenvectors of a + !! complex Hermitian matrix in packed storage. #ifdef STDLIB_EXTERNAL_LAPACK subroutine chpev( jobz, uplo, n, ap, w, z, ldz, work, rwork,info ) import sp,dp,qp,ilp,lk @@ -7131,15 +7131,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine chpevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,rwork, lrwork, iwork, & liwork, info ) @@ -7178,13 +7178,13 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chpgst( itype, uplo, n, ap, bp, info ) import sp,dp,qp,ilp,lk @@ -7219,11 +7219,11 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine chpgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,rwork, info ) @@ -7262,18 +7262,18 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine chpgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, rwork, & lrwork, iwork, liwork, info ) @@ -7312,10 +7312,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, & work, rwork, info ) @@ -7356,17 +7356,17 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chpsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -7399,9 +7399,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chptrd( uplo, n, ap, d, e, tau, info ) import sp,dp,qp,ilp,lk @@ -7438,12 +7438,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chptrf( uplo, n, ap, ipiv, info ) import sp,dp,qp,ilp,lk @@ -7476,9 +7476,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chptri( uplo, n, ap, ipiv, work, info ) import sp,dp,qp,ilp,lk @@ -7513,9 +7513,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -7550,12 +7550,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine chsein( side, eigsrc, initv, select, n, h, ldh, w, vl,ldvl, vr, ldvr, & mm, m, work, rwork, ifaill,ifailr, info ) @@ -7633,14 +7633,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chseqr( job, compz, n, ilo, ihi, h, ldh, w, z, ldz,work, lwork, & info ) @@ -7708,9 +7708,9 @@ module stdlib_linalg_lapack interface isnan - !> ISNAN returns .TRUE. if its argument is NaN, and .FALSE. - !> otherwise. To be replaced by the Fortran 2003 intrinsic in the - !> future. + !! ISNAN returns .TRUE. if its argument is NaN, and .FALSE. + !! otherwise. To be replaced by the Fortran 2003 intrinsic in the + !! future. #ifdef STDLIB_EXTERNAL_LAPACK pure logical(lk) function disnan( din ) import sp,dp,qp,ilp,lk @@ -7737,19 +7737,19 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) @@ -7811,15 +7811,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(dp) function dla_gbrcond( trans, n, kl, ku, ab, ldab,afb, ldafb, ipiv, cmode, & c,info, work, iwork ) @@ -7856,8 +7856,8 @@ module stdlib_linalg_lapack 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. + !! LA_GBRCOND_C Computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a REAL vector. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_gbrcond_c( trans, n, kl, ku, ab, ldab, afb,ldafb, ipiv, c, & capply, info, work,rwork ) @@ -7900,12 +7900,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure real(sp) function cla_gbrpvgrw( n, kl, ku, ncols, ab, ldab, afb,ldafb ) @@ -7961,19 +7961,19 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) import sp,dp,qp,ilp,lk @@ -8031,15 +8031,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(dp) function dla_gercond( trans, n, a, lda, af,ldaf, ipiv, cmode, c,info, & work, iwork ) @@ -8076,8 +8076,8 @@ module stdlib_linalg_lapack 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. + !! LA_GERCOND_C computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a REAL vector. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_gercond_c( trans, n, a, lda, af, ldaf, ipiv, c,capply, info, & work, rwork ) @@ -8120,12 +8120,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure real(sp) function cla_gerpvgrw( n, ncols, a, lda, af, ldaf ) import sp,dp,qp,ilp,lk @@ -8177,18 +8177,18 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cla_heamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) import sp,dp,qp,ilp,lk @@ -8221,8 +8221,8 @@ module stdlib_linalg_lapack 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. + !! LA_HERCOND_C computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a REAL vector. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_hercond_c( uplo, n, a, lda, af, ldaf, ipiv, c,capply, info, & work, rwork ) @@ -8265,12 +8265,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_herpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work ) @@ -8305,11 +8305,11 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cla_lin_berr( n, nz, nrhs, res, ayb, berr ) import sp,dp,qp,ilp,lk @@ -8367,15 +8367,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(dp) function dla_porcond( uplo, n, a, lda, af, ldaf,cmode, c, info, work,& iwork ) @@ -8412,8 +8412,8 @@ module stdlib_linalg_lapack 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 + !! LA_PORCOND_C Computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a REAL vector #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_porcond_c( uplo, n, a, lda, af, ldaf, c, capply,info, work, & rwork ) @@ -8456,12 +8456,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_porpvgrw( uplo, ncols, a, lda, af, ldaf, work ) import sp,dp,qp,ilp,lk @@ -8521,18 +8521,18 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) import sp,dp,qp,ilp,lk @@ -8590,15 +8590,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(dp) function dla_syrcond( uplo, n, a, lda, af, ldaf,ipiv, cmode, c, info, & work,iwork ) @@ -8635,8 +8635,8 @@ module stdlib_linalg_lapack 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. + !! LA_SYRCOND_C Computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a REAL vector. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_syrcond_c( uplo, n, a, lda, af, ldaf, ipiv, c,capply, info, & work, rwork ) @@ -8679,12 +8679,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function cla_syrpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work ) @@ -8748,9 +8748,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cla_wwaddw( n, x, y, w ) import sp,dp,qp,ilp,lk @@ -8806,14 +8806,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlabad( small, large ) import sp,dp,qp,ilp,lk @@ -8840,13 +8840,13 @@ module stdlib_linalg_lapack 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 + !! 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 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) import sp,dp,qp,ilp,lk @@ -8904,7 +8904,7 @@ module stdlib_linalg_lapack interface lacgv - !> LACGV conjugates a complex vector of length N. + !! LACGV conjugates a complex vector of length N. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clacgv( n, x, incx ) import sp,dp,qp,ilp,lk @@ -8933,8 +8933,8 @@ module stdlib_linalg_lapack interface lacon - !> LACON estimates the 1-norm of a square, complex matrix A. - !> Reverse communication is used for evaluating matrix-vector products. + !! LACON estimates the 1-norm of a square, complex matrix A. + !! Reverse communication is used for evaluating matrix-vector products. #ifdef STDLIB_EXTERNAL_LAPACK subroutine clacon( n, v, x, est, kase ) import sp,dp,qp,ilp,lk @@ -8998,8 +8998,8 @@ module stdlib_linalg_lapack interface lacpy - !> LACPY copies all or part of a two-dimensional matrix A to another - !> matrix B. + !! LACPY copies all or part of a two-dimensional matrix A to another + !! matrix B. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clacpy( uplo, m, n, a, lda, b, ldb ) import sp,dp,qp,ilp,lk @@ -9059,10 +9059,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clacrm( m, n, a, lda, b, ldb, c, ldc, rwork ) import sp,dp,qp,ilp,lk @@ -9097,10 +9097,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clacrt( n, cx, incx, cy, incy, c, s ) import sp,dp,qp,ilp,lk @@ -9131,9 +9131,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure complex(sp) function cladiv( x, y ) import sp,dp,qp,ilp,lk @@ -9160,13 +9160,13 @@ module stdlib_linalg_lapack 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" + !! 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" #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dladiv( a, b, c, d, p, q ) import sp,dp,qp,ilp,lk @@ -9251,37 +9251,37 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaebz( ijob, nitmax, n, mmax, minp, nbmin, abstol,reltol, pivmin, & d, e, e2, nval, ab, c, mout,nab, work, iwork, info ) @@ -9320,10 +9320,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claed0( qsiz, n, d, e, q, ldq, qstore, ldqs, rwork,iwork, info ) @@ -9391,32 +9391,32 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaed1( n, d, q, ldq, indxq, rho, cutpnt, work, iwork,info ) @@ -9453,16 +9453,16 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaed4( n, i, d, z, delta, rho, dlam, info ) import sp,dp,qp,ilp,lk @@ -9495,13 +9495,13 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaed5( i, d, z, delta, rho, dlam ) import sp,dp,qp,ilp,lk @@ -9532,17 +9532,17 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaed6( kniter, orgati, rho, d, z, finit, tau, info ) import sp,dp,qp,ilp,lk @@ -9577,30 +9577,30 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -9682,12 +9682,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claed8( k, n, qsiz, q, ldq, d, rho, cutpnt, z, dlamda,q2, ldq2, w, & indxp, indx, indxq, perm, givptr,givcol, givnum, info ) @@ -9763,10 +9763,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaed9( k, kstart, kstop, n, d, q, ldq, rho, dlamda, w,s, lds, & info ) @@ -9803,9 +9803,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaeda( n, tlvls, curlvl, curpbm, prmptr, perm, givptr,givcol, & givnum, q, qptr, z, ztemp, info ) @@ -9842,9 +9842,9 @@ module stdlib_linalg_lapack 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. + !! LAEIN uses inverse iteration to find a right or left eigenvector + !! corresponding to the eigenvalue W of a complex upper Hessenberg + !! matrix H. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claein( rightv, noinit, n, h, ldh, w, v, b, ldb, rwork,eps3, & smlnum, info ) @@ -9920,15 +9920,15 @@ module stdlib_linalg_lapack 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 ] + !! 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 ] #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claesy( a, b, c, rt1, rt2, evscal, cs1, sn1 ) import sp,dp,qp,ilp,lk @@ -9957,13 +9957,13 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dlaexc( wantq, n, t, ldt, q, ldq, j1, n1, n2, work,info ) import sp,dp,qp,ilp,lk @@ -9998,18 +9998,18 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlagtf( n, a, lambda, b, c, tol, d, in, info ) import sp,dp,qp,ilp,lk @@ -10044,11 +10044,11 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) @@ -10114,15 +10114,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlagts( job, n, a, b, c, d, in, y, tol, info ) import sp,dp,qp,ilp,lk @@ -10155,19 +10155,19 @@ module stdlib_linalg_lapack 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'). + !! 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'). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clahef( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) import sp,dp,qp,ilp,lk @@ -10202,16 +10202,16 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clahef_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) import sp,dp,qp,ilp,lk @@ -10246,18 +10246,18 @@ module stdlib_linalg_lapack 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'). + !! 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'). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clahef_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) import sp,dp,qp,ilp,lk @@ -10292,19 +10292,19 @@ module stdlib_linalg_lapack 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'). + !! 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'). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clahef_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) import sp,dp,qp,ilp,lk @@ -10339,10 +10339,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, & info ) @@ -10410,26 +10410,26 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claic1( job, j, x, sest, w, gamma, sestpr, s, c ) import sp,dp,qp,ilp,lk @@ -10489,17 +10489,17 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure logical(lk) function dlaisnan( din1, din2 ) import sp,dp,qp,ilp,lk @@ -10526,26 +10526,26 @@ module stdlib_linalg_lapack 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). + !! 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). #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -10623,15 +10623,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK 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 & @@ -10713,20 +10713,20 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, & rwork, iwork, info ) @@ -10802,9 +10802,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlamrg( n1, n2, a, dtrd1, dtrd2, index ) import sp,dp,qp,ilp,lk @@ -10835,13 +10835,13 @@ module stdlib_linalg_lapack 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) + !! 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) #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, & work, lwork, info ) @@ -10913,13 +10913,13 @@ module stdlib_linalg_lapack 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) + !! 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) #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, & work, lwork, info ) @@ -10991,21 +10991,21 @@ module stdlib_linalg_lapack 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.) + !! 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.) #ifdef STDLIB_EXTERNAL_LAPACK pure integer(ilp) function dlaneg( n, d, lld, sigma, pivmin, r ) import sp,dp,qp,ilp,lk @@ -11034,9 +11034,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clangb( norm, n, kl, ku, ab, ldab,work ) import sp,dp,qp,ilp,lk @@ -11096,9 +11096,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clange( norm, m, n, a, lda, work ) import sp,dp,qp,ilp,lk @@ -11158,9 +11158,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure real(sp) function clangt( norm, n, dl, d, du ) import sp,dp,qp,ilp,lk @@ -11216,9 +11216,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clanhb( norm, uplo, n, k, ab, ldab,work ) import sp,dp,qp,ilp,lk @@ -11251,9 +11251,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clanhe( norm, uplo, n, a, lda, work ) import sp,dp,qp,ilp,lk @@ -11286,9 +11286,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clanhf( norm, transr, uplo, n, a, work ) import sp,dp,qp,ilp,lk @@ -11321,9 +11321,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clanhp( norm, uplo, n, ap, work ) import sp,dp,qp,ilp,lk @@ -11356,9 +11356,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clanhs( norm, n, a, lda, work ) import sp,dp,qp,ilp,lk @@ -11418,9 +11418,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure real(sp) function clanht( norm, n, d, e ) import sp,dp,qp,ilp,lk @@ -11453,9 +11453,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clansb( norm, uplo, n, k, ab, ldab,work ) import sp,dp,qp,ilp,lk @@ -11515,9 +11515,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(dp) function dlansf( norm, transr, uplo, n, a, work ) import sp,dp,qp,ilp,lk @@ -11550,9 +11550,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clansp( norm, uplo, n, ap, work ) import sp,dp,qp,ilp,lk @@ -11612,9 +11612,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure real(dp) function dlanst( norm, n, d, e ) import sp,dp,qp,ilp,lk @@ -11645,9 +11645,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clansy( norm, uplo, n, a, lda, work ) import sp,dp,qp,ilp,lk @@ -11707,9 +11707,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clantb( norm, uplo, diag, n, k, ab,ldab, work ) @@ -11771,9 +11771,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clantp( norm, uplo, diag, n, ap, work ) import sp,dp,qp,ilp,lk @@ -11833,9 +11833,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK real(sp) function clantr( norm, uplo, diag, m, n, a, lda,work ) import sp,dp,qp,ilp,lk @@ -11895,39 +11895,39 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaorhr_col_getrfnp( m, n, a, lda, d, info ) import sp,dp,qp,ilp,lk @@ -11960,54 +11960,54 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure recursive subroutine dlaorhr_col_getrfnp2( m, n, a, lda, d, info ) import sp,dp,qp,ilp,lk @@ -12040,12 +12040,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clapll( n, x, incx, y, incy, ssmin ) import sp,dp,qp,ilp,lk @@ -12101,12 +12101,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clapmr( forwrd, m, n, x, ldx, k ) import sp,dp,qp,ilp,lk @@ -12166,12 +12166,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clapmt( forwrd, m, n, x, ldx, k ) import sp,dp,qp,ilp,lk @@ -12231,9 +12231,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) @@ -12297,8 +12297,8 @@ module stdlib_linalg_lapack interface laqge - !> LAQGE equilibrates a general M by N matrix A using the row and - !> column scaling factors in the vectors R and C. + !! LAQGE equilibrates a general M by N matrix A using the row and + !! column scaling factors in the vectors R and C. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed ) import sp,dp,qp,ilp,lk @@ -12358,8 +12358,8 @@ module stdlib_linalg_lapack interface laqhb - !> LAQHB equilibrates an Hermitian band matrix A using the scaling - !> factors in the vector S. + !! LAQHB equilibrates an Hermitian band matrix A using the scaling + !! factors in the vector S. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqhb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) import sp,dp,qp,ilp,lk @@ -12396,8 +12396,8 @@ module stdlib_linalg_lapack interface laqhe - !> LAQHE equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. + !! LAQHE equilibrates a Hermitian matrix A using the scaling factors + !! in the vector S. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqhe( uplo, n, a, lda, s, scond, amax, equed ) import sp,dp,qp,ilp,lk @@ -12432,8 +12432,8 @@ module stdlib_linalg_lapack interface laqhp - !> LAQHP equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. + !! LAQHP equilibrates a Hermitian matrix A using the scaling factors + !! in the vector S. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqhp( uplo, n, ap, s, scond, amax, equed ) import sp,dp,qp,ilp,lk @@ -12468,14 +12468,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & ldf ) @@ -12545,14 +12545,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, & work, lwork, info ) @@ -12620,12 +12620,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqr1( n, h, ldh, s1, s2, v ) import sp,dp,qp,ilp,lk @@ -12681,20 +12681,20 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqr4( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, & work, lwork, info ) @@ -12762,8 +12762,8 @@ module stdlib_linalg_lapack interface laqr5 - !> LAQR5 called by CLAQR0 performs a - !> single small-bulge multi-shift QR sweep. + !! LAQR5 called by CLAQR0 performs a + !! single small-bulge multi-shift QR sweep. #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -12831,8 +12831,8 @@ module stdlib_linalg_lapack interface laqsb - !> LAQSB equilibrates a symmetric band matrix A using the scaling - !> factors in the vector S. + !! LAQSB equilibrates a symmetric band matrix A using the scaling + !! factors in the vector S. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) import sp,dp,qp,ilp,lk @@ -12896,8 +12896,8 @@ module stdlib_linalg_lapack interface laqsp - !> LAQSP equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. + !! LAQSP equilibrates a symmetric matrix A using the scaling factors + !! in the vector S. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqsp( uplo, n, ap, s, scond, amax, equed ) import sp,dp,qp,ilp,lk @@ -12961,8 +12961,8 @@ module stdlib_linalg_lapack interface laqsy - !> LAQSY equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. + !! LAQSY equilibrates a symmetric matrix A using the scaling factors + !! in the vector S. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqsy( uplo, n, a, lda, s, scond, amax, equed ) import sp,dp,qp,ilp,lk @@ -13026,24 +13026,24 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dlaqtr( ltran, lreal, n, t, ldt, b, w, scale, x, work,info ) import sp,dp,qp,ilp,lk @@ -13080,46 +13080,46 @@ module stdlib_linalg_lapack 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" + !! 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" #ifdef STDLIB_EXTERNAL_LAPACK recursive subroutine claqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, & alpha, beta, q, ldq, z,ldz, work, lwork, rwork, rec,info ) @@ -13189,7 +13189,7 @@ module stdlib_linalg_lapack interface laqz1 - !> LAQZ1 chases a 1x1 shift bulge in a matrix pencil down a single position + !! LAQZ1 chases a 1x1 shift bulge in a matrix pencil down a single position #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqz1( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, & qstart, q, ldq, nz, zstart, z, ldz ) @@ -13249,7 +13249,7 @@ module stdlib_linalg_lapack interface laqz4 - !> LAQZ4 Executes a single multishift QZ sweep + !! LAQZ4 Executes a single multishift QZ sweep #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -13294,21 +13294,21 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc,& negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) @@ -13384,13 +13384,13 @@ module stdlib_linalg_lapack 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) ) + !! 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) ) #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clar2v( n, x, y, z, incx, c, s, incc ) import sp,dp,qp,ilp,lk @@ -13448,10 +13448,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarcm( m, n, a, lda, b, ldb, c, ldc, rwork ) import sp,dp,qp,ilp,lk @@ -13486,14 +13486,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarf( side, m, n, v, incv, tau, c, ldc, work ) import sp,dp,qp,ilp,lk @@ -13557,8 +13557,8 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, & ldc, work, ldwork ) @@ -13626,13 +13626,13 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) @@ -13700,19 +13700,19 @@ module stdlib_linalg_lapack 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 . + !! 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 . #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarfg( n, alpha, x, incx, tau ) import sp,dp,qp,ilp,lk @@ -13768,18 +13768,18 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine clarfgp( n, alpha, x, incx, tau ) import sp,dp,qp,ilp,lk @@ -13835,16 +13835,16 @@ module stdlib_linalg_lapack 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 + !! 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 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarft( direct, storev, n, k, v, ldv, tau, t, ldt ) import sp,dp,qp,ilp,lk @@ -13904,12 +13904,12 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarfy( uplo, n, v, incv, tau, c, ldc, work ) import sp,dp,qp,ilp,lk @@ -13973,16 +13973,16 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clargv( n, x, incx, y, incy, c, incc ) import sp,dp,qp,ilp,lk @@ -14038,8 +14038,8 @@ module stdlib_linalg_lapack interface larnv - !> LARNV returns a vector of n random complex numbers from a uniform or - !> normal distribution. + !! LARNV returns a vector of n random complex numbers from a uniform or + !! normal distribution. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarnv( idist, iseed, n, x ) import sp,dp,qp,ilp,lk @@ -14095,8 +14095,8 @@ module stdlib_linalg_lapack interface larra - !> Compute the splitting points with threshold SPLTOL. - !> LARRA sets any "small" off-diagonal elements to zero. + !! Compute the splitting points with threshold SPLTOL. + !! LARRA sets any "small" off-diagonal elements to zero. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlarra( n, d, e, e2, spltol, tnrm,nsplit, isplit, info ) import sp,dp,qp,ilp,lk @@ -14129,14 +14129,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlarrb( n, d, lld, ifirst, ilast, rtol1,rtol2, offset, w, wgap, & werr, work, iwork,pivmin, spdiam, twist, info ) @@ -14173,9 +14173,9 @@ module stdlib_linalg_lapack 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'. + !! 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlarrc( jobt, n, vl, vu, d, e, pivmin,eigcnt, lcnt, rcnt, info ) @@ -14210,18 +14210,18 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -14260,19 +14260,19 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -14315,11 +14315,11 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlarrf( n, d, l, ld, clstrt, clend,w, wgap, werr,spdiam, clgapl, & clgapr, pivmin, sigma,dplus, lplus, work, info ) @@ -14358,13 +14358,13 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlarrj( n, d, e2, ifirst, ilast,rtol, offset, w, werr, work, iwork,& pivmin, spdiam, info ) @@ -14401,15 +14401,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlarrk( n, iw, gl, gu,d, e2, pivmin, reltol, w, werr, info) import sp,dp,qp,ilp,lk @@ -14442,9 +14442,9 @@ module stdlib_linalg_lapack interface larrr - !> Perform tests to decide whether the symmetric tridiagonal matrix T - !> warrants expensive computations which guarantee high relative accuracy - !> in the eigenvalues. + !! Perform tests to decide whether the symmetric tridiagonal matrix T + !! warrants expensive computations which guarantee high relative accuracy + !! in the eigenvalues. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlarrr( n, d, e, info ) import sp,dp,qp,ilp,lk @@ -14477,9 +14477,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -14557,30 +14557,28 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clartg( f, g, c, s, r ) import sp,dp,qp,ilp,lk @@ -14634,15 +14632,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlartgp( f, g, cs, sn, r ) import sp,dp,qp,ilp,lk @@ -14671,14 +14669,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlartgs( x, y, sigma, cs, sn ) import sp,dp,qp,ilp,lk @@ -14707,10 +14705,10 @@ module stdlib_linalg_lapack 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) ) + !! 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) ) #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clartv( n, x, incx, y, incy, c, s, incc ) import sp,dp,qp,ilp,lk @@ -14768,9 +14766,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaruv( iseed, n, x ) import sp,dp,qp,ilp,lk @@ -14801,15 +14799,15 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarz( side, m, n, l, v, incv, tau, c, ldc, work ) import sp,dp,qp,ilp,lk @@ -14873,9 +14871,9 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & ldc, work, ldwork ) @@ -14939,18 +14937,18 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) import sp,dp,qp,ilp,lk @@ -15014,11 +15012,11 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) import sp,dp,qp,ilp,lk @@ -15082,13 +15080,13 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasd0( n, sqre, d, e, u, ldu, vt, ldvt, smlsiz, iwork,work, info ) @@ -15123,35 +15121,35 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasd1( nl, nr, sqre, d, alpha, beta, u, ldu, vt, ldvt,idxq, iwork,& work, info ) @@ -15188,17 +15186,17 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasd4( n, i, d, z, delta, rho, sigma, work, info ) import sp,dp,qp,ilp,lk @@ -15231,14 +15229,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasd5( i, d, z, delta, rho, dsigma, work ) import sp,dp,qp,ilp,lk @@ -15269,41 +15267,41 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK 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, & @@ -15346,13 +15344,13 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK 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, & @@ -15397,13 +15395,13 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasd8( icompq, k, d, z, vf, vl, difl, difr, lddifr,dsigma, work, & info ) @@ -15438,14 +15436,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK 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 ) @@ -15484,18 +15482,18 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasdq( uplo, sqre, n, ncvt, nru, ncc, d, e, vt, ldvt,u, ldu, c, & ldc, work, info ) @@ -15532,8 +15530,8 @@ module stdlib_linalg_lapack interface laset - !> LASET initializes a 2-D array A to BETA on the diagonal and - !> ALPHA on the offdiagonals. + !! LASET initializes a 2-D array A to BETA on the diagonal and + !! ALPHA on the offdiagonals. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claset( uplo, m, n, alpha, beta, a, lda ) import sp,dp,qp,ilp,lk @@ -15593,16 +15591,16 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasq1( n, d, e, work, info ) import sp,dp,qp,ilp,lk @@ -15635,8 +15633,8 @@ module stdlib_linalg_lapack interface lasq4 - !> LASQ4 computes an approximation TAU to the smallest eigenvalue - !> using values of d from the previous transform. + !! LASQ4 computes an approximation TAU to the smallest eigenvalue + !! using values of d from the previous transform. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasq4( i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn,dn1, dn2, tau, & ttype, g ) @@ -15673,8 +15671,8 @@ module stdlib_linalg_lapack interface lasq5 - !> LASQ5 computes one dqds transform in ping-pong form, one - !> version for IEEE machines another for non IEEE machines. + !! LASQ5 computes one dqds transform in ping-pong form, one + !! version for IEEE machines another for non IEEE machines. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasq5( i0, n0, z, pp, tau, sigma, dmin, dmin1, dmin2,dn, dnm1, & dnm2, ieee, eps ) @@ -15711,8 +15709,8 @@ module stdlib_linalg_lapack interface lasq6 - !> LASQ6 computes one dqd (shift equal to zero) transform in - !> ping-pong form, with protection against underflow and overflow. + !! LASQ6 computes one dqd (shift equal to zero) transform in + !! ping-pong form, with protection against underflow and overflow. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasq6( i0, n0, z, pp, dmin, dmin1, dmin2, dn,dnm1, dnm2 ) import sp,dp,qp,ilp,lk @@ -15743,57 +15741,57 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clasr( side, pivot, direct, m, n, c, s, a, lda ) import sp,dp,qp,ilp,lk @@ -15853,10 +15851,10 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasrt( id, n, d, info ) import sp,dp,qp,ilp,lk @@ -15889,26 +15887,24 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine classq( n, x, incx, scl, sumsq ) import sp,dp,qp,ilp,lk @@ -15964,16 +15960,16 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) import sp,dp,qp,ilp,lk @@ -16033,8 +16029,8 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claswp( n, a, lda, k1, k2, ipiv, incx ) import sp,dp,qp,ilp,lk @@ -16086,19 +16082,19 @@ module stdlib_linalg_lapack 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'). + !! 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'). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) import sp,dp,qp,ilp,lk @@ -16162,16 +16158,16 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) import sp,dp,qp,ilp,lk @@ -16235,18 +16231,18 @@ module stdlib_linalg_lapack 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'). + !! 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'). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) import sp,dp,qp,ilp,lk @@ -16310,18 +16306,18 @@ module stdlib_linalg_lapack 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'). + !! 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'). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) import sp,dp,qp,ilp,lk @@ -16385,16 +16381,16 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm,& info ) @@ -16468,14 +16464,14 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) import sp,dp,qp,ilp,lk @@ -16529,17 +16525,17 @@ module stdlib_linalg_lapack 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. + !! 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) @@ -16613,15 +16609,15 @@ module stdlib_linalg_lapack interface latrd - !> LATRD reduces NB rows and columns of a complex Hermitian matrix A to - !> Hermitian tridiagonal form by a unitary similarity - !> transformation Q**H * A * Q, and returns the matrices V and W which are - !> needed to apply the transformation to the unreduced part of A. - !> If UPLO = 'U', LATRD reduces the last NB rows and columns of a - !> matrix, of which the upper triangle is supplied; - !> if UPLO = 'L', LATRD reduces the first NB rows and columns of a - !> matrix, of which the lower triangle is supplied. - !> This is an auxiliary routine called by CHETRD. + !! LATRD reduces NB rows and columns of a complex Hermitian matrix A to + !! Hermitian tridiagonal form by a unitary similarity + !! transformation Q**H * A * Q, and returns the matrices V and W which are + !! needed to apply the transformation to the unreduced part of A. + !! If UPLO = 'U', LATRD reduces the last NB rows and columns of a + !! matrix, of which the upper triangle is supplied; + !! if UPLO = 'L', LATRD reduces the first NB rows and columns of a + !! matrix, of which the lower triangle is supplied. + !! This is an auxiliary routine called by CHETRD. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) import sp,dp,qp,ilp,lk @@ -16683,16 +16679,16 @@ module stdlib_linalg_lapack interface latrs - !> LATRS 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. Here A is an upper or lower - !> triangular matrix, 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 - !> CTRSV 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. + !! LATRS 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. Here A is an upper or lower + !! triangular matrix, 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 + !! CTRSV 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info & ) @@ -16766,10 +16762,10 @@ module stdlib_linalg_lapack interface latrz - !> LATRZ factors the M-by-(M+L) complex upper trapezoidal matrix - !> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z by means - !> of unitary transformations, where Z is an (M+L)-by-(M+L) unitary - !> matrix and, R and A1 are M-by-M upper triangular matrices. + !! LATRZ factors the M-by-(M+L) complex upper trapezoidal matrix + !! [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z by means + !! of unitary transformations, where Z is an (M+L)-by-(M+L) unitary + !! matrix and, R and A1 are M-by-M upper triangular matrices. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatrz( m, n, l, a, lda, tau, work ) import sp,dp,qp,ilp,lk @@ -16825,17 +16821,17 @@ module stdlib_linalg_lapack interface latsqr - !> LATSQR computes a blocked Tall-Skinny QR factorization of - !> a complex M-by-N matrix A for M >= N: - !> A = Q * ( R ), - !> ( 0 ) - !> where: - !> Q is a M-by-M orthogonal matrix, stored on exit in an implicit - !> form in the elements below the diagonal of the array A and in - !> the elements of the array T; - !> R is an upper-triangular N-by-N matrix, stored on exit in - !> the elements on and above the diagonal of the array A. - !> 0 is a (M-N)-by-N zero matrix, and is not stored. + !! LATSQR computes a blocked Tall-Skinny QR factorization of + !! a complex M-by-N matrix A for M >= N: + !! A = Q * ( R ), + !! ( 0 ) + !! where: + !! Q is a M-by-M orthogonal matrix, stored on exit in an implicit + !! form in the elements below the diagonal of the array A and in + !! the elements of the array T; + !! R is an upper-triangular N-by-N matrix, stored on exit in + !! the elements on and above the diagonal of the array A. + !! 0 is a (M-N)-by-N zero matrix, and is not stored. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) import sp,dp,qp,ilp,lk @@ -16895,39 +16891,39 @@ module stdlib_linalg_lapack interface launhr_col_getrfnp - !> LAUNHR_COL_GETRFNP computes the modified LU factorization without - !> pivoting of a complex 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 CUNHR_COL. In CUNHR_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 LAUNHR_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. + !! LAUNHR_COL_GETRFNP computes the modified LU factorization without + !! pivoting of a complex 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 CUNHR_COL. In CUNHR_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 LAUNHR_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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claunhr_col_getrfnp( m, n, a, lda, d, info ) import sp,dp,qp,ilp,lk @@ -16960,54 +16956,54 @@ module stdlib_linalg_lapack interface launhr_col_getrfnp2 - !> LAUNHR_COL_GETRFNP2 computes the modified LU factorization without - !> pivoting of a complex 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 CUNHR_COL. In CUNHR_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]. - !> LAUNHR_COL_GETRFNP2 is called to factorize a block by the blocked - !> routine CLAUNHR_COL_GETRFNP, which uses blocked code calling - !> Level 3 BLAS to update the submatrix. However, LAUNHR_COL_GETRFNP2 - !> is self-sufficient and can be used without CLAUNHR_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. + !! LAUNHR_COL_GETRFNP2 computes the modified LU factorization without + !! pivoting of a complex 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 CUNHR_COL. In CUNHR_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]. + !! LAUNHR_COL_GETRFNP2 is called to factorize a block by the blocked + !! routine CLAUNHR_COL_GETRFNP, which uses blocked code calling + !! Level 3 BLAS to update the submatrix. However, LAUNHR_COL_GETRFNP2 + !! is self-sufficient and can be used without CLAUNHR_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. #ifdef STDLIB_EXTERNAL_LAPACK pure recursive subroutine claunhr_col_getrfnp2( m, n, a, lda, d, info ) import sp,dp,qp,ilp,lk @@ -17040,14 +17036,14 @@ module stdlib_linalg_lapack interface lauum - !> LAUUM computes the product U * U**H or L**H * L, where the triangular - !> factor U or L is stored in the upper or lower triangular part of - !> the array A. - !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, - !> overwriting the factor U in A. - !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, - !> overwriting the factor L in A. - !> This is the blocked form of the algorithm, calling Level 3 BLAS. + !! LAUUM computes the product U * U**H or L**H * L, where the triangular + !! factor U or L is stored in the upper or lower triangular part of + !! the array A. + !! If UPLO = 'U' or 'u' then the upper triangle of the result is stored, + !! overwriting the factor U in A. + !! If UPLO = 'L' or 'l' then the lower triangle of the result is stored, + !! overwriting the factor L in A. + !! This is the blocked form of the algorithm, calling Level 3 BLAS. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clauum( uplo, n, a, lda, info ) import sp,dp,qp,ilp,lk @@ -17107,11 +17103,11 @@ module stdlib_linalg_lapack interface opgtr - !> OPGTR generates a real orthogonal matrix Q which is defined as the - !> product of n-1 elementary reflectors H(i) of order n, as returned by - !> DSPTRD using packed storage: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! OPGTR generates a real orthogonal matrix Q which is defined as the + !! product of n-1 elementary reflectors H(i) of order n, as returned by + !! DSPTRD using packed storage: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dopgtr( uplo, n, ap, tau, q, ldq, work, info ) import sp,dp,qp,ilp,lk @@ -17146,16 +17142,16 @@ module stdlib_linalg_lapack interface opmtr - !> OPMTR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by DSPTRD using packed - !> storage: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! OPMTR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by DSPTRD using packed + !! storage: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dopmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) @@ -17194,22 +17190,22 @@ module stdlib_linalg_lapack interface orbdb - !> ORBDB simultaneously bidiagonalizes the blocks of an M-by-M - !> partitioned orthogonal matrix X: - !> [ B11 | B12 0 0 ] - !> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**T - !> X = [-----------] = [---------] [----------------] [---------] . - !> [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] - !> [ 0 | 0 0 I ] - !> X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is - !> not the case, then X must be transposed and/or permuted. This can be - !> done in constant time using the TRANS and SIGNS options. See DORCSD - !> for details.) - !> The orthogonal matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- - !> (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are - !> represented implicitly by Householder vectors. - !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! ORBDB simultaneously bidiagonalizes the blocks of an M-by-M + !! partitioned orthogonal matrix X: + !! [ B11 | B12 0 0 ] + !! [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**T + !! X = [-----------] = [---------] [----------------] [---------] . + !! [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] + !! [ 0 | 0 0 I ] + !! X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is + !! not the case, then X must be transposed and/or permuted. This can be + !! done in constant time using the TRANS and SIGNS options. See DORCSD + !! for details.) + !! The orthogonal matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- + !! (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are + !! represented implicitly by Householder vectors. + !! B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented + !! implicitly by angles THETA, PHI. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) @@ -17250,21 +17246,21 @@ module stdlib_linalg_lapack interface orbdb1 - !> ORBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, - !> M-P, or M-Q. Routines DORBDB2, DORBDB3, and DORBDB4 handle cases in - !> which Q is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! ORBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, + !! M-P, or M-Q. Routines DORBDB2, DORBDB3, and DORBDB4 handle cases in + !! which Q is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by + !! angles THETA, PHI. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -17301,21 +17297,21 @@ module stdlib_linalg_lapack interface orbdb2 - !> ORBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, - !> Q, or M-Q. Routines DORBDB1, DORBDB3, and DORBDB4 handle cases in - !> which P is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! ORBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, + !! Q, or M-Q. Routines DORBDB1, DORBDB3, and DORBDB4 handle cases in + !! which P is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are P-by-P bidiagonal matrices represented implicitly by + !! angles THETA, PHI. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -17352,21 +17348,21 @@ module stdlib_linalg_lapack interface orbdb3 - !> ORBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, - !> Q, or M-Q. Routines DORBDB1, DORBDB2, and DORBDB4 handle cases in - !> which M-P is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! ORBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, + !! Q, or M-Q. Routines DORBDB1, DORBDB2, and DORBDB4 handle cases in + !! which M-P is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -17403,21 +17399,21 @@ module stdlib_linalg_lapack interface orbdb4 - !> ORBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, - !> M-P, or Q. Routines DORBDB1, DORBDB2, and DORBDB3 handle cases in - !> which M-Q is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! ORBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, + !! M-P, or Q. Routines DORBDB1, DORBDB2, and DORBDB3 handle cases in + !! which M-Q is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, phantom, work, lwork,info ) @@ -17454,17 +17450,17 @@ module stdlib_linalg_lapack interface orbdb5 - !> ORBDB5 orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then some other vector from the orthogonal complement - !> is returned. This vector is chosen in an arbitrary but deterministic - !> way. + !! ORBDB5 orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then some other vector from the orthogonal complement + !! is returned. This vector is chosen in an arbitrary but deterministic + !! way. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) @@ -17501,15 +17497,15 @@ module stdlib_linalg_lapack interface orbdb6 - !> ORBDB6 orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then the zero vector is returned. + !! ORBDB6 orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then the zero vector is returned. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) @@ -17546,19 +17542,19 @@ module stdlib_linalg_lapack interface orcsd - !> ORCSD computes the CS decomposition of an M-by-M partitioned - !> orthogonal matrix X: - !> [ I 0 0 | 0 0 0 ] - !> [ 0 C 0 | 0 -S 0 ] - !> [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**T - !> X = [-----------] = [---------] [---------------------] [---------] . - !> [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] - !> [ 0 S 0 | 0 C 0 ] - !> [ 0 0 I | 0 0 0 ] - !> X11 is P-by-Q. The orthogonal matrices U1, U2, V1, and V2 are P-by-P, - !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are - !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in - !> which R = MIN(P,M-P,Q,M-Q). + !! ORCSD computes the CS decomposition of an M-by-M partitioned + !! orthogonal matrix X: + !! [ I 0 0 | 0 0 0 ] + !! [ 0 C 0 | 0 -S 0 ] + !! [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**T + !! X = [-----------] = [---------] [---------------------] [---------] . + !! [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] + !! [ 0 S 0 | 0 C 0 ] + !! [ 0 0 I | 0 0 0 ] + !! X11 is P-by-Q. The orthogonal matrices U1, U2, V1, and V2 are P-by-P, + !! (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are + !! R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in + !! which R = MIN(P,M-P,Q,M-Q). #ifdef STDLIB_EXTERNAL_LAPACK recursive subroutine dorcsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, & x11, ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, & @@ -17603,21 +17599,21 @@ module stdlib_linalg_lapack interface orcsd2by1 - !> ORCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with - !> orthonormal columns that has been partitioned into a 2-by-1 block - !> structure: - !> [ I1 0 0 ] - !> [ 0 C 0 ] - !> [ X11 ] [ U1 | ] [ 0 0 0 ] - !> X = [-----] = [---------] [----------] V1**T . - !> [ X21 ] [ | U2 ] [ 0 0 0 ] - !> [ 0 S 0 ] - !> [ 0 0 I2] - !> X11 is P-by-Q. The orthogonal matrices U1, U2, and V1 are P-by-P, - !> (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R - !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which - !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a - !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). + !! ORCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with + !! orthonormal columns that has been partitioned into a 2-by-1 block + !! structure: + !! [ I1 0 0 ] + !! [ 0 C 0 ] + !! [ X11 ] [ U1 | ] [ 0 0 0 ] + !! X = [-----] = [---------] [----------] V1**T . + !! [ X21 ] [ | U2 ] [ 0 0 0 ] + !! [ 0 S 0 ] + !! [ 0 0 I2] + !! X11 is P-by-Q. The orthogonal matrices U1, U2, and V1 are P-by-P, + !! (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R + !! nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which + !! R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a + !! K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorcsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta,& u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, iwork, info ) @@ -17656,11 +17652,11 @@ module stdlib_linalg_lapack interface org2l - !> ORG2L generates an m by n real matrix Q with orthonormal columns, - !> which is defined as the last n columns of a product of k elementary - !> reflectors of order m - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGEQLF. + !! ORG2L generates an m by n real matrix Q with orthonormal columns, + !! which is defined as the last n columns of a product of k elementary + !! reflectors of order m + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGEQLF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorg2l( m, n, k, a, lda, tau, work, info ) import sp,dp,qp,ilp,lk @@ -17695,11 +17691,11 @@ module stdlib_linalg_lapack interface org2r - !> ORG2R generates an m by n real matrix Q with orthonormal columns, - !> which is defined as the first n columns of a product of k elementary - !> reflectors of order m - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGEQRF. + !! ORG2R generates an m by n real matrix Q with orthonormal columns, + !! which is defined as the first n columns of a product of k elementary + !! reflectors of order m + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGEQRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorg2r( m, n, k, a, lda, tau, work, info ) import sp,dp,qp,ilp,lk @@ -17734,22 +17730,22 @@ module stdlib_linalg_lapack interface orgbr - !> ORGBR generates one of the real orthogonal matrices Q or P**T - !> determined by DGEBRD when reducing a real matrix A to bidiagonal - !> form: A = Q * B * P**T. Q and P**T are defined as products of - !> elementary reflectors H(i) or G(i) respectively. - !> If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q - !> is of order M: - !> if m >= k, Q = H(1) H(2) . . . H(k) and ORGBR returns the first n - !> columns of Q, where m >= n >= k; - !> if m < k, Q = H(1) H(2) . . . H(m-1) and ORGBR returns Q as an - !> M-by-M matrix. - !> If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T - !> is of order N: - !> if k < n, P**T = G(k) . . . G(2) G(1) and ORGBR returns the first m - !> rows of P**T, where n >= m >= k; - !> if k >= n, P**T = G(n-1) . . . G(2) G(1) and ORGBR returns P**T as - !> an N-by-N matrix. + !! ORGBR generates one of the real orthogonal matrices Q or P**T + !! determined by DGEBRD when reducing a real matrix A to bidiagonal + !! form: A = Q * B * P**T. Q and P**T are defined as products of + !! elementary reflectors H(i) or G(i) respectively. + !! If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q + !! is of order M: + !! if m >= k, Q = H(1) H(2) . . . H(k) and ORGBR returns the first n + !! columns of Q, where m >= n >= k; + !! if m < k, Q = H(1) H(2) . . . H(m-1) and ORGBR returns Q as an + !! M-by-M matrix. + !! If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T + !! is of order N: + !! if k < n, P**T = G(k) . . . G(2) G(1) and ORGBR returns the first m + !! rows of P**T, where n >= m >= k; + !! if k >= n, P**T = G(n-1) . . . G(2) G(1) and ORGBR returns P**T as + !! an N-by-N matrix. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorgbr( vect, m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -17786,10 +17782,10 @@ module stdlib_linalg_lapack interface orghr - !> ORGHR generates a real orthogonal matrix Q which is defined as the - !> product of IHI-ILO elementary reflectors of order N, as returned by - !> DGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! ORGHR generates a real orthogonal matrix Q which is defined as the + !! product of IHI-ILO elementary reflectors of order N, as returned by + !! DGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -17824,11 +17820,11 @@ module stdlib_linalg_lapack interface orglq - !> ORGLQ generates an M-by-N real matrix Q with orthonormal rows, - !> which is defined as the first M rows of a product of K elementary - !> reflectors of order N - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGELQF. + !! ORGLQ generates an M-by-N real matrix Q with orthonormal rows, + !! which is defined as the first M rows of a product of K elementary + !! reflectors of order N + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGELQF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorglq( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -17863,11 +17859,11 @@ module stdlib_linalg_lapack interface orgql - !> ORGQL generates an M-by-N real matrix Q with orthonormal columns, - !> which is defined as the last N columns of a product of K elementary - !> reflectors of order M - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGEQLF. + !! ORGQL generates an M-by-N real matrix Q with orthonormal columns, + !! which is defined as the last N columns of a product of K elementary + !! reflectors of order M + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGEQLF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorgql( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -17902,11 +17898,11 @@ module stdlib_linalg_lapack interface orgqr - !> ORGQR generates an M-by-N real matrix Q with orthonormal columns, - !> which is defined as the first N columns of a product of K elementary - !> reflectors of order M - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGEQRF. + !! ORGQR generates an M-by-N real matrix Q with orthonormal columns, + !! which is defined as the first N columns of a product of K elementary + !! reflectors of order M + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGEQRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorgqr( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -17941,11 +17937,11 @@ module stdlib_linalg_lapack interface orgrq - !> ORGRQ generates an M-by-N real matrix Q with orthonormal rows, - !> which is defined as the last M rows of a product of K elementary - !> reflectors of order N - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGERQF. + !! ORGRQ generates an M-by-N real matrix Q with orthonormal rows, + !! which is defined as the last M rows of a product of K elementary + !! reflectors of order N + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGERQF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorgrq( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -17980,11 +17976,11 @@ module stdlib_linalg_lapack interface orgtr - !> ORGTR generates a real orthogonal matrix Q which is defined as the - !> product of n-1 elementary reflectors of order N, as returned by - !> DSYTRD: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! ORGTR generates a real orthogonal matrix Q which is defined as the + !! product of n-1 elementary reflectors of order N, as returned by + !! DSYTRD: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorgtr( uplo, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -18021,11 +18017,11 @@ module stdlib_linalg_lapack interface orgtsqr - !> ORGTSQR generates an M-by-N real matrix Q_out with orthonormal columns, - !> which are the first N columns of a product of real orthogonal - !> matrices of order M which are returned by DLATSQR - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> See the documentation for DLATSQR. + !! ORGTSQR generates an M-by-N real matrix Q_out with orthonormal columns, + !! which are the first N columns of a product of real orthogonal + !! matrices of order M which are returned by DLATSQR + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! See the documentation for DLATSQR. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorgtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -18060,21 +18056,21 @@ module stdlib_linalg_lapack interface orgtsqr_row - !> ORGTSQR_ROW generates an M-by-N real matrix Q_out with - !> orthonormal columns from the output of DLATSQR. These N orthonormal - !> columns are the first N columns of a product of complex unitary - !> matrices Q(k)_in of order M, which are returned by DLATSQR in - !> a special format. - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> The input matrices Q(k)_in are stored in row and column blocks in A. - !> See the documentation of DLATSQR for more details on the format of - !> Q(k)_in, where each Q(k)_in is represented by block Householder - !> transformations. This routine calls an auxiliary routine DLARFB_GETT, - !> where the computation is performed on each individual block. The - !> algorithm first sweeps NB-sized column blocks from the right to left - !> starting in the bottom row block and continues to the top row block - !> (hence _ROW in the routine name). This sweep is in reverse order of - !> the order in which DLATSQR generates the output blocks. + !! ORGTSQR_ROW generates an M-by-N real matrix Q_out with + !! orthonormal columns from the output of DLATSQR. These N orthonormal + !! columns are the first N columns of a product of complex unitary + !! matrices Q(k)_in of order M, which are returned by DLATSQR in + !! a special format. + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! The input matrices Q(k)_in are stored in row and column blocks in A. + !! See the documentation of DLATSQR for more details on the format of + !! Q(k)_in, where each Q(k)_in is represented by block Householder + !! transformations. This routine calls an auxiliary routine DLARFB_GETT, + !! where the computation is performed on each individual block. The + !! algorithm first sweeps NB-sized column blocks from the right to left + !! starting in the bottom row block and continues to the top row block + !! (hence _ROW in the routine name). This sweep is in reverse order of + !! the order in which DLATSQR generates the output blocks. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorgtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) @@ -18111,15 +18107,15 @@ module stdlib_linalg_lapack interface orhr_col - !> ORHR_COL takes an M-by-N real matrix Q_in with orthonormal columns - !> as input, stored in A, and performs Householder Reconstruction (HR), - !> i.e. reconstructs Householder vectors V(i) implicitly representing - !> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, - !> where S is an N-by-N diagonal matrix with diagonal entries - !> equal to +1 or -1. The Householder vectors (columns V(i) of V) are - !> stored in A on output, and the diagonal entries of S are stored in D. - !> Block reflectors are also returned in T - !> (same output format as DGEQRT). + !! ORHR_COL takes an M-by-N real matrix Q_in with orthonormal columns + !! as input, stored in A, and performs Householder Reconstruction (HR), + !! i.e. reconstructs Householder vectors V(i) implicitly representing + !! another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, + !! where S is an N-by-N diagonal matrix with diagonal entries + !! equal to +1 or -1. The Householder vectors (columns V(i) of V) are + !! stored in A on output, and the diagonal entries of S are stored in D. + !! Block reflectors are also returned in T + !! (same output format as DGEQRT). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorhr_col( m, n, nb, a, lda, t, ldt, d, info ) import sp,dp,qp,ilp,lk @@ -18152,16 +18148,16 @@ module stdlib_linalg_lapack interface orm2l - !> ORM2L overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T * C if SIDE = 'L' and TRANS = 'T', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'T', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGEQLF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! ORM2L overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T * C if SIDE = 'L' and TRANS = 'T', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'T', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGEQLF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) @@ -18200,16 +18196,16 @@ module stdlib_linalg_lapack interface orm2r - !> ORM2R overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T* C if SIDE = 'L' and TRANS = 'T', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'T', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! ORM2R overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T* C if SIDE = 'L' and TRANS = 'T', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'T', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) @@ -18248,28 +18244,28 @@ module stdlib_linalg_lapack interface ormbr - !> If VECT = 'Q', ORMBR: overwrites the general real M-by-N matrix C - !> with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> If VECT = 'P', ORMBR overwrites the general real M-by-N matrix C - !> with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': P * C C * P - !> TRANS = 'T': P**T * C C * P**T - !> Here Q and P**T are the orthogonal matrices determined by DGEBRD when - !> reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and - !> P**T are defined as products of elementary reflectors H(i) and G(i) - !> respectively. - !> Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the - !> order of the orthogonal matrix Q or P**T that is applied. - !> If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: - !> if nq >= k, Q = H(1) H(2) . . . H(k); - !> if nq < k, Q = H(1) H(2) . . . H(nq-1). - !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: - !> if k < nq, P = G(1) G(2) . . . G(k); - !> if k >= nq, P = G(1) G(2) . . . G(nq-1). + !! If VECT = 'Q', ORMBR: overwrites the general real M-by-N matrix C + !! with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! If VECT = 'P', ORMBR overwrites the general real M-by-N matrix C + !! with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': P * C C * P + !! TRANS = 'T': P**T * C C * P**T + !! Here Q and P**T are the orthogonal matrices determined by DGEBRD when + !! reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and + !! P**T are defined as products of elementary reflectors H(i) and G(i) + !! respectively. + !! Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the + !! order of the orthogonal matrix Q or P**T that is applied. + !! If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: + !! if nq >= k, Q = H(1) H(2) . . . H(k); + !! if nq < k, Q = H(1) H(2) . . . H(nq-1). + !! If VECT = 'P', A is assumed to have been a K-by-NQ matrix: + !! if k < nq, P = G(1) G(2) . . . G(k); + !! if k >= nq, P = G(1) G(2) . . . G(nq-1). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, & lwork, info ) @@ -18308,14 +18304,14 @@ module stdlib_linalg_lapack interface ormhr - !> ORMHR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> IHI-ILO elementary reflectors, as returned by DGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! ORMHR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! IHI-ILO elementary reflectors, as returned by DGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, & lwork, info ) @@ -18354,15 +18350,15 @@ module stdlib_linalg_lapack interface ormlq - !> ORMLQ overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! ORMLQ overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18401,15 +18397,15 @@ module stdlib_linalg_lapack interface ormql - !> ORMQL overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! ORMQL overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18448,15 +18444,15 @@ module stdlib_linalg_lapack interface ormqr - !> ORMQR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! ORMQR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18495,15 +18491,15 @@ module stdlib_linalg_lapack interface ormrq - !> ORMRQ overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGERQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! ORMRQ overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGERQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18542,15 +18538,15 @@ module stdlib_linalg_lapack interface ormrz - !> ORMRZ overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DTZRZF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! ORMRZ overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DTZRZF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18589,15 +18585,15 @@ module stdlib_linalg_lapack interface ormtr - !> ORMTR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by DSYTRD: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! ORMTR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by DSYTRD: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18636,12 +18632,12 @@ module stdlib_linalg_lapack interface pbcon - !> PBCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite band matrix using - !> the Cholesky factorization A = U**H*U or A = L*L**H computed by - !> CPBTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! PBCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite band matrix using + !! the Cholesky factorization A = U**H*U or A = L*L**H computed by + !! CPBTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,rwork, info ) @@ -18713,14 +18709,14 @@ module stdlib_linalg_lapack interface pbequ - !> PBEQU computes row and column scalings intended to equilibrate a - !> Hermitian positive definite band matrix A and reduce its condition - !> number (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. + !! PBEQU computes row and column scalings intended to equilibrate a + !! Hermitian positive definite band matrix A and reduce its condition + !! number (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) import sp,dp,qp,ilp,lk @@ -18784,10 +18780,10 @@ module stdlib_linalg_lapack interface pbrfs - !> PBRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite - !> and banded, and provides error bounds and backward error estimates - !> for the solution. + !! PBRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite + !! and banded, and provides error bounds and backward error estimates + !! for the solution. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, & ferr, berr, work, rwork, info ) @@ -18861,15 +18857,15 @@ module stdlib_linalg_lapack interface pbstf - !> PBSTF computes a split Cholesky factorization of a complex - !> Hermitian positive definite band matrix A. - !> This routine is designed to be used in conjunction with CHBGST. - !> The factorization has the form A = S**H*S where S is a band matrix - !> of the same bandwidth as A and the following structure: - !> S = ( U ) - !> ( M L ) - !> where U is upper triangular of order m = (n+kd)/2, and L is lower - !> triangular of order n-m. + !! PBSTF computes a split Cholesky factorization of a complex + !! Hermitian positive definite band matrix A. + !! This routine is designed to be used in conjunction with CHBGST. + !! The factorization has the form A = S**H*S where S is a band matrix + !! of the same bandwidth as A and the following structure: + !! S = ( U ) + !! ( M L ) + !! where U is upper triangular of order m = (n+kd)/2, and L is lower + !! triangular of order n-m. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbstf( uplo, n, kd, ab, ldab, info ) import sp,dp,qp,ilp,lk @@ -18929,17 +18925,17 @@ module stdlib_linalg_lapack interface pbsv - !> PBSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite band matrix and X - !> and B are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular band matrix, and L is a lower - !> triangular band matrix, with the same number of superdiagonals or - !> subdiagonals as A. The factored form of A is then used to solve the - !> system of equations A * X = B. + !! PBSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite band matrix and X + !! and B are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular band matrix, and L is a lower + !! triangular band matrix, with the same number of superdiagonals or + !! subdiagonals as A. The factored form of A is then used to solve the + !! system of equations A * X = B. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -18999,12 +18995,12 @@ module stdlib_linalg_lapack interface pbtrf - !> PBTRF computes the Cholesky factorization of a complex Hermitian - !> positive definite band matrix A. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. + !! PBTRF computes the Cholesky factorization of a complex Hermitian + !! positive definite band matrix A. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbtrf( uplo, n, kd, ab, ldab, info ) import sp,dp,qp,ilp,lk @@ -19064,9 +19060,9 @@ module stdlib_linalg_lapack interface pbtrs - !> PBTRS solves a system of linear equations A*X = B with a Hermitian - !> positive definite band matrix A using the Cholesky factorization - !> A = U**H*U or A = L*L**H computed by CPBTRF. + !! PBTRS solves a system of linear equations A*X = B with a Hermitian + !! positive definite band matrix A using the Cholesky factorization + !! A = U**H*U or A = L*L**H computed by CPBTRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -19130,13 +19126,13 @@ module stdlib_linalg_lapack interface pftrf - !> PFTRF computes the Cholesky factorization of a complex Hermitian - !> positive definite matrix A. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the block version of the algorithm, calling Level 3 BLAS. + !! PFTRF computes the Cholesky factorization of a complex Hermitian + !! positive definite matrix A. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the block version of the algorithm, calling Level 3 BLAS. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpftrf( transr, uplo, n, a, info ) import sp,dp,qp,ilp,lk @@ -19196,9 +19192,9 @@ module stdlib_linalg_lapack interface pftri - !> PFTRI computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by CPFTRF. + !! PFTRI computes the inverse of a complex Hermitian positive definite + !! matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !! computed by CPFTRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpftri( transr, uplo, n, a, info ) import sp,dp,qp,ilp,lk @@ -19258,9 +19254,9 @@ module stdlib_linalg_lapack interface pftrs - !> PFTRS solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A using the Cholesky factorization - !> A = U**H*U or A = L*L**H computed by CPFTRF. + !! PFTRS solves a system of linear equations A*X = B with a Hermitian + !! positive definite matrix A using the Cholesky factorization + !! A = U**H*U or A = L*L**H computed by CPFTRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpftrs( transr, uplo, n, nrhs, a, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -19324,11 +19320,11 @@ module stdlib_linalg_lapack interface pocon - !> POCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite matrix using the - !> Cholesky factorization A = U**H*U or A = L*L**H computed by CPOTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! POCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite matrix using the + !! Cholesky factorization A = U**H*U or A = L*L**H computed by CPOTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpocon( uplo, n, a, lda, anorm, rcond, work, rwork,info ) import sp,dp,qp,ilp,lk @@ -19398,14 +19394,14 @@ module stdlib_linalg_lapack interface poequ - !> POEQU computes row and column scalings intended to equilibrate a - !> Hermitian positive definite matrix A and reduce its condition number - !> (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. + !! POEQU computes row and column scalings intended to equilibrate a + !! Hermitian positive definite matrix A and reduce its condition number + !! (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpoequ( n, a, lda, s, scond, amax, info ) import sp,dp,qp,ilp,lk @@ -19465,19 +19461,19 @@ module stdlib_linalg_lapack interface poequb - !> POEQUB computes row and column scalings intended to equilibrate a - !> Hermitian positive definite matrix A and reduce its condition number - !> (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. - !> This routine differs from CPOEQU 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 diagonal entries are no longer approximately 1 but lie - !> between sqrt(radix) and 1/sqrt(radix). + !! POEQUB computes row and column scalings intended to equilibrate a + !! Hermitian positive definite matrix A and reduce its condition number + !! (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. + !! This routine differs from CPOEQU 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 diagonal entries are no longer approximately 1 but lie + !! between sqrt(radix) and 1/sqrt(radix). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpoequb( n, a, lda, s, scond, amax, info ) import sp,dp,qp,ilp,lk @@ -19537,10 +19533,10 @@ module stdlib_linalg_lapack interface porfs - !> PORFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite, - !> and provides error bounds and backward error estimates for the - !> solution. + !! PORFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite, + !! and provides error bounds and backward error estimates for the + !! solution. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr,& work, rwork, info ) @@ -19614,16 +19610,16 @@ module stdlib_linalg_lapack interface posv - !> POSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**H* U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is a lower triangular - !> matrix. The factored form of A is then used to solve the system of - !> equations A * X = B. + !! POSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**H* U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is a lower triangular + !! matrix. The factored form of A is then used to solve the system of + !! equations A * X = B. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cposv( uplo, n, nrhs, a, lda, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -19683,13 +19679,13 @@ module stdlib_linalg_lapack interface potrf - !> POTRF computes the Cholesky factorization of a complex Hermitian - !> positive definite matrix A. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the block version of the algorithm, calling Level 3 BLAS. + !! POTRF computes the Cholesky factorization of a complex Hermitian + !! positive definite matrix A. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the block version of the algorithm, calling Level 3 BLAS. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpotrf( uplo, n, a, lda, info ) import sp,dp,qp,ilp,lk @@ -19749,19 +19745,19 @@ module stdlib_linalg_lapack interface potrf2 - !> POTRF2 computes the Cholesky factorization of a Hermitian - !> positive definite matrix A using the recursive algorithm. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> 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 = n/2 - !> [ A21 | A22 ] n2 = n-n1 - !> The subroutine calls itself to factor A11. Update and scale A21 - !> or A12, update A22 then calls itself to factor A22. + !! POTRF2 computes the Cholesky factorization of a Hermitian + !! positive definite matrix A using the recursive algorithm. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! 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 = n/2 + !! [ A21 | A22 ] n2 = n-n1 + !! The subroutine calls itself to factor A11. Update and scale A21 + !! or A12, update A22 then calls itself to factor A22. #ifdef STDLIB_EXTERNAL_LAPACK pure recursive subroutine cpotrf2( uplo, n, a, lda, info ) import sp,dp,qp,ilp,lk @@ -19821,9 +19817,9 @@ module stdlib_linalg_lapack interface potri - !> POTRI computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by CPOTRF. + !! POTRI computes the inverse of a complex Hermitian positive definite + !! matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !! computed by CPOTRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpotri( uplo, n, a, lda, info ) import sp,dp,qp,ilp,lk @@ -19883,9 +19879,9 @@ module stdlib_linalg_lapack interface potrs - !> POTRS solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A using the Cholesky factorization - !> A = U**H*U or A = L*L**H computed by CPOTRF. + !! POTRS solves a system of linear equations A*X = B with a Hermitian + !! positive definite matrix A using the Cholesky factorization + !! A = U**H*U or A = L*L**H computed by CPOTRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpotrs( uplo, n, nrhs, a, lda, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -19949,12 +19945,12 @@ module stdlib_linalg_lapack interface ppcon - !> PPCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite packed matrix using - !> the Cholesky factorization A = U**H*U or A = L*L**H computed by - !> CPPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! PPCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite packed matrix using + !! the Cholesky factorization A = U**H*U or A = L*L**H computed by + !! CPPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cppcon( uplo, n, ap, anorm, rcond, work, rwork, info ) import sp,dp,qp,ilp,lk @@ -20022,14 +20018,14 @@ module stdlib_linalg_lapack interface ppequ - !> PPEQU computes row and column scalings intended to equilibrate a - !> Hermitian positive definite matrix A in packed storage and reduce - !> its condition number (with respect to the two-norm). S contains the - !> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix - !> B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal. - !> This choice of S puts the condition number of B within a factor N of - !> the smallest possible condition number over all possible diagonal - !> scalings. + !! PPEQU computes row and column scalings intended to equilibrate a + !! Hermitian positive definite matrix A in packed storage and reduce + !! its condition number (with respect to the two-norm). S contains the + !! scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix + !! B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal. + !! This choice of S puts the condition number of B within a factor N of + !! the smallest possible condition number over all possible diagonal + !! scalings. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cppequ( uplo, n, ap, s, scond, amax, info ) import sp,dp,qp,ilp,lk @@ -20093,10 +20089,10 @@ module stdlib_linalg_lapack interface pprfs - !> PPRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite - !> and packed, and provides error bounds and backward error estimates - !> for the solution. + !! PPRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite + !! and packed, and provides error bounds and backward error estimates + !! for the solution. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & rwork, info ) @@ -20170,16 +20166,16 @@ module stdlib_linalg_lapack interface ppsv - !> PPSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix stored in - !> packed format and X and B are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is a lower triangular - !> matrix. The factored form of A is then used to solve the system of - !> equations A * X = B. + !! PPSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix stored in + !! packed format and X and B are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is a lower triangular + !! matrix. The factored form of A is then used to solve the system of + !! equations A * X = B. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cppsv( uplo, n, nrhs, ap, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -20239,12 +20235,12 @@ module stdlib_linalg_lapack interface pptrf - !> PPTRF computes the Cholesky factorization of a complex Hermitian - !> positive definite matrix A stored in packed format. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. + !! PPTRF computes the Cholesky factorization of a complex Hermitian + !! positive definite matrix A stored in packed format. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpptrf( uplo, n, ap, info ) import sp,dp,qp,ilp,lk @@ -20304,9 +20300,9 @@ module stdlib_linalg_lapack interface pptri - !> PPTRI computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by CPPTRF. + !! PPTRI computes the inverse of a complex Hermitian positive definite + !! matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !! computed by CPPTRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpptri( uplo, n, ap, info ) import sp,dp,qp,ilp,lk @@ -20366,9 +20362,9 @@ module stdlib_linalg_lapack interface pptrs - !> PPTRS solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A in packed storage using the Cholesky - !> factorization A = U**H*U or A = L*L**H computed by CPPTRF. + !! PPTRS solves a system of linear equations A*X = B with a Hermitian + !! positive definite matrix A in packed storage using the Cholesky + !! factorization A = U**H*U or A = L*L**H computed by CPPTRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpptrs( uplo, n, nrhs, ap, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -20432,15 +20428,15 @@ module stdlib_linalg_lapack interface pstrf - !> PSTRF computes the Cholesky factorization with complete - !> pivoting of a complex Hermitian positive semidefinite matrix A. - !> The factorization has the form - !> P**T * A * P = U**H * U , if UPLO = 'U', - !> P**T * A * P = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular, and - !> P is stored as vector PIV. - !> This algorithm does not attempt to check that A is positive - !> semidefinite. This version of the algorithm calls level 3 BLAS. + !! PSTRF computes the Cholesky factorization with complete + !! pivoting of a complex Hermitian positive semidefinite matrix A. + !! The factorization has the form + !! P**T * A * P = U**H * U , if UPLO = 'U', + !! P**T * A * P = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular, and + !! P is stored as vector PIV. + !! This algorithm does not attempt to check that A is positive + !! semidefinite. This version of the algorithm calls level 3 BLAS. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) import sp,dp,qp,ilp,lk @@ -20508,13 +20504,13 @@ module stdlib_linalg_lapack interface ptcon - !> PTCON computes the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite tridiagonal matrix - !> using the factorization A = L*D*L**H or A = U**H*D*U computed by - !> CPTTRF. - !> Norm(inv(A)) is computed by a direct method, and the reciprocal of - !> the condition number is computed as - !> RCOND = 1 / (ANORM * norm(inv(A))). + !! PTCON computes the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite tridiagonal matrix + !! using the factorization A = L*D*L**H or A = U**H*D*U computed by + !! CPTTRF. + !! Norm(inv(A)) is computed by a direct method, and the reciprocal of + !! the condition number is computed as + !! RCOND = 1 / (ANORM * norm(inv(A))). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cptcon( n, d, e, anorm, rcond, rwork, info ) import sp,dp,qp,ilp,lk @@ -20576,21 +20572,21 @@ module stdlib_linalg_lapack interface pteqr - !> PTEQR computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric positive definite tridiagonal matrix by first factoring the - !> matrix using SPTTRF and then calling CBDSQR to compute the singular - !> values of the bidiagonal factor. - !> This routine computes the eigenvalues of the positive definite - !> tridiagonal matrix to high relative accuracy. This means that if the - !> eigenvalues range over many orders of magnitude in size, then the - !> small eigenvalues and corresponding eigenvectors will be computed - !> more accurately than, for example, with the standard QR method. - !> The eigenvectors of a full or band positive definite Hermitian matrix - !> can also be found if CHETRD, CHPTRD, or CHBTRD has been used to - !> reduce this matrix to tridiagonal form. (The reduction to - !> tridiagonal form, however, may preclude the possibility of obtaining - !> high relative accuracy in the small eigenvalues of the original - !> matrix, if these eigenvalues range over many orders of magnitude.) + !! PTEQR computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric positive definite tridiagonal matrix by first factoring the + !! matrix using SPTTRF and then calling CBDSQR to compute the singular + !! values of the bidiagonal factor. + !! This routine computes the eigenvalues of the positive definite + !! tridiagonal matrix to high relative accuracy. This means that if the + !! eigenvalues range over many orders of magnitude in size, then the + !! small eigenvalues and corresponding eigenvectors will be computed + !! more accurately than, for example, with the standard QR method. + !! The eigenvectors of a full or band positive definite Hermitian matrix + !! can also be found if CHETRD, CHPTRD, or CHBTRD has been used to + !! reduce this matrix to tridiagonal form. (The reduction to + !! tridiagonal form, however, may preclude the possibility of obtaining + !! high relative accuracy in the small eigenvalues of the original + !! matrix, if these eigenvalues range over many orders of magnitude.) #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpteqr( compz, n, d, e, z, ldz, work, info ) import sp,dp,qp,ilp,lk @@ -20656,10 +20652,10 @@ module stdlib_linalg_lapack interface ptrfs - !> PTRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite - !> and tridiagonal, and provides error bounds and backward error - !> estimates for the solution. + !! PTRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite + !! and tridiagonal, and provides error bounds and backward error + !! estimates for the solution. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cptrfs( uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx,ferr, berr, & work, rwork, info ) @@ -20733,11 +20729,11 @@ module stdlib_linalg_lapack interface ptsv - !> PTSV computes the solution to a complex system of linear equations - !> A*X = B, where A is an N-by-N Hermitian positive definite tridiagonal - !> matrix, and X and B are N-by-NRHS matrices. - !> A is factored as A = L*D*L**H, and the factored form of A is then - !> used to solve the system of equations. + !! PTSV computes the solution to a complex system of linear equations + !! A*X = B, where A is an N-by-N Hermitian positive definite tridiagonal + !! matrix, and X and B are N-by-NRHS matrices. + !! A is factored as A = L*D*L**H, and the factored form of A is then + !! used to solve the system of equations. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cptsv( n, nrhs, d, e, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -20795,9 +20791,9 @@ module stdlib_linalg_lapack interface pttrf - !> PTTRF computes the L*D*L**H factorization of a complex Hermitian - !> positive definite tridiagonal matrix A. The factorization may also - !> be regarded as having the form A = U**H *D*U. + !! PTTRF computes the L*D*L**H factorization of a complex Hermitian + !! positive definite tridiagonal matrix A. The factorization may also + !! be regarded as having the form A = U**H *D*U. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpttrf( n, d, e, info ) import sp,dp,qp,ilp,lk @@ -20855,12 +20851,12 @@ module stdlib_linalg_lapack interface pttrs - !> PTTRS solves a tridiagonal system of the form - !> A * X = B - !> using the factorization A = U**H*D*U or A = L*D*L**H computed by CPTTRF. - !> D is a diagonal matrix specified in the vector D, U (or L) is a unit - !> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in - !> the vector E, and X and B are N by NRHS matrices. + !! PTTRS solves a tridiagonal system of the form + !! A * X = B + !! using the factorization A = U**H*D*U or A = L*D*L**H computed by CPTTRF. + !! D is a diagonal matrix specified in the vector D, U (or L) is a unit + !! bidiagonal matrix whose superdiagonal (subdiagonal) is specified in + !! the vector E, and X and B are N by NRHS matrices. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpttrs( uplo, n, nrhs, d, e, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -20924,8 +20920,8 @@ module stdlib_linalg_lapack interface rot - !> ROT applies a plane rotation, where the cos (C) is real and the - !> sin (S) is complex, and the vectors CX and CY are complex. + !! ROT applies a plane rotation, where the cos (C) is real and the + !! sin (S) is complex, and the vectors CX and CY are complex. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine crot( n, cx, incx, cy, incy, c, s ) import sp,dp,qp,ilp,lk @@ -20958,9 +20954,9 @@ module stdlib_linalg_lapack interface rscl - !> RSCL multiplies an n-element real vector x by the real scalar 1/a. - !> This is done without overflow or underflow as long as - !> the final result x/a does not overflow or underflow. + !! RSCL multiplies an n-element real vector x by the real scalar 1/a. + !! This is done without overflow or underflow as long as + !! the final result x/a does not overflow or underflow. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine drscl( n, sa, sx, incx ) import sp,dp,qp,ilp,lk @@ -20991,8 +20987,8 @@ module stdlib_linalg_lapack interface sb2st_kernels - !> SB2ST_KERNELS is an internal routine used by the DSYTRD_SB2ST - !> subroutine. + !! SB2ST_KERNELS is an internal routine used by the DSYTRD_SB2ST + !! subroutine. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, & lda, v, tau, ldvt, work) @@ -21029,8 +21025,8 @@ module stdlib_linalg_lapack interface sbev - !> SBEV computes all the eigenvalues and, optionally, eigenvectors of - !> a real symmetric band matrix A. + !! SBEV computes all the eigenvalues and, optionally, eigenvectors of + !! a real symmetric band matrix A. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,info ) import sp,dp,qp,ilp,lk @@ -21065,15 +21061,15 @@ module stdlib_linalg_lapack interface sbevd - !> SBEVD computes all the eigenvalues and, optionally, eigenvectors of - !> a real symmetric 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. + !! SBEVD computes all the eigenvalues and, optionally, eigenvectors of + !! a real symmetric 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, iwork, & liwork, info ) @@ -21110,13 +21106,13 @@ module stdlib_linalg_lapack interface sbgst - !> SBGST reduces a real symmetric-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**T*S by DPBSTF, using a - !> split Cholesky factorization. A is overwritten by C = X**T*A*X, where - !> X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the - !> bandwidth of A. + !! SBGST reduces a real symmetric-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**T*S by DPBSTF, using a + !! split Cholesky factorization. A is overwritten by C = X**T*A*X, where + !! X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the + !! bandwidth of A. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, & info ) @@ -21155,10 +21151,10 @@ module stdlib_linalg_lapack interface sbgv - !> SBGV computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-definite banded eigenproblem, of - !> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric - !> and banded, and B is also positive definite. + !! SBGV computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-definite banded eigenproblem, of + !! the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric + !! and banded, and B is also positive definite. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & info ) @@ -21195,17 +21191,17 @@ module stdlib_linalg_lapack interface sbgvd - !> SBGVD computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-definite banded eigenproblem, of the - !> form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric 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. + !! SBGVD computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-definite banded eigenproblem, of the + !! form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & lwork, iwork, liwork, info ) @@ -21242,9 +21238,9 @@ module stdlib_linalg_lapack interface sbtrd - !> SBTRD reduces a real symmetric band matrix A to symmetric - !> tridiagonal form T by an orthogonal similarity transformation: - !> Q**T * A * Q = T. + !! SBTRD reduces a real symmetric band matrix A to symmetric + !! tridiagonal form T by an orthogonal similarity transformation: + !! Q**T * A * Q = T. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) @@ -21281,14 +21277,14 @@ module stdlib_linalg_lapack interface sfrk - !> Level 3 BLAS like routine for C in RFP Format. - !> SFRK performs one of the symmetric rank--k operations - !> C := alpha*A*A**T + beta*C, - !> or - !> C := alpha*A**T*A + beta*C, - !> where alpha and beta are real scalars, C is an n--by--n symmetric - !> matrix and A is an n--by--k matrix in the first case and a k--by--n - !> matrix in the second case. + !! Level 3 BLAS like routine for C in RFP Format. + !! SFRK performs one of the symmetric rank--k operations + !! C := alpha*A*A**T + beta*C, + !! or + !! C := alpha*A**T*A + beta*C, + !! where alpha and beta are real scalars, C is an n--by--n symmetric + !! matrix and A is an n--by--k matrix in the first case and a k--by--n + !! matrix in the second case. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) import sp,dp,qp,ilp,lk @@ -21321,11 +21317,11 @@ module stdlib_linalg_lapack interface spcon - !> SPCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex symmetric packed matrix A using the - !> factorization A = U*D*U**T or A = L*D*L**T computed by CSPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! SPCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex symmetric packed matrix A using the + !! factorization A = U*D*U**T or A = L*D*L**T computed by CSPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cspcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) import sp,dp,qp,ilp,lk @@ -21393,8 +21389,8 @@ module stdlib_linalg_lapack interface spev - !> SPEV computes all the eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A in packed storage. + !! SPEV computes all the eigenvalues and, optionally, eigenvectors of a + !! real symmetric matrix A in packed storage. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dspev( jobz, uplo, n, ap, w, z, ldz, work, info ) import sp,dp,qp,ilp,lk @@ -21429,15 +21425,15 @@ module stdlib_linalg_lapack interface spevd - !> SPEVD computes all the eigenvalues and, optionally, eigenvectors - !> of a real symmetric 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. + !! SPEVD computes all the eigenvalues and, optionally, eigenvectors + !! of a real symmetric 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dspevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,iwork, liwork, info ) @@ -21474,13 +21470,13 @@ module stdlib_linalg_lapack interface spgst - !> SPGST reduces a real symmetric-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**T)*A*inv(U) or inv(L)*A*inv(L**T) - !> 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**T or L**T*A*L. - !> B must have been previously factorized as U**T*U or L*L**T by DPPTRF. + !! SPGST reduces a real symmetric-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**T)*A*inv(U) or inv(L)*A*inv(L**T) + !! 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**T or L**T*A*L. + !! B must have been previously factorized as U**T*U or L*L**T by DPPTRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dspgst( itype, uplo, n, ap, bp, info ) import sp,dp,qp,ilp,lk @@ -21515,11 +21511,11 @@ module stdlib_linalg_lapack interface spgv - !> SPGV computes all the eigenvalues and, optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric, stored in packed format, - !> and B is also positive definite. + !! SPGV computes all the eigenvalues and, optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric, stored in packed format, + !! and B is also positive definite. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dspgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,info ) import sp,dp,qp,ilp,lk @@ -21554,18 +21550,18 @@ module stdlib_linalg_lapack interface spgvd - !> SPGVD computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric, 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. + !! SPGVD computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric, 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dspgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, iwork, & liwork, info ) @@ -21602,10 +21598,10 @@ module stdlib_linalg_lapack interface spmv - !> SPMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix, supplied in packed form. + !! SPMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix, supplied in packed form. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cspmv( uplo, n, alpha, ap, x, incx, beta, y, incy ) import sp,dp,qp,ilp,lk @@ -21638,10 +21634,10 @@ module stdlib_linalg_lapack interface spr - !> SPR performs the symmetric rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a complex scalar, x is an n element vector and A is an - !> n by n symmetric matrix, supplied in packed form. + !! SPR performs the symmetric rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a complex scalar, x is an n element vector and A is an + !! n by n symmetric matrix, supplied in packed form. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cspr( uplo, n, alpha, x, incx, ap ) import sp,dp,qp,ilp,lk @@ -21674,10 +21670,10 @@ module stdlib_linalg_lapack interface sprfs - !> SPRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite - !> and packed, and provides error bounds and backward error estimates - !> for the solution. + !! SPRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric indefinite + !! and packed, and provides error bounds and backward error estimates + !! for the solution. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, & work, rwork, info ) @@ -21751,17 +21747,17 @@ module stdlib_linalg_lapack interface spsv - !> SPSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric 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**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, D is symmetric 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. + !! SPSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric 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**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, D is symmetric 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -21821,9 +21817,9 @@ module stdlib_linalg_lapack interface sptrd - !> SPTRD reduces a real symmetric matrix A stored in packed form to - !> symmetric tridiagonal form T by an orthogonal similarity - !> transformation: Q**T * A * Q = T. + !! SPTRD reduces a real symmetric matrix A stored in packed form to + !! symmetric tridiagonal form T by an orthogonal similarity + !! transformation: Q**T * A * Q = T. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsptrd( uplo, n, ap, d, e, tau, info ) import sp,dp,qp,ilp,lk @@ -21858,13 +21854,13 @@ module stdlib_linalg_lapack interface sptrf - !> SPTRF computes the factorization of a complex symmetric matrix A - !> stored in packed format using the Bunch-Kaufman diagonal pivoting - !> method: - !> 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 symmetric and block diagonal with - !> 1-by-1 and 2-by-2 diagonal blocks. + !! SPTRF computes the factorization of a complex symmetric matrix A + !! stored in packed format using the Bunch-Kaufman diagonal pivoting + !! method: + !! 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 symmetric and block diagonal with + !! 1-by-1 and 2-by-2 diagonal blocks. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csptrf( uplo, n, ap, ipiv, info ) import sp,dp,qp,ilp,lk @@ -21924,9 +21920,9 @@ module stdlib_linalg_lapack interface sptri - !> SPTRI computes the inverse of a complex symmetric indefinite matrix - !> A in packed storage using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by CSPTRF. + !! SPTRI computes the inverse of a complex symmetric indefinite matrix + !! A in packed storage using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by CSPTRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csptri( uplo, n, ap, ipiv, work, info ) import sp,dp,qp,ilp,lk @@ -21990,9 +21986,9 @@ module stdlib_linalg_lapack interface sptrs - !> SPTRS solves a system of linear equations A*X = B with a complex - !> symmetric matrix A stored in packed format using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by CSPTRF. + !! SPTRS solves a system of linear equations A*X = B with a complex + !! symmetric matrix A stored in packed format using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by CSPTRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -22056,16 +22052,16 @@ module stdlib_linalg_lapack interface stebz - !> STEBZ computes the eigenvalues of a symmetric tridiagonal - !> matrix T. 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. + !! STEBZ computes the eigenvalues of a symmetric tridiagonal + !! matrix T. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dstebz( range, order, n, vl, vu, il, iu, abstol, d, e,m, nsplit, w,& iblock, isplit, work, iwork,info ) @@ -22104,17 +22100,17 @@ module stdlib_linalg_lapack interface stedc - !> STEDC computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric tridiagonal matrix using the divide and conquer method. - !> The eigenvectors of a full or band complex Hermitian matrix can also - !> be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this - !> matrix to tridiagonal 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 SLAED3 for details. + !! STEDC computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric tridiagonal matrix using the divide and conquer method. + !! The eigenvectors of a full or band complex Hermitian matrix can also + !! be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this + !! matrix to tridiagonal 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 SLAED3 for details. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cstedc( compz, n, d, e, z, ldz, work, lwork, rwork,lrwork, iwork, & liwork, info ) @@ -22186,22 +22182,22 @@ module stdlib_linalg_lapack interface stegr - !> STEGR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has - !> a well defined set of pairwise different real eigenvalues, the corresponding - !> real eigenvectors are pairwise orthogonal. - !> The spectrum may be computed either completely or partially by specifying - !> either an interval (VL,VU] or a range of indices IL:IU for the desired - !> eigenvalues. - !> STEGR is a compatibility wrapper around the improved CSTEMR routine. - !> See SSTEMR for further details. - !> One important change is that the ABSTOL parameter no longer provides any - !> benefit and hence is no longer used. - !> Note : STEGR and CSTEMR work only on machines which follow - !> IEEE-754 floating-point standard in their handling of infinities and - !> NaNs. Normal execution may create these exceptiona values and hence - !> may abort due to a floating point exception in environments which - !> do not conform to the IEEE-754 standard. + !! STEGR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Any such unreduced matrix has + !! a well defined set of pairwise different real eigenvalues, the corresponding + !! real eigenvectors are pairwise orthogonal. + !! The spectrum may be computed either completely or partially by specifying + !! either an interval (VL,VU] or a range of indices IL:IU for the desired + !! eigenvalues. + !! STEGR is a compatibility wrapper around the improved CSTEMR routine. + !! See SSTEMR for further details. + !! One important change is that the ABSTOL parameter no longer provides any + !! benefit and hence is no longer used. + !! Note : STEGR and CSTEMR work only on machines which follow + !! IEEE-754 floating-point standard in their handling of infinities and + !! NaNs. Normal execution may create these exceptiona values and hence + !! may abort due to a floating point exception in environments which + !! do not conform to the IEEE-754 standard. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & isuppz, work, lwork, iwork,liwork, info ) @@ -22275,15 +22271,15 @@ module stdlib_linalg_lapack interface stein - !> STEIN computes the eigenvectors of a real symmetric tridiagonal - !> matrix T corresponding to specified eigenvalues, using inverse - !> iteration. - !> The maximum number of iterations allowed for each eigenvector is - !> specified by an internal parameter MAXITS (currently set to 5). - !> Although the eigenvectors are real, they are stored in a complex - !> array, which may be passed to CUNMTR or CUPMTR for back - !> transformation to the eigenvectors of a complex Hermitian matrix - !> which was reduced to tridiagonal form. + !! STEIN computes the eigenvectors of a real symmetric tridiagonal + !! matrix T corresponding to specified eigenvalues, using inverse + !! iteration. + !! The maximum number of iterations allowed for each eigenvector is + !! specified by an internal parameter MAXITS (currently set to 5). + !! Although the eigenvectors are real, they are stored in a complex + !! array, which may be passed to CUNMTR or CUPMTR for back + !! transformation to the eigenvectors of a complex Hermitian matrix + !! which was reduced to tridiagonal form. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & info ) @@ -22349,65 +22345,65 @@ module stdlib_linalg_lapack interface stemr - !> STEMR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has - !> a well defined set of pairwise different real eigenvalues, the corresponding - !> real eigenvectors are pairwise orthogonal. - !> The spectrum may be computed either completely or partially by specifying - !> either an interval (VL,VU] or a range of indices IL:IU for the desired - !> eigenvalues. - !> Depending on the number of desired eigenvalues, these are computed either - !> by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are - !> computed by the use of various suitable L D L^T factorizations near clusters - !> of close eigenvalues (referred to as RRRs, Relatively Robust - !> Representations). An informal sketch of the algorithm 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. - !> For more details, see: - !> - 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. - !> Further Details - !> 1.STEMR works only on machines which follow IEEE-754 - !> floating-point standard in their handling of infinities and NaNs. - !> This permits the use of efficient inner loops avoiding a check for - !> zero divisors. - !> 2. LAPACK routines can be used to reduce a complex Hermitean matrix to - !> real symmetric tridiagonal form. - !> (Any complex Hermitean tridiagonal matrix has real values on its diagonal - !> and potentially complex numbers on its off-diagonals. By applying a - !> similarity transform with an appropriate diagonal matrix - !> diag(1,e^{i \phy_1}, ... , e^{i \phy_{n-1}}), the complex Hermitean - !> matrix can be transformed into a real symmetric matrix and complex - !> arithmetic can be entirely avoided.) - !> While the eigenvectors of the real symmetric tridiagonal matrix are real, - !> the eigenvectors of original complex Hermitean matrix have complex entries - !> in general. - !> Since LAPACK drivers overwrite the matrix data with the eigenvectors, - !> STEMR accepts complex workspace to facilitate interoperability - !> with CUNMTR or CUPMTR. + !! STEMR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Any such unreduced matrix has + !! a well defined set of pairwise different real eigenvalues, the corresponding + !! real eigenvectors are pairwise orthogonal. + !! The spectrum may be computed either completely or partially by specifying + !! either an interval (VL,VU] or a range of indices IL:IU for the desired + !! eigenvalues. + !! Depending on the number of desired eigenvalues, these are computed either + !! by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are + !! computed by the use of various suitable L D L^T factorizations near clusters + !! of close eigenvalues (referred to as RRRs, Relatively Robust + !! Representations). An informal sketch of the algorithm 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. + !! For more details, see: + !! - 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. + !! Further Details + !! 1.STEMR works only on machines which follow IEEE-754 + !! floating-point standard in their handling of infinities and NaNs. + !! This permits the use of efficient inner loops avoiding a check for + !! zero divisors. + !! 2. LAPACK routines can be used to reduce a complex Hermitean matrix to + !! real symmetric tridiagonal form. + !! (Any complex Hermitean tridiagonal matrix has real values on its diagonal + !! and potentially complex numbers on its off-diagonals. By applying a + !! similarity transform with an appropriate diagonal matrix + !! diag(1,e^{i \phy_1}, ... , e^{i \phy_{n-1}}), the complex Hermitean + !! matrix can be transformed into a real symmetric matrix and complex + !! arithmetic can be entirely avoided.) + !! While the eigenvectors of the real symmetric tridiagonal matrix are real, + !! the eigenvectors of original complex Hermitean matrix have complex entries + !! in general. + !! Since LAPACK drivers overwrite the matrix data with the eigenvectors, + !! STEMR accepts complex workspace to facilitate interoperability + !! with CUNMTR or CUPMTR. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & isuppz, tryrac, work, lwork,iwork, liwork, info ) @@ -22485,11 +22481,11 @@ module stdlib_linalg_lapack interface steqr - !> STEQR computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric tridiagonal matrix using the implicit QL or QR method. - !> The eigenvectors of a full or band complex Hermitian matrix can also - !> be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this - !> matrix to tridiagonal form. + !! STEQR computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric tridiagonal matrix using the implicit QL or QR method. + !! The eigenvectors of a full or band complex Hermitian matrix can also + !! be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this + !! matrix to tridiagonal form. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csteqr( compz, n, d, e, z, ldz, work, info ) import sp,dp,qp,ilp,lk @@ -22555,8 +22551,8 @@ module stdlib_linalg_lapack interface sterf - !> STERF computes all eigenvalues of a symmetric tridiagonal matrix - !> using the Pal-Walker-Kahan variant of the QL or QR algorithm. + !! STERF computes all eigenvalues of a symmetric tridiagonal matrix + !! using the Pal-Walker-Kahan variant of the QL or QR algorithm. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsterf( n, d, e, info ) import sp,dp,qp,ilp,lk @@ -22587,8 +22583,8 @@ module stdlib_linalg_lapack interface stev - !> STEV computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric tridiagonal matrix A. + !! STEV computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric tridiagonal matrix A. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dstev( jobz, n, d, e, z, ldz, work, info ) import sp,dp,qp,ilp,lk @@ -22623,15 +22619,15 @@ module stdlib_linalg_lapack interface stevd - !> STEVD computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric tridiagonal matrix. 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. + !! STEVD computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric tridiagonal matrix. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dstevd( jobz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) @@ -22668,41 +22664,41 @@ module stdlib_linalg_lapack interface stevr - !> STEVR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Eigenvalues and - !> eigenvectors can be selected by specifying either a range of values - !> or a range of indices for the desired eigenvalues. - !> Whenever possible, STEVR calls DSTEMR to compute the - !> eigenspectrum using Relatively Robust Representations. DSTEMR - !> 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 the i-th - !> unreduced block of T, - !> (a) Compute T - sigma_i = L_i D_i L_i^T, such that L_i D_i L_i^T - !> is a relatively robust representation, - !> (b) Compute the eigenvalues, lambda_j, of L_i D_i L_i^T to high - !> relative accuracy by the dqds algorithm, - !> (c) If there is a cluster of close eigenvalues, "choose" sigma_i - !> close to the cluster, and go to step (a), - !> (d) Given the approximate eigenvalue lambda_j of L_i D_i L_i^T, - !> compute the corresponding eigenvector by forming a - !> rank-revealing twisted factorization. - !> The desired accuracy of the output can be specified by the input - !> parameter ABSTOL. - !> For more details, see "A new O(n^2) algorithm for the symmetric - !> tridiagonal eigenvalue/eigenvector problem", by Inderjit Dhillon, - !> Computer Science Division Technical Report No. UCB//CSD-97-971, - !> UC Berkeley, May 1997. - !> Note 1 : STEVR calls DSTEMR when the full spectrum is requested - !> on machines which conform to the ieee-754 floating point standard. - !> STEVR calls DSTEBZ and DSTEIN on non-ieee machines and - !> when partial spectrum requests are made. - !> Normal execution of DSTEMR 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. + !! STEVR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Eigenvalues and + !! eigenvectors can be selected by specifying either a range of values + !! or a range of indices for the desired eigenvalues. + !! Whenever possible, STEVR calls DSTEMR to compute the + !! eigenspectrum using Relatively Robust Representations. DSTEMR + !! 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 the i-th + !! unreduced block of T, + !! (a) Compute T - sigma_i = L_i D_i L_i^T, such that L_i D_i L_i^T + !! is a relatively robust representation, + !! (b) Compute the eigenvalues, lambda_j, of L_i D_i L_i^T to high + !! relative accuracy by the dqds algorithm, + !! (c) If there is a cluster of close eigenvalues, "choose" sigma_i + !! close to the cluster, and go to step (a), + !! (d) Given the approximate eigenvalue lambda_j of L_i D_i L_i^T, + !! compute the corresponding eigenvector by forming a + !! rank-revealing twisted factorization. + !! The desired accuracy of the output can be specified by the input + !! parameter ABSTOL. + !! For more details, see "A new O(n^2) algorithm for the symmetric + !! tridiagonal eigenvalue/eigenvector problem", by Inderjit Dhillon, + !! Computer Science Division Technical Report No. UCB//CSD-97-971, + !! UC Berkeley, May 1997. + !! Note 1 : STEVR calls DSTEMR when the full spectrum is requested + !! on machines which conform to the ieee-754 floating point standard. + !! STEVR calls DSTEBZ and DSTEIN on non-ieee machines and + !! when partial spectrum requests are made. + !! Normal execution of DSTEMR 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dstevr( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & isuppz, work, lwork, iwork,liwork, info ) @@ -22741,11 +22737,11 @@ module stdlib_linalg_lapack interface sycon - !> SYCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex symmetric matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by CSYTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! SYCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex symmetric matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by CSYTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csycon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) import sp,dp,qp,ilp,lk @@ -22815,11 +22811,11 @@ module stdlib_linalg_lapack interface sycon_rook - !> SYCON_ROOK estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex symmetric matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by CSYTRF_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))). + !! SYCON_ROOK estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex symmetric matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by CSYTRF_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))). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) @@ -22891,9 +22887,9 @@ module stdlib_linalg_lapack interface syconv - !> SYCONV convert A given by TRF into L and D and vice-versa. - !> Get Non-diag elements of D (returned in workspace) and - !> apply or reverse permutation done in TRF. + !! SYCONV convert A given by TRF into L and D and vice-versa. + !! Get Non-diag elements of D (returned in workspace) and + !! apply or reverse permutation done in TRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyconv( uplo, way, n, a, lda, ipiv, e, info ) import sp,dp,qp,ilp,lk @@ -22957,23 +22953,23 @@ module stdlib_linalg_lapack interface syconvf - !> If parameter WAY = 'C': - !> SYCONVF converts the factorization output format used in - !> CSYTRF provided on entry in parameter A into the factorization - !> output format used in CSYTRF_RK (or CSYTRF_BK) that is stored - !> on exit in parameters A and E. It also converts in place details of - !> the intechanges stored in IPIV from the format used in CSYTRF into - !> the format used in CSYTRF_RK (or CSYTRF_BK). - !> If parameter WAY = 'R': - !> SYCONVF performs the conversion in reverse direction, i.e. - !> converts the factorization output format used in CSYTRF_RK - !> (or CSYTRF_BK) provided on entry in parameters A and E into - !> the factorization output format used in CSYTRF that is stored - !> on exit in parameter A. It also converts in place details of - !> the intechanges stored in IPIV from the format used in CSYTRF_RK - !> (or CSYTRF_BK) into the format used in CSYTRF. - !> SYCONVF can also convert in Hermitian matrix case, i.e. between - !> formats used in CHETRF and CHETRF_RK (or CHETRF_BK). + !! If parameter WAY = 'C': + !! SYCONVF converts the factorization output format used in + !! CSYTRF provided on entry in parameter A into the factorization + !! output format used in CSYTRF_RK (or CSYTRF_BK) that is stored + !! on exit in parameters A and E. It also converts in place details of + !! the intechanges stored in IPIV from the format used in CSYTRF into + !! the format used in CSYTRF_RK (or CSYTRF_BK). + !! If parameter WAY = 'R': + !! SYCONVF performs the conversion in reverse direction, i.e. + !! converts the factorization output format used in CSYTRF_RK + !! (or CSYTRF_BK) provided on entry in parameters A and E into + !! the factorization output format used in CSYTRF that is stored + !! on exit in parameter A. It also converts in place details of + !! the intechanges stored in IPIV from the format used in CSYTRF_RK + !! (or CSYTRF_BK) into the format used in CSYTRF. + !! SYCONVF can also convert in Hermitian matrix case, i.e. between + !! formats used in CHETRF and CHETRF_RK (or CHETRF_BK). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyconvf( uplo, way, n, a, lda, e, ipiv, info ) import sp,dp,qp,ilp,lk @@ -23037,21 +23033,21 @@ module stdlib_linalg_lapack interface syconvf_rook - !> If parameter WAY = 'C': - !> SYCONVF_ROOK converts the factorization output format used in - !> CSYTRF_ROOK provided on entry in parameter A into the factorization - !> output format used in CSYTRF_RK (or CSYTRF_BK) that is stored - !> on exit in parameters A and E. IPIV format for CSYTRF_ROOK and - !> CSYTRF_RK (or CSYTRF_BK) is the same and is not converted. - !> If parameter WAY = 'R': - !> SYCONVF_ROOK performs the conversion in reverse direction, i.e. - !> converts the factorization output format used in CSYTRF_RK - !> (or CSYTRF_BK) provided on entry in parameters A and E into - !> the factorization output format used in CSYTRF_ROOK that is stored - !> on exit in parameter A. IPIV format for CSYTRF_ROOK and - !> CSYTRF_RK (or CSYTRF_BK) is the same and is not converted. - !> SYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between - !> formats used in CHETRF_ROOK and CHETRF_RK (or CHETRF_BK). + !! If parameter WAY = 'C': + !! SYCONVF_ROOK converts the factorization output format used in + !! CSYTRF_ROOK provided on entry in parameter A into the factorization + !! output format used in CSYTRF_RK (or CSYTRF_BK) that is stored + !! on exit in parameters A and E. IPIV format for CSYTRF_ROOK and + !! CSYTRF_RK (or CSYTRF_BK) is the same and is not converted. + !! If parameter WAY = 'R': + !! SYCONVF_ROOK performs the conversion in reverse direction, i.e. + !! converts the factorization output format used in CSYTRF_RK + !! (or CSYTRF_BK) provided on entry in parameters A and E into + !! the factorization output format used in CSYTRF_ROOK that is stored + !! on exit in parameter A. IPIV format for CSYTRF_ROOK and + !! CSYTRF_RK (or CSYTRF_BK) is the same and is not converted. + !! SYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between + !! formats used in CHETRF_ROOK and CHETRF_RK (or CHETRF_BK). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) import sp,dp,qp,ilp,lk @@ -23111,13 +23107,13 @@ module stdlib_linalg_lapack interface syequb - !> SYEQUB computes row and column scalings intended to equilibrate a - !> symmetric 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. + !! SYEQUB computes row and column scalings intended to equilibrate a + !! symmetric 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyequb( uplo, n, a, lda, s, scond, amax, work, info ) import sp,dp,qp,ilp,lk @@ -23183,8 +23179,8 @@ module stdlib_linalg_lapack interface syev - !> SYEV computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A. + !! SYEV computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric matrix A. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsyev( jobz, uplo, n, a, lda, w, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -23219,17 +23215,17 @@ module stdlib_linalg_lapack interface syevd - !> SYEVD computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric 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. - !> Because of large use of BLAS of level 3, SYEVD needs N**2 more - !> workspace than DSYEVX. + !! SYEVD computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric 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. + !! Because of large use of BLAS of level 3, SYEVD needs N**2 more + !! workspace than DSYEVX. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsyevd( jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info ) @@ -23266,56 +23262,56 @@ module stdlib_linalg_lapack interface syevr - !> SYEVR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric matrix A. Eigenvalues and eigenvectors can be - !> selected by specifying either a range of values or a range of - !> indices for the desired eigenvalues. - !> SYEVR first reduces the matrix A to tridiagonal form T with a call - !> to DSYTRD. Then, whenever possible, SYEVR calls DSTEMR to compute - !> the eigenspectrum using Relatively Robust Representations. DSTEMR - !> 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 DSTEMR'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 : SYEVR calls DSTEMR when the full spectrum is requested - !> on machines which conform to the ieee-754 floating point standard. - !> SYEVR calls DSTEBZ and DSTEIN on non-ieee machines and - !> when partial spectrum requests are made. - !> Normal execution of DSTEMR 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. + !! SYEVR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric matrix A. Eigenvalues and eigenvectors can be + !! selected by specifying either a range of values or a range of + !! indices for the desired eigenvalues. + !! SYEVR first reduces the matrix A to tridiagonal form T with a call + !! to DSYTRD. Then, whenever possible, SYEVR calls DSTEMR to compute + !! the eigenspectrum using Relatively Robust Representations. DSTEMR + !! 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 DSTEMR'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 : SYEVR calls DSTEMR when the full spectrum is requested + !! on machines which conform to the ieee-754 floating point standard. + !! SYEVR calls DSTEBZ and DSTEIN on non-ieee machines and + !! when partial spectrum requests are made. + !! Normal execution of DSTEMR 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsyevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, & ldz, isuppz, work, lwork,iwork, liwork, info ) @@ -23354,13 +23350,13 @@ module stdlib_linalg_lapack interface sygst - !> SYGST reduces a real symmetric-definite generalized eigenproblem - !> to standard form. - !> If ITYPE = 1, the problem is A*x = lambda*B*x, - !> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) - !> 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**T or L**T*A*L. - !> B must have been previously factorized as U**T*U or L*L**T by DPOTRF. + !! SYGST reduces a real symmetric-definite generalized eigenproblem + !! to standard form. + !! If ITYPE = 1, the problem is A*x = lambda*B*x, + !! and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) + !! 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**T or L**T*A*L. + !! B must have been previously factorized as U**T*U or L*L**T by DPOTRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsygst( itype, uplo, n, a, lda, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -23395,11 +23391,11 @@ module stdlib_linalg_lapack interface sygv - !> SYGV computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric and B is also - !> positive definite. + !! SYGV computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric and B is also + !! positive definite. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsygv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, info ) @@ -23436,17 +23432,17 @@ module stdlib_linalg_lapack interface sygvd - !> SYGVD computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric 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. + !! SYGVD computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsygvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, iwork, & liwork, info ) @@ -23483,10 +23479,10 @@ module stdlib_linalg_lapack interface symv - !> SYMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix. + !! SYMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csymv( uplo, n, alpha, a, lda, x, incx, beta, y, incy ) import sp,dp,qp,ilp,lk @@ -23519,10 +23515,10 @@ module stdlib_linalg_lapack interface syr - !> SYR performs the symmetric rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a complex scalar, x is an n element vector and A is an - !> n by n symmetric matrix. + !! SYR performs the symmetric rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a complex scalar, x is an n element vector and A is an + !! n by n symmetric matrix. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyr( uplo, n, alpha, x, incx, a, lda ) import sp,dp,qp,ilp,lk @@ -23555,9 +23551,9 @@ module stdlib_linalg_lapack interface syrfs - !> SYRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite, and - !> provides error bounds and backward error estimates for the solution. + !! SYRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric indefinite, and + !! provides error bounds and backward error estimates for the solution. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr,& berr, work, rwork, info ) @@ -23631,17 +23627,17 @@ module stdlib_linalg_lapack interface sysv - !> SYSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> The 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 symmetric 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. + !! SYSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! The 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 symmetric 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -23709,16 +23705,16 @@ module stdlib_linalg_lapack interface sysv_aa - !> CSYSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> Aasen's algorithm is used to factor A as - !> A = U**T * T * U, if UPLO = 'U', or - !> A = L * T * L**T, if UPLO = 'L', - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and T is symmetric tridiagonal. The factored - !> form of A is then used to solve the system of equations A * X = B. + !! CSYSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! Aasen's algorithm is used to factor A as + !! A = U**T * T * U, if UPLO = 'U', or + !! A = L * T * L**T, if UPLO = 'L', + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and T is symmetric tridiagonal. The factored + !! form of A is then used to solve the system of equations A * X = B. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -23786,20 +23782,20 @@ module stdlib_linalg_lapack interface sysv_rk - !> SYSV_RK computes the solution to a complex system of linear - !> equations A * X = B, where A is an N-by-N symmetric 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**T)*(P**T), if UPLO = 'U', or - !> A = P*L*D*(L**T)*(P**T), if UPLO = 'L', - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric and block - !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. - !> CSYTRF_RK is called to compute the factorization of a complex - !> symmetric matrix. The factored form of A is then used to solve - !> the system of equations A * X = B by calling BLAS3 routine CSYTRS_3. + !! SYSV_RK computes the solution to a complex system of linear + !! equations A * X = B, where A is an N-by-N symmetric 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**T)*(P**T), if UPLO = 'U', or + !! A = P*L*D*(L**T)*(P**T), if UPLO = 'L', + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric and block + !! diagonal with 1-by-1 and 2-by-2 diagonal blocks. + !! CSYTRF_RK is called to compute the factorization of a complex + !! symmetric matrix. The factored form of A is then used to solve + !! the system of equations A * X = B by calling BLAS3 routine CSYTRS_3. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info & ) @@ -23867,22 +23863,22 @@ module stdlib_linalg_lapack interface sysv_rook - !> SYSV_ROOK computes the solution to a complex system of linear - !> equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> The 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 symmetric and block diagonal with - !> 1-by-1 and 2-by-2 diagonal blocks. - !> CSYTRF_ROOK is called to compute the factorization of a complex - !> symmetric 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 CSYTRS_ROOK. + !! SYSV_ROOK computes the solution to a complex system of linear + !! equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! The 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 symmetric and block diagonal with + !! 1-by-1 and 2-by-2 diagonal blocks. + !! CSYTRF_ROOK is called to compute the factorization of a complex + !! symmetric 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 CSYTRS_ROOK. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -23950,8 +23946,8 @@ module stdlib_linalg_lapack interface syswapr - !> SYSWAPR applies an elementary permutation on the rows and the columns of - !> a symmetric matrix. + !! SYSWAPR applies an elementary permutation on the rows and the columns of + !! a symmetric matrix. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyswapr( uplo, n, a, lda, i1, i2) import sp,dp,qp,ilp,lk @@ -24007,15 +24003,15 @@ module stdlib_linalg_lapack interface sytf2_rk - !> SYTF2_RK computes the factorization of a complex symmetric matrix A - !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric 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. + !! SYTF2_RK computes the factorization of a complex symmetric matrix A + !! using the bounded Bunch-Kaufman (rook) diagonal pivoting method: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytf2_rk( uplo, n, a, lda, e, ipiv, info ) import sp,dp,qp,ilp,lk @@ -24079,13 +24075,13 @@ module stdlib_linalg_lapack interface sytf2_rook - !> SYTF2_ROOK computes the factorization of a complex symmetric matrix A - !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: - !> 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, U**T is the transpose of U, and D is symmetric 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. + !! SYTF2_ROOK computes the factorization of a complex symmetric matrix A + !! using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: + !! 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, U**T is the transpose of U, and D is symmetric 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytf2_rook( uplo, n, a, lda, ipiv, info ) import sp,dp,qp,ilp,lk @@ -24145,9 +24141,9 @@ module stdlib_linalg_lapack interface sytrd - !> SYTRD reduces a real symmetric matrix A to real symmetric - !> tridiagonal form T by an orthogonal similarity transformation: - !> Q**T * A * Q = T. + !! SYTRD reduces a real symmetric matrix A to real symmetric + !! tridiagonal form T by an orthogonal similarity transformation: + !! Q**T * A * Q = T. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsytrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -24182,9 +24178,9 @@ module stdlib_linalg_lapack interface sytrd_sb2st - !> SYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric - !> tridiagonal form T by a orthogonal similarity transformation: - !> Q**T * A * Q = T. + !! SYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric + !! tridiagonal form T by a orthogonal similarity transformation: + !! Q**T * A * Q = T. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, & lhous, work, lwork, info ) @@ -24221,9 +24217,9 @@ module stdlib_linalg_lapack interface sytrd_sy2sb - !> SYTRD_SY2SB reduces a real symmetric matrix A to real symmetric - !> band-diagonal form AB by a orthogonal similarity transformation: - !> Q**T * A * Q = AB. + !! SYTRD_SY2SB reduces a real symmetric matrix A to real symmetric + !! band-diagonal form AB by a orthogonal similarity transformation: + !! Q**T * A * Q = AB. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dsytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info & ) @@ -24260,14 +24256,14 @@ module stdlib_linalg_lapack interface sytrf - !> SYTRF computes the factorization of a complex symmetric matrix A - !> using the Bunch-Kaufman 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 symmetric 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. + !! SYTRF computes the factorization of a complex symmetric matrix A + !! using the Bunch-Kaufman 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 symmetric 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrf( uplo, n, a, lda, ipiv, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -24331,12 +24327,12 @@ module stdlib_linalg_lapack interface sytrf_aa - !> SYTRF_AA computes the factorization of a complex symmetric matrix A - !> using the Aasen's algorithm. The form of the factorization is - !> A = U**T*T*U or A = L*T*L**T - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and T is a complex symmetric tridiagonal matrix. - !> This is the blocked version of the algorithm, calling Level 3 BLAS. + !! SYTRF_AA computes the factorization of a complex symmetric matrix A + !! using the Aasen's algorithm. The form of the factorization is + !! A = U**T*T*U or A = L*T*L**T + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and T is a complex symmetric tridiagonal matrix. + !! This is the blocked version of the algorithm, calling Level 3 BLAS. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) import sp,dp,qp,ilp,lk @@ -24400,15 +24396,15 @@ module stdlib_linalg_lapack interface sytrf_rk - !> SYTRF_RK computes the factorization of a complex symmetric matrix A - !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric 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. + !! SYTRF_RK computes the factorization of a complex symmetric matrix A + !! using the bounded Bunch-Kaufman (rook) diagonal pivoting method: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -24472,14 +24468,14 @@ module stdlib_linalg_lapack interface sytrf_rook - !> SYTRF_ROOK computes the factorization of a complex symmetric 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 symmetric 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. + !! SYTRF_ROOK computes the factorization of a complex symmetric 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 symmetric 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -24543,9 +24539,9 @@ module stdlib_linalg_lapack interface sytri - !> SYTRI computes the inverse of a complex symmetric indefinite matrix - !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by - !> CSYTRF. + !! SYTRI computes the inverse of a complex symmetric indefinite matrix + !! A using the factorization A = U*D*U**T or A = L*D*L**T computed by + !! CSYTRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytri( uplo, n, a, lda, ipiv, work, info ) import sp,dp,qp,ilp,lk @@ -24609,9 +24605,9 @@ module stdlib_linalg_lapack interface sytri_rook - !> SYTRI_ROOK computes the inverse of a complex symmetric - !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T - !> computed by CSYTRF_ROOK. + !! SYTRI_ROOK computes the inverse of a complex symmetric + !! matrix A using the factorization A = U*D*U**T or A = L*D*L**T + !! computed by CSYTRF_ROOK. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytri_rook( uplo, n, a, lda, ipiv, work, info ) import sp,dp,qp,ilp,lk @@ -24675,9 +24671,9 @@ module stdlib_linalg_lapack interface sytrs - !> SYTRS solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by CSYTRF. + !! SYTRS solves a system of linear equations A*X = B with a complex + !! symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by CSYTRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -24741,9 +24737,9 @@ module stdlib_linalg_lapack interface sytrs2 - !> SYTRS2 solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by CSYTRF and converted by CSYCONV. + !! SYTRS2 solves a system of linear equations A*X = B with a complex + !! symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by CSYTRF and converted by CSYCONV. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) import sp,dp,qp,ilp,lk @@ -24807,15 +24803,15 @@ module stdlib_linalg_lapack interface sytrs_3 - !> SYTRS_3 solves a system of linear equations A * X = B with a complex - !> symmetric matrix A using the factorization computed - !> by CSYTRF_RK or CSYTRF_BK: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric and block - !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. - !> This algorithm is using Level 3 BLAS. + !! SYTRS_3 solves a system of linear equations A * X = B with a complex + !! symmetric matrix A using the factorization computed + !! by CSYTRF_RK or CSYTRF_BK: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric and block + !! diagonal with 1-by-1 and 2-by-2 diagonal blocks. + !! This algorithm is using Level 3 BLAS. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) import sp,dp,qp,ilp,lk @@ -24879,9 +24875,9 @@ module stdlib_linalg_lapack interface sytrs_aa - !> SYTRS_AA solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U**T*T*U or - !> A = L*T*L**T computed by CSYTRF_AA. + !! SYTRS_AA solves a system of linear equations A*X = B with a complex + !! symmetric matrix A using the factorization A = U**T*T*U or + !! A = L*T*L**T computed by CSYTRF_AA. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) @@ -24953,9 +24949,9 @@ module stdlib_linalg_lapack interface sytrs_rook - !> SYTRS_ROOK solves a system of linear equations A*X = B with - !> a complex symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by CSYTRF_ROOK. + !! SYTRS_ROOK solves a system of linear equations A*X = B with + !! a complex symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by CSYTRF_ROOK. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) import sp,dp,qp,ilp,lk @@ -25019,12 +25015,12 @@ module stdlib_linalg_lapack interface tbcon - !> TBCON estimates the reciprocal of the condition number of a - !> triangular band matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! TBCON estimates the reciprocal of the condition number of a + !! triangular band matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). #ifdef STDLIB_EXTERNAL_LAPACK subroutine ctbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,rwork, info ) @@ -25094,12 +25090,12 @@ module stdlib_linalg_lapack interface tbrfs - !> TBRFS provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular band - !> coefficient matrix. - !> The solution matrix X must be computed by CTBTRS or some other - !> means before entering this routine. TBRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! TBRFS provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular band + !! coefficient matrix. + !! The solution matrix X must be computed by CTBTRS or some other + !! means before entering this routine. TBRFS does not do iterative + !! refinement because doing so cannot improve the backward error. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, & ferr, berr, work, rwork, info ) @@ -25169,10 +25165,10 @@ module stdlib_linalg_lapack interface tbtrs - !> TBTRS solves a triangular system of the form - !> A * X = B, A**T * X = B, or A**H * X = B, - !> where A is a triangular band matrix of order N, and B is an - !> N-by-NRHS matrix. A check is made to verify that A is nonsingular. + !! TBTRS solves a triangular system of the form + !! A * X = B, A**T * X = B, or A**H * X = B, + !! where A is a triangular band matrix of order N, and B is an + !! N-by-NRHS matrix. A check is made to verify that A is nonsingular. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) @@ -25240,14 +25236,14 @@ module stdlib_linalg_lapack interface tfsm - !> Level 3 BLAS like routine for A in RFP Format. - !> TFSM solves the matrix equation - !> op( A )*X = alpha*B or X*op( A ) = alpha*B - !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**H. - !> A is in Rectangular Full Packed (RFP) Format. - !> The matrix X is overwritten on B. + !! Level 3 BLAS like routine for A in RFP Format. + !! TFSM solves the matrix equation + !! op( A )*X = alpha*B or X*op( A ) = alpha*B + !! where alpha is a scalar, X and B are m by n matrices, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**H. + !! A is in Rectangular Full Packed (RFP) Format. + !! The matrix X is overwritten on B. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) @@ -25311,9 +25307,9 @@ module stdlib_linalg_lapack interface tftri - !> TFTRI computes the inverse of a triangular matrix A stored in RFP - !> format. - !> This is a Level 3 BLAS version of the algorithm. + !! TFTRI computes the inverse of a triangular matrix A stored in RFP + !! format. + !! This is a Level 3 BLAS version of the algorithm. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctftri( transr, uplo, diag, n, a, info ) import sp,dp,qp,ilp,lk @@ -25373,8 +25369,8 @@ module stdlib_linalg_lapack interface tfttp - !> TFTTP copies a triangular matrix A from rectangular full packed - !> format (TF) to standard packed format (TP). + !! TFTTP copies a triangular matrix A from rectangular full packed + !! format (TF) to standard packed format (TP). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctfttp( transr, uplo, n, arf, ap, info ) import sp,dp,qp,ilp,lk @@ -25438,8 +25434,8 @@ module stdlib_linalg_lapack interface tfttr - !> TFTTR copies a triangular matrix A from rectangular full packed - !> format (TF) to standard full format (TR). + !! TFTTR copies a triangular matrix A from rectangular full packed + !! format (TF) to standard full format (TR). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctfttr( transr, uplo, n, arf, a, lda, info ) import sp,dp,qp,ilp,lk @@ -25503,24 +25499,24 @@ module stdlib_linalg_lapack interface tgevc - !> TGEVC computes some or all of the right and/or left eigenvectors of - !> a pair of complex matrices (S,P), where S and P are upper triangular. - !> Matrix pairs of this type are produced by the generalized Schur - !> factorization of a complex matrix pair (A,B): - !> A = Q*S*Z**H, B = Q*P*Z**H - !> as computed by CGGHRD + CHGEQZ. - !> The right eigenvector x and the left eigenvector y of (S,P) - !> corresponding to an eigenvalue w are defined by: - !> S*x = w*P*x, (y**H)*S = w*(y**H)*P, - !> where y**H denotes the conjugate tranpose of y. - !> The eigenvalues are not input to this routine, but are computed - !> directly from the diagonal elements of S and P. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of (S,P), or the products Z*X and/or Q*Y, - !> where Z and Q are input matrices. - !> If Q and Z are the unitary factors from the generalized Schur - !> factorization of a matrix pair (A,B), then Z*X and Q*Y - !> are the matrices of right and left eigenvectors of (A,B). + !! TGEVC computes some or all of the right and/or left eigenvectors of + !! a pair of complex matrices (S,P), where S and P are upper triangular. + !! Matrix pairs of this type are produced by the generalized Schur + !! factorization of a complex matrix pair (A,B): + !! A = Q*S*Z**H, B = Q*P*Z**H + !! as computed by CGGHRD + CHGEQZ. + !! The right eigenvector x and the left eigenvector y of (S,P) + !! corresponding to an eigenvalue w are defined by: + !! S*x = w*P*x, (y**H)*S = w*(y**H)*P, + !! where y**H denotes the conjugate tranpose of y. + !! The eigenvalues are not input to this routine, but are computed + !! directly from the diagonal elements of S and P. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of (S,P), or the products Z*X and/or Q*Y, + !! where Z and Q are input matrices. + !! If Q and Z are the unitary factors from the generalized Schur + !! factorization of a matrix pair (A,B), then Z*X and Q*Y + !! are the matrices of right and left eigenvectors of (A,B). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr,& mm, m, work, rwork, info ) @@ -25598,16 +25594,16 @@ module stdlib_linalg_lapack interface tgexc - !> TGEXC reorders the generalized Schur decomposition of a complex - !> matrix pair (A,B), using an unitary equivalence transformation - !> (A, B) := Q * (A, B) * Z**H, so that the diagonal block of (A, B) with - !> row index IFST is moved to row ILST. - !> (A, B) must be in generalized Schur canonical form, that is, A and - !> B are both upper triangular. - !> Optionally, the matrices Q and Z of generalized Schur vectors are - !> updated. - !> Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H - !> Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H + !! TGEXC reorders the generalized Schur decomposition of a complex + !! matrix pair (A,B), using an unitary equivalence transformation + !! (A, B) := Q * (A, B) * Z**H, so that the diagonal block of (A, B) with + !! row index IFST is moved to row ILST. + !! (A, B) must be in generalized Schur canonical form, that is, A and + !! B are both upper triangular. + !! Optionally, the matrices Q and Z of generalized Schur vectors are + !! updated. + !! Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H + !! Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst,& info ) @@ -25677,24 +25673,24 @@ module stdlib_linalg_lapack interface tgsen - !> TGSEN reorders the generalized Schur decomposition of a complex - !> matrix pair (A, B) (in terms of an unitary equivalence trans- - !> formation Q**H * (A, B) * Z), so that a selected cluster of eigenvalues - !> appears in the leading diagonal blocks of the pair (A,B). The leading - !> columns of Q and Z form unitary bases of the corresponding left and - !> right eigenspaces (deflating subspaces). (A, B) must be in - !> generalized Schur canonical form, that is, A and B are both upper - !> triangular. - !> TGSEN also computes the generalized eigenvalues - !> w(j)= ALPHA(j) / BETA(j) - !> of the reordered matrix pair (A, B). - !> Optionally, the routine computes estimates of reciprocal condition - !> numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11), - !> (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s) - !> between the matrix pairs (A11, B11) and (A22,B22) that correspond to - !> the selected cluster and the eigenvalues outside the cluster, resp., - !> and norms of "projections" onto left and right eigenspaces w.r.t. - !> the selected cluster in the (1,1)-block. + !! TGSEN reorders the generalized Schur decomposition of a complex + !! matrix pair (A, B) (in terms of an unitary equivalence trans- + !! formation Q**H * (A, B) * Z), so that a selected cluster of eigenvalues + !! appears in the leading diagonal blocks of the pair (A,B). The leading + !! columns of Q and Z form unitary bases of the corresponding left and + !! right eigenspaces (deflating subspaces). (A, B) must be in + !! generalized Schur canonical form, that is, A and B are both upper + !! triangular. + !! TGSEN also computes the generalized eigenvalues + !! w(j)= ALPHA(j) / BETA(j) + !! of the reordered matrix pair (A, B). + !! Optionally, the routine computes estimates of reciprocal condition + !! numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11), + !! (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s) + !! between the matrix pairs (A11, B11) and (A22,B22) that correspond to + !! the selected cluster and the eigenvalues outside the cluster, resp., + !! and norms of "projections" onto left and right eigenspaces w.r.t. + !! the selected cluster in the (1,1)-block. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alpha, beta, & q, ldq, z, ldz, m, pl, pr, dif,work, lwork, iwork, liwork, info ) @@ -25768,68 +25764,68 @@ module stdlib_linalg_lapack interface tgsja - !> TGSJA computes the generalized singular value decomposition (GSVD) - !> of two complex upper triangular (or trapezoidal) matrices A and B. - !> On entry, it is assumed that matrices A and B have the following - !> forms, which may be obtained by the preprocessing subroutine CGGSVP - !> from a general M-by-N matrix A and P-by-N matrix B: - !> N-K-L K L - !> A = K ( 0 A12 A13 ) if M-K-L >= 0; - !> L ( 0 0 A23 ) - !> M-K-L ( 0 0 0 ) - !> N-K-L K L - !> A = K ( 0 A12 A13 ) if M-K-L < 0; - !> M-K ( 0 0 A23 ) - !> N-K-L K L - !> B = L ( 0 0 B13 ) - !> P-L ( 0 0 0 ) - !> where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular - !> upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, - !> otherwise A23 is (M-K)-by-L upper trapezoidal. - !> On exit, - !> U**H *A*Q = D1*( 0 R ), V**H *B*Q = D2*( 0 R ), - !> where U, V and Q are unitary matrices. - !> R is a nonsingular upper triangular matrix, and D1 - !> and D2 are ``diagonal'' matrices, which are of the following - !> structures: - !> If M-K-L >= 0, - !> K L - !> D1 = K ( I 0 ) - !> L ( 0 C ) - !> M-K-L ( 0 0 ) - !> K L - !> D2 = L ( 0 S ) - !> P-L ( 0 0 ) - !> N-K-L K L - !> ( 0 R ) = K ( 0 R11 R12 ) K - !> L ( 0 0 R22 ) L - !> where - !> C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), - !> S = diag( BETA(K+1), ... , BETA(K+L) ), - !> C**2 + S**2 = I. - !> R is stored in A(1:K+L,N-K-L+1:N) on exit. - !> If M-K-L < 0, - !> K M-K K+L-M - !> D1 = K ( I 0 0 ) - !> M-K ( 0 C 0 ) - !> K M-K K+L-M - !> D2 = M-K ( 0 S 0 ) - !> K+L-M ( 0 0 I ) - !> P-L ( 0 0 0 ) - !> N-K-L K M-K K+L-M - !> ( 0 R ) = K ( 0 R11 R12 R13 ) - !> M-K ( 0 0 R22 R23 ) - !> K+L-M ( 0 0 0 R33 ) - !> where - !> C = diag( ALPHA(K+1), ... , ALPHA(M) ), - !> S = diag( BETA(K+1), ... , BETA(M) ), - !> C**2 + S**2 = I. - !> R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored - !> ( 0 R22 R23 ) - !> in B(M-K+1:L,N+M-K-L+1:N) on exit. - !> The computation of the unitary transformation matrices U, V or Q - !> is optional. These matrices may either be formed explicitly, or they - !> may be postmultiplied into input matrices U1, V1, or Q1. + !! TGSJA computes the generalized singular value decomposition (GSVD) + !! of two complex upper triangular (or trapezoidal) matrices A and B. + !! On entry, it is assumed that matrices A and B have the following + !! forms, which may be obtained by the preprocessing subroutine CGGSVP + !! from a general M-by-N matrix A and P-by-N matrix B: + !! N-K-L K L + !! A = K ( 0 A12 A13 ) if M-K-L >= 0; + !! L ( 0 0 A23 ) + !! M-K-L ( 0 0 0 ) + !! N-K-L K L + !! A = K ( 0 A12 A13 ) if M-K-L < 0; + !! M-K ( 0 0 A23 ) + !! N-K-L K L + !! B = L ( 0 0 B13 ) + !! P-L ( 0 0 0 ) + !! where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular + !! upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, + !! otherwise A23 is (M-K)-by-L upper trapezoidal. + !! On exit, + !! U**H *A*Q = D1*( 0 R ), V**H *B*Q = D2*( 0 R ), + !! where U, V and Q are unitary matrices. + !! R is a nonsingular upper triangular matrix, and D1 + !! and D2 are ``diagonal'' matrices, which are of the following + !! structures: + !! If M-K-L >= 0, + !! K L + !! D1 = K ( I 0 ) + !! L ( 0 C ) + !! M-K-L ( 0 0 ) + !! K L + !! D2 = L ( 0 S ) + !! P-L ( 0 0 ) + !! N-K-L K L + !! ( 0 R ) = K ( 0 R11 R12 ) K + !! L ( 0 0 R22 ) L + !! where + !! C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), + !! S = diag( BETA(K+1), ... , BETA(K+L) ), + !! C**2 + S**2 = I. + !! R is stored in A(1:K+L,N-K-L+1:N) on exit. + !! If M-K-L < 0, + !! K M-K K+L-M + !! D1 = K ( I 0 0 ) + !! M-K ( 0 C 0 ) + !! K M-K K+L-M + !! D2 = M-K ( 0 S 0 ) + !! K+L-M ( 0 0 I ) + !! P-L ( 0 0 0 ) + !! N-K-L K M-K K+L-M + !! ( 0 R ) = K ( 0 R11 R12 R13 ) + !! M-K ( 0 0 R22 R23 ) + !! K+L-M ( 0 0 0 R33 ) + !! where + !! C = diag( ALPHA(K+1), ... , ALPHA(M) ), + !! S = diag( BETA(K+1), ... , BETA(M) ), + !! C**2 + S**2 = I. + !! R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored + !! ( 0 R22 R23 ) + !! in B(M-K+1:L,N+M-K-L+1:N) on exit. + !! The computation of the unitary transformation matrices U, V or Q + !! is optional. These matrices may either be formed explicitly, or they + !! may be postmultiplied into input matrices U1, V1, or Q1. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb,& alpha, beta, u, ldu, v, ldv,q, ldq, work, ncycle, info ) @@ -25907,10 +25903,10 @@ module stdlib_linalg_lapack interface tgsna - !> TGSNA estimates reciprocal condition numbers for specified - !> eigenvalues and/or eigenvectors of a matrix pair (A, B). - !> (A, B) must be in generalized Schur canonical form, that is, A and - !> B are both upper triangular. + !! TGSNA estimates reciprocal condition numbers for specified + !! eigenvalues and/or eigenvectors of a matrix pair (A, B). + !! (A, B) must be in generalized Schur canonical form, that is, A and + !! B are both upper triangular. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, & s, dif, mm, m, work, lwork,iwork, info ) @@ -25984,33 +25980,33 @@ module stdlib_linalg_lapack interface tgsyl - !> TGSYL solves the generalized Sylvester equation: - !> A * R - L * B = scale * C (1) - !> D * R - L * E = scale * F - !> where R and L are unknown m-by-n matrices, (A, D), (B, E) and - !> (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n, - !> respectively, with complex entries. A, B, D and E are upper - !> triangular (i.e., (A,D) and (B,E) in generalized Schur form). - !> The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 - !> is an output scaling factor chosen to avoid overflow. - !> In matrix notation (1) is equivalent to solve Zx = scale*b, where Z - !> is defined as - !> Z = [ kron(In, A) -kron(B**H, Im) ] (2) - !> [ kron(In, D) -kron(E**H, Im) ], - !> Here Ix is the identity matrix of size x and X**H is the conjugate - !> transpose of X. Kron(X, Y) is the Kronecker product between the - !> matrices X and Y. - !> If TRANS = 'C', y in the conjugate transposed system Z**H *y = scale*b - !> is solved for, which is equivalent to solve for R and L in - !> A**H * R + D**H * L = scale * C (3) - !> R * B**H + L * E**H = scale * -F - !> This case (TRANS = 'C') is used to compute an one-norm-based estimate - !> of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D) - !> and (B,E), using CLACON. - !> If IJOB >= 1, TGSYL computes a Frobenius norm-based estimate of - !> Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the - !> reciprocal of the smallest singular value of Z. - !> This is a level-3 BLAS algorithm. + !! TGSYL solves the generalized Sylvester equation: + !! A * R - L * B = scale * C (1) + !! D * R - L * E = scale * F + !! where R and L are unknown m-by-n matrices, (A, D), (B, E) and + !! (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n, + !! respectively, with complex entries. A, B, D and E are upper + !! triangular (i.e., (A,D) and (B,E) in generalized Schur form). + !! The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 + !! is an output scaling factor chosen to avoid overflow. + !! In matrix notation (1) is equivalent to solve Zx = scale*b, where Z + !! is defined as + !! Z = [ kron(In, A) -kron(B**H, Im) ] (2) + !! [ kron(In, D) -kron(E**H, Im) ], + !! Here Ix is the identity matrix of size x and X**H is the conjugate + !! transpose of X. Kron(X, Y) is the Kronecker product between the + !! matrices X and Y. + !! If TRANS = 'C', y in the conjugate transposed system Z**H *y = scale*b + !! is solved for, which is equivalent to solve for R and L in + !! A**H * R + D**H * L = scale * C (3) + !! R * B**H + L * E**H = scale * -F + !! This case (TRANS = 'C') is used to compute an one-norm-based estimate + !! of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D) + !! and (B,E), using CLACON. + !! If IJOB >= 1, TGSYL computes a Frobenius norm-based estimate of + !! Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the + !! reciprocal of the smallest singular value of Z. + !! This is a level-3 BLAS algorithm. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, & f, ldf, scale, dif, work, lwork,iwork, info ) @@ -26084,12 +26080,12 @@ module stdlib_linalg_lapack interface tpcon - !> TPCON estimates the reciprocal of the condition number of a packed - !> triangular matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! TPCON estimates the reciprocal of the condition number of a packed + !! triangular matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). #ifdef STDLIB_EXTERNAL_LAPACK subroutine ctpcon( norm, uplo, diag, n, ap, rcond, work, rwork,info ) import sp,dp,qp,ilp,lk @@ -26155,10 +26151,10 @@ module stdlib_linalg_lapack interface tplqt - !> TPLQT computes a blocked LQ factorization of a complex - !> "triangular-pentagonal" matrix C, which is composed of a - !> triangular block A and pentagonal block B, using the compact - !> WY representation for Q. + !! TPLQT computes a blocked LQ factorization of a complex + !! "triangular-pentagonal" matrix C, which is composed of a + !! triangular block A and pentagonal block B, using the compact + !! WY representation for Q. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) import sp,dp,qp,ilp,lk @@ -26218,9 +26214,9 @@ module stdlib_linalg_lapack interface tplqt2 - !> TPLQT2 computes a LQ a factorization of a complex "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. + !! TPLQT2 computes a LQ a factorization of a complex "triangular-pentagonal" + !! matrix C, which is composed of a triangular block A and pentagonal block B, + !! using the compact WY representation for Q. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) import sp,dp,qp,ilp,lk @@ -26280,9 +26276,9 @@ module stdlib_linalg_lapack interface tpmlqt - !> TPMLQT applies a complex unitary matrix Q obtained from a - !> "triangular-pentagonal" complex block reflector H to a general - !> complex matrix C, which consists of two blocks A and B. + !! TPMLQT applies a complex unitary matrix Q obtained from a + !! "triangular-pentagonal" complex block reflector H to a general + !! complex matrix C, which consists of two blocks A and B. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, & ldb, work, info ) @@ -26354,9 +26350,9 @@ module stdlib_linalg_lapack interface tpmqrt - !> TPMQRT applies a complex orthogonal matrix Q obtained from a - !> "triangular-pentagonal" complex block reflector H to a general - !> complex matrix C, which consists of two blocks A and B. + !! TPMQRT applies a complex orthogonal matrix Q obtained from a + !! "triangular-pentagonal" complex block reflector H to a general + !! complex matrix C, which consists of two blocks A and B. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, & ldb, work, info ) @@ -26428,10 +26424,10 @@ module stdlib_linalg_lapack interface tpqrt - !> TPQRT computes a blocked QR factorization of a complex - !> "triangular-pentagonal" matrix C, which is composed of a - !> triangular block A and pentagonal block B, using the compact - !> WY representation for Q. + !! TPQRT computes a blocked QR factorization of a complex + !! "triangular-pentagonal" matrix C, which is composed of a + !! triangular block A and pentagonal block B, using the compact + !! WY representation for Q. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) import sp,dp,qp,ilp,lk @@ -26491,9 +26487,9 @@ module stdlib_linalg_lapack interface tpqrt2 - !> TPQRT2 computes a QR factorization of a complex "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. + !! TPQRT2 computes a QR factorization of a complex "triangular-pentagonal" + !! matrix C, which is composed of a triangular block A and pentagonal block B, + !! using the compact WY representation for Q. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) import sp,dp,qp,ilp,lk @@ -26553,9 +26549,9 @@ module stdlib_linalg_lapack interface tprfb - !> TPRFB applies a complex "triangular-pentagonal" block reflector H or its - !> conjugate transpose H**H to a complex matrix C, which is composed of two - !> blocks A and B, either from the left or right. + !! TPRFB applies a complex "triangular-pentagonal" block reflector H or its + !! conjugate transpose H**H to a complex matrix C, which is composed of two + !! blocks A and B, either from the left or right. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & lda, b, ldb, work, ldwork ) @@ -26623,12 +26619,12 @@ module stdlib_linalg_lapack interface tprfs - !> TPRFS provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular packed - !> coefficient matrix. - !> The solution matrix X must be computed by CTPTRS or some other - !> means before entering this routine. TPRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! TPRFS provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular packed + !! coefficient matrix. + !! The solution matrix X must be computed by CTPTRS or some other + !! means before entering this routine. TPRFS does not do iterative + !! refinement because doing so cannot improve the backward error. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & work, rwork, info ) @@ -26698,8 +26694,8 @@ module stdlib_linalg_lapack interface tptri - !> TPTRI computes the inverse of a complex upper or lower triangular - !> matrix A stored in packed format. + !! TPTRI computes the inverse of a complex upper or lower triangular + !! matrix A stored in packed format. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctptri( uplo, diag, n, ap, info ) import sp,dp,qp,ilp,lk @@ -26759,11 +26755,11 @@ module stdlib_linalg_lapack interface tptrs - !> TPTRS solves a triangular system of the form - !> A * X = B, A**T * X = B, or A**H * X = B, - !> where A is a triangular matrix of order N stored in packed format, - !> and B is an N-by-NRHS matrix. A check is made to verify that A is - !> nonsingular. + !! TPTRS solves a triangular system of the form + !! A * X = B, A**T * X = B, or A**H * X = B, + !! where A is a triangular matrix of order N stored in packed format, + !! and B is an N-by-NRHS matrix. A check is made to verify that A is + !! nonsingular. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -26827,8 +26823,8 @@ module stdlib_linalg_lapack interface tpttf - !> TPTTF copies a triangular matrix A from standard packed format (TP) - !> to rectangular full packed format (TF). + !! TPTTF copies a triangular matrix A from standard packed format (TP) + !! to rectangular full packed format (TF). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctpttf( transr, uplo, n, ap, arf, info ) import sp,dp,qp,ilp,lk @@ -26892,8 +26888,8 @@ module stdlib_linalg_lapack interface tpttr - !> TPTTR copies a triangular matrix A from standard packed format (TP) - !> to standard full format (TR). + !! TPTTR copies a triangular matrix A from standard packed format (TP) + !! to standard full format (TR). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctpttr( uplo, n, ap, a, lda, info ) import sp,dp,qp,ilp,lk @@ -26957,12 +26953,12 @@ module stdlib_linalg_lapack interface trcon - !> TRCON estimates the reciprocal of the condition number of a - !> triangular matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! TRCON estimates the reciprocal of the condition number of a + !! triangular matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). #ifdef STDLIB_EXTERNAL_LAPACK subroutine ctrcon( norm, uplo, diag, n, a, lda, rcond, work,rwork, info ) import sp,dp,qp,ilp,lk @@ -27028,21 +27024,21 @@ module stdlib_linalg_lapack interface trevc - !> TREVC computes some or all of the right and/or left eigenvectors of - !> a complex upper triangular matrix T. - !> Matrices of this type are produced by the Schur factorization of - !> a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. - !> The right eigenvector x and the left eigenvector y of T corresponding - !> to an eigenvalue w are defined by: - !> T*x = w*x, (y**H)*T = w*(y**H) - !> where y**H denotes the conjugate transpose of the vector y. - !> The eigenvalues are not input to this routine, but are read directly - !> from the diagonal of T. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an - !> input matrix. If Q is the unitary factor that reduces a matrix A to - !> Schur form T, then Q*X and Q*Y are the matrices of right and left - !> eigenvectors of A. + !! TREVC computes some or all of the right and/or left eigenvectors of + !! a complex upper triangular matrix T. + !! Matrices of this type are produced by the Schur factorization of + !! a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. + !! The right eigenvector x and the left eigenvector y of T corresponding + !! to an eigenvalue w are defined by: + !! T*x = w*x, (y**H)*T = w*(y**H) + !! where y**H denotes the conjugate transpose of the vector y. + !! The eigenvalues are not input to this routine, but are read directly + !! from the diagonal of T. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an + !! input matrix. If Q is the unitary factor that reduces a matrix A to + !! Schur form T, then Q*X and Q*Y are the matrices of right and left + !! eigenvectors of A. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & work, rwork, info ) @@ -27118,22 +27114,22 @@ module stdlib_linalg_lapack interface trevc3 - !> TREVC3 computes some or all of the right and/or left eigenvectors of - !> a complex upper triangular matrix T. - !> Matrices of this type are produced by the Schur factorization of - !> a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. - !> The right eigenvector x and the left eigenvector y of T corresponding - !> to an eigenvalue w are defined by: - !> T*x = w*x, (y**H)*T = w*(y**H) - !> where y**H denotes the conjugate transpose of the vector y. - !> The eigenvalues are not input to this routine, but are read directly - !> from the diagonal of T. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an - !> input matrix. If Q is the unitary factor that reduces a matrix A to - !> Schur form T, then Q*X and Q*Y are the matrices of right and left - !> eigenvectors of A. - !> This uses a Level 3 BLAS version of the back transformation. + !! TREVC3 computes some or all of the right and/or left eigenvectors of + !! a complex upper triangular matrix T. + !! Matrices of this type are produced by the Schur factorization of + !! a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. + !! The right eigenvector x and the left eigenvector y of T corresponding + !! to an eigenvalue w are defined by: + !! T*x = w*x, (y**H)*T = w*(y**H) + !! where y**H denotes the conjugate transpose of the vector y. + !! The eigenvalues are not input to this routine, but are read directly + !! from the diagonal of T. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an + !! input matrix. If Q is the unitary factor that reduces a matrix A to + !! Schur form T, then Q*X and Q*Y are the matrices of right and left + !! eigenvectors of A. + !! This uses a Level 3 BLAS version of the back transformation. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrevc3( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m,& work, lwork, rwork, lrwork, info) @@ -27209,12 +27205,12 @@ module stdlib_linalg_lapack interface trexc - !> TREXC reorders the Schur factorization of a complex matrix - !> A = Q*T*Q**H, so that the diagonal element of T with row index IFST - !> is moved to row ILST. - !> The Schur form T is reordered by a unitary similarity transformation - !> Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by - !> postmultplying it with Z. + !! TREXC reorders the Schur factorization of a complex matrix + !! A = Q*T*Q**H, so that the diagonal element of T with row index IFST + !! is moved to row ILST. + !! The Schur form T is reordered by a unitary similarity transformation + !! Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by + !! postmultplying it with Z. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrexc( compq, n, t, ldt, q, ldq, ifst, ilst, info ) import sp,dp,qp,ilp,lk @@ -27278,12 +27274,12 @@ module stdlib_linalg_lapack interface trrfs - !> TRRFS provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular - !> coefficient matrix. - !> The solution matrix X must be computed by CTRTRS or some other - !> means before entering this routine. TRRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! TRRFS provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular + !! coefficient matrix. + !! The solution matrix X must be computed by CTRTRS or some other + !! means before entering this routine. TRRFS does not do iterative + !! refinement because doing so cannot improve the backward error. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, & berr, work, rwork, info ) @@ -27353,13 +27349,13 @@ module stdlib_linalg_lapack interface trsen - !> TRSEN reorders the Schur factorization of a complex matrix - !> A = Q*T*Q**H, so that a selected cluster of eigenvalues appears in - !> the leading positions on the diagonal of the upper triangular matrix - !> T, and the leading columns of Q form an orthonormal basis of the - !> corresponding right invariant subspace. - !> Optionally the routine computes the reciprocal condition numbers of - !> the cluster of eigenvalues and/or the invariant subspace. + !! TRSEN reorders the Schur factorization of a complex matrix + !! A = Q*T*Q**H, so that a selected cluster of eigenvalues appears in + !! the leading positions on the diagonal of the upper triangular matrix + !! T, and the leading columns of Q form an orthonormal basis of the + !! corresponding right invariant subspace. + !! Optionally the routine computes the reciprocal condition numbers of + !! the cluster of eigenvalues and/or the invariant subspace. #ifdef STDLIB_EXTERNAL_LAPACK subroutine ctrsen( job, compq, select, n, t, ldt, q, ldq, w, m, s,sep, work, lwork,& info ) @@ -27433,9 +27429,9 @@ module stdlib_linalg_lapack interface trsna - !> TRSNA estimates reciprocal condition numbers for specified - !> eigenvalues and/or right eigenvectors of a complex upper triangular - !> matrix T (or of any matrix Q*T*Q**H with Q unitary). + !! TRSNA estimates reciprocal condition numbers for specified + !! eigenvalues and/or right eigenvectors of a complex upper triangular + !! matrix T (or of any matrix Q*T*Q**H with Q unitary). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, & mm, m, work, ldwork, rwork,info ) @@ -27509,13 +27505,13 @@ module stdlib_linalg_lapack interface trsyl - !> TRSYL solves the complex Sylvester matrix equation: - !> op(A)*X + X*op(B) = scale*C or - !> op(A)*X - X*op(B) = scale*C, - !> where op(A) = A or A**H, and A and B are both upper triangular. A is - !> M-by-M and B is N-by-N; the right hand side C and the solution X are - !> M-by-N; and scale is an output scale factor, set <= 1 to avoid - !> overflow in X. + !! TRSYL solves the complex Sylvester matrix equation: + !! op(A)*X + X*op(B) = scale*C or + !! op(A)*X - X*op(B) = scale*C, + !! where op(A) = A or A**H, and A and B are both upper triangular. A is + !! M-by-M and B is N-by-N; the right hand side C and the solution X are + !! M-by-N; and scale is an output scale factor, set <= 1 to avoid + !! overflow in X. #ifdef STDLIB_EXTERNAL_LAPACK subroutine ctrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) @@ -27587,9 +27583,9 @@ module stdlib_linalg_lapack interface trtri - !> TRTRI computes the inverse of a complex upper or lower triangular - !> matrix A. - !> This is the Level 3 BLAS version of the algorithm. + !! TRTRI computes the inverse of a complex upper or lower triangular + !! matrix A. + !! This is the Level 3 BLAS version of the algorithm. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrtri( uplo, diag, n, a, lda, info ) import sp,dp,qp,ilp,lk @@ -27649,10 +27645,10 @@ module stdlib_linalg_lapack interface trtrs - !> TRTRS solves a triangular system of the form - !> A * X = B, A**T * X = B, or A**H * X = B, - !> where A is a triangular matrix of order N, and B is an N-by-NRHS - !> matrix. A check is made to verify that A is nonsingular. + !! TRTRS solves a triangular system of the form + !! A * X = B, A**T * X = B, or A**H * X = B, + !! where A is a triangular matrix of order N, and B is an N-by-NRHS + !! matrix. A check is made to verify that A is nonsingular. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) import sp,dp,qp,ilp,lk @@ -27716,8 +27712,8 @@ module stdlib_linalg_lapack interface trttf - !> TRTTF copies a triangular matrix A from standard full format (TR) - !> to rectangular full packed format (TF) . + !! TRTTF copies a triangular matrix A from standard full format (TR) + !! to rectangular full packed format (TF) . #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrttf( transr, uplo, n, a, lda, arf, info ) import sp,dp,qp,ilp,lk @@ -27781,8 +27777,8 @@ module stdlib_linalg_lapack interface trttp - !> TRTTP copies a triangular matrix A from full format (TR) to standard - !> packed format (TP). + !! TRTTP copies a triangular matrix A from full format (TR) to standard + !! packed format (TP). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrttp( uplo, n, a, lda, ap, info ) import sp,dp,qp,ilp,lk @@ -27846,12 +27842,12 @@ module stdlib_linalg_lapack interface tzrzf - !> TZRZF reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A - !> to upper triangular form by means of unitary transformations. - !> The upper trapezoidal matrix A is factored as - !> A = ( R 0 ) * Z, - !> where Z is an N-by-N unitary matrix and R is an M-by-M upper - !> triangular matrix. + !! TZRZF reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A + !! to upper triangular form by means of unitary transformations. + !! The upper trapezoidal matrix A is factored as + !! A = ( R 0 ) * Z, + !! where Z is an N-by-N unitary matrix and R is an M-by-M upper + !! triangular matrix. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctzrzf( m, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -27911,22 +27907,22 @@ module stdlib_linalg_lapack interface unbdb - !> UNBDB simultaneously bidiagonalizes the blocks of an M-by-M - !> partitioned unitary matrix X: - !> [ B11 | B12 0 0 ] - !> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**H - !> X = [-----------] = [---------] [----------------] [---------] . - !> [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] - !> [ 0 | 0 0 I ] - !> X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is - !> not the case, 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 unitary matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- - !> (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are - !> represented implicitly by Householder vectors. - !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! UNBDB simultaneously bidiagonalizes the blocks of an M-by-M + !! partitioned unitary matrix X: + !! [ B11 | B12 0 0 ] + !! [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**H + !! X = [-----------] = [---------] [----------------] [---------] . + !! [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] + !! [ 0 | 0 0 I ] + !! X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is + !! not the case, 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 unitary matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- + !! (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are + !! represented implicitly by Householder vectors. + !! B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented + !! implicitly by angles THETA, PHI. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cunbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) @@ -27969,21 +27965,21 @@ module stdlib_linalg_lapack interface unbdb1 - !> UNBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, - !> M-P, or M-Q. Routines CUNBDB2, CUNBDB3, and CUNBDB4 handle cases in - !> which Q is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! UNBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, + !! M-P, or M-Q. Routines CUNBDB2, CUNBDB3, and CUNBDB4 handle cases in + !! which Q is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by + !! angles THETA, PHI. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cunbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -28020,21 +28016,21 @@ module stdlib_linalg_lapack interface unbdb2 - !> UNBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, - !> Q, or M-Q. Routines CUNBDB1, CUNBDB3, and CUNBDB4 handle cases in - !> which P is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! UNBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, + !! Q, or M-Q. Routines CUNBDB1, CUNBDB3, and CUNBDB4 handle cases in + !! which P is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are P-by-P bidiagonal matrices represented implicitly by + !! angles THETA, PHI. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cunbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -28071,21 +28067,21 @@ module stdlib_linalg_lapack interface unbdb3 - !> UNBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, - !> Q, or M-Q. Routines CUNBDB1, CUNBDB2, and CUNBDB4 handle cases in - !> which M-P is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! UNBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, + !! Q, or M-Q. Routines CUNBDB1, CUNBDB2, and CUNBDB4 handle cases in + !! which M-P is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cunbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -28122,21 +28118,21 @@ module stdlib_linalg_lapack interface unbdb4 - !> UNBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, - !> M-P, or Q. Routines CUNBDB1, CUNBDB2, and CUNBDB3 handle cases in - !> which M-Q is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! UNBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, + !! M-P, or Q. Routines CUNBDB1, CUNBDB2, and CUNBDB3 handle cases in + !! which M-Q is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cunbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, phantom, work, lwork,info ) @@ -28175,17 +28171,17 @@ module stdlib_linalg_lapack interface unbdb5 - !> UNBDB5 orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then some other vector from the orthogonal complement - !> is returned. This vector is chosen in an arbitrary but deterministic - !> way. + !! UNBDB5 orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then some other vector from the orthogonal complement + !! is returned. This vector is chosen in an arbitrary but deterministic + !! way. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) @@ -28222,15 +28218,15 @@ module stdlib_linalg_lapack interface unbdb6 - !> UNBDB6 orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then the zero vector is returned. + !! UNBDB6 orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then the zero vector is returned. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) @@ -28267,19 +28263,19 @@ module stdlib_linalg_lapack interface uncsd - !> UNCSD computes the CS decomposition of an M-by-M partitioned - !> unitary matrix X: - !> [ I 0 0 | 0 0 0 ] - !> [ 0 C 0 | 0 -S 0 ] - !> [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**H - !> X = [-----------] = [---------] [---------------------] [---------] . - !> [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] - !> [ 0 S 0 | 0 C 0 ] - !> [ 0 0 I | 0 0 0 ] - !> X11 is P-by-Q. The unitary matrices U1, U2, V1, and V2 are P-by-P, - !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are - !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in - !> which R = MIN(P,M-P,Q,M-Q). + !! UNCSD computes the CS decomposition of an M-by-M partitioned + !! unitary matrix X: + !! [ I 0 0 | 0 0 0 ] + !! [ 0 C 0 | 0 -S 0 ] + !! [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**H + !! X = [-----------] = [---------] [---------------------] [---------] . + !! [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] + !! [ 0 S 0 | 0 C 0 ] + !! [ 0 0 I | 0 0 0 ] + !! X11 is P-by-Q. The unitary matrices U1, U2, V1, and V2 are P-by-P, + !! (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are + !! R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in + !! which R = MIN(P,M-P,Q,M-Q). #ifdef STDLIB_EXTERNAL_LAPACK recursive subroutine cuncsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, & x11, ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, & @@ -28326,21 +28322,21 @@ module stdlib_linalg_lapack interface uncsd2by1 - !> UNCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with - !> orthonormal columns that has been partitioned into a 2-by-1 block - !> structure: - !> [ I1 0 0 ] - !> [ 0 C 0 ] - !> [ X11 ] [ U1 | ] [ 0 0 0 ] - !> X = [-----] = [---------] [----------] V1**T . - !> [ X21 ] [ | U2 ] [ 0 0 0 ] - !> [ 0 S 0 ] - !> [ 0 0 I2] - !> X11 is P-by-Q. The unitary matrices U1, U2, and V1 are P-by-P, - !> (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R - !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which - !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a - !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). + !! UNCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with + !! orthonormal columns that has been partitioned into a 2-by-1 block + !! structure: + !! [ I1 0 0 ] + !! [ 0 C 0 ] + !! [ X11 ] [ U1 | ] [ 0 0 0 ] + !! X = [-----] = [---------] [----------] V1**T . + !! [ X21 ] [ | U2 ] [ 0 0 0 ] + !! [ 0 S 0 ] + !! [ 0 0 I2] + !! X11 is P-by-Q. The unitary matrices U1, U2, and V1 are P-by-P, + !! (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R + !! nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which + !! R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a + !! K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). #ifdef STDLIB_EXTERNAL_LAPACK subroutine cuncsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta,& u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, rwork, lrwork, iwork,info ) @@ -28381,11 +28377,11 @@ module stdlib_linalg_lapack interface ung2l - !> UNG2L generates an m by n complex matrix Q with orthonormal columns, - !> which is defined as the last n columns of a product of k elementary - !> reflectors of order m - !> Q = H(k) . . . H(2) H(1) - !> as returned by CGEQLF. + !! UNG2L generates an m by n complex matrix Q with orthonormal columns, + !! which is defined as the last n columns of a product of k elementary + !! reflectors of order m + !! Q = H(k) . . . H(2) H(1) + !! as returned by CGEQLF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cung2l( m, n, k, a, lda, tau, work, info ) import sp,dp,qp,ilp,lk @@ -28420,11 +28416,11 @@ module stdlib_linalg_lapack interface ung2r - !> UNG2R generates an m by n complex matrix Q with orthonormal columns, - !> which is defined as the first n columns of a product of k elementary - !> reflectors of order m - !> Q = H(1) H(2) . . . H(k) - !> as returned by CGEQRF. + !! UNG2R generates an m by n complex matrix Q with orthonormal columns, + !! which is defined as the first n columns of a product of k elementary + !! reflectors of order m + !! Q = H(1) H(2) . . . H(k) + !! as returned by CGEQRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cung2r( m, n, k, a, lda, tau, work, info ) import sp,dp,qp,ilp,lk @@ -28459,22 +28455,22 @@ module stdlib_linalg_lapack interface ungbr - !> UNGBR generates one of the complex unitary matrices Q or P**H - !> determined by CGEBRD when reducing a complex matrix A to bidiagonal - !> form: A = Q * B * P**H. Q and P**H are defined as products of - !> elementary reflectors H(i) or G(i) respectively. - !> If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q - !> is of order M: - !> if m >= k, Q = H(1) H(2) . . . H(k) and UNGBR returns the first n - !> columns of Q, where m >= n >= k; - !> if m < k, Q = H(1) H(2) . . . H(m-1) and UNGBR returns Q as an - !> M-by-M matrix. - !> If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**H - !> is of order N: - !> if k < n, P**H = G(k) . . . G(2) G(1) and UNGBR returns the first m - !> rows of P**H, where n >= m >= k; - !> if k >= n, P**H = G(n-1) . . . G(2) G(1) and UNGBR returns P**H as - !> an N-by-N matrix. + !! UNGBR generates one of the complex unitary matrices Q or P**H + !! determined by CGEBRD when reducing a complex matrix A to bidiagonal + !! form: A = Q * B * P**H. Q and P**H are defined as products of + !! elementary reflectors H(i) or G(i) respectively. + !! If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q + !! is of order M: + !! if m >= k, Q = H(1) H(2) . . . H(k) and UNGBR returns the first n + !! columns of Q, where m >= n >= k; + !! if m < k, Q = H(1) H(2) . . . H(m-1) and UNGBR returns Q as an + !! M-by-M matrix. + !! If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**H + !! is of order N: + !! if k < n, P**H = G(k) . . . G(2) G(1) and UNGBR returns the first m + !! rows of P**H, where n >= m >= k; + !! if k >= n, P**H = G(n-1) . . . G(2) G(1) and UNGBR returns P**H as + !! an N-by-N matrix. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cungbr( vect, m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -28511,10 +28507,10 @@ module stdlib_linalg_lapack interface unghr - !> UNGHR generates a complex unitary matrix Q which is defined as the - !> product of IHI-ILO elementary reflectors of order N, as returned by - !> CGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! UNGHR generates a complex unitary matrix Q which is defined as the + !! product of IHI-ILO elementary reflectors of order N, as returned by + !! CGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -28549,11 +28545,11 @@ module stdlib_linalg_lapack interface unglq - !> UNGLQ generates an M-by-N complex matrix Q with orthonormal rows, - !> which is defined as the first M rows of a product of K elementary - !> reflectors of order N - !> Q = H(k)**H . . . H(2)**H H(1)**H - !> as returned by CGELQF. + !! UNGLQ generates an M-by-N complex matrix Q with orthonormal rows, + !! which is defined as the first M rows of a product of K elementary + !! reflectors of order N + !! Q = H(k)**H . . . H(2)**H H(1)**H + !! as returned by CGELQF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunglq( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -28588,11 +28584,11 @@ module stdlib_linalg_lapack interface ungql - !> UNGQL generates an M-by-N complex matrix Q with orthonormal columns, - !> which is defined as the last N columns of a product of K elementary - !> reflectors of order M - !> Q = H(k) . . . H(2) H(1) - !> as returned by CGEQLF. + !! UNGQL generates an M-by-N complex matrix Q with orthonormal columns, + !! which is defined as the last N columns of a product of K elementary + !! reflectors of order M + !! Q = H(k) . . . H(2) H(1) + !! as returned by CGEQLF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cungql( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -28627,11 +28623,11 @@ module stdlib_linalg_lapack interface ungqr - !> UNGQR generates an M-by-N complex matrix Q with orthonormal columns, - !> which is defined as the first N columns of a product of K elementary - !> reflectors of order M - !> Q = H(1) H(2) . . . H(k) - !> as returned by CGEQRF. + !! UNGQR generates an M-by-N complex matrix Q with orthonormal columns, + !! which is defined as the first N columns of a product of K elementary + !! reflectors of order M + !! Q = H(1) H(2) . . . H(k) + !! as returned by CGEQRF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cungqr( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -28666,11 +28662,11 @@ module stdlib_linalg_lapack interface ungrq - !> UNGRQ generates an M-by-N complex matrix Q with orthonormal rows, - !> which is defined as the last M rows of a product of K elementary - !> reflectors of order N - !> Q = H(1)**H H(2)**H . . . H(k)**H - !> as returned by CGERQF. + !! UNGRQ generates an M-by-N complex matrix Q with orthonormal rows, + !! which is defined as the last M rows of a product of K elementary + !! reflectors of order N + !! Q = H(1)**H H(2)**H . . . H(k)**H + !! as returned by CGERQF. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cungrq( m, n, k, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -28705,11 +28701,11 @@ module stdlib_linalg_lapack interface ungtr - !> UNGTR generates a complex unitary matrix Q which is defined as the - !> product of n-1 elementary reflectors of order N, as returned by - !> CHETRD: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! UNGTR generates a complex unitary matrix Q which is defined as the + !! product of n-1 elementary reflectors of order N, as returned by + !! CHETRD: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cungtr( uplo, n, a, lda, tau, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -28746,11 +28742,11 @@ module stdlib_linalg_lapack interface ungtsqr - !> UNGTSQR generates an M-by-N complex matrix Q_out with orthonormal - !> columns, which are the first N columns of a product of comlpex unitary - !> matrices of order M which are returned by CLATSQR - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> See the documentation for CLATSQR. + !! UNGTSQR generates an M-by-N complex matrix Q_out with orthonormal + !! columns, which are the first N columns of a product of comlpex unitary + !! matrices of order M which are returned by CLATSQR + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! See the documentation for CLATSQR. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cungtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -28785,21 +28781,21 @@ module stdlib_linalg_lapack interface ungtsqr_row - !> UNGTSQR_ROW generates an M-by-N complex matrix Q_out with - !> orthonormal columns from the output of CLATSQR. These N orthonormal - !> columns are the first N columns of a product of complex unitary - !> matrices Q(k)_in of order M, which are returned by CLATSQR in - !> a special format. - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> The input matrices Q(k)_in are stored in row and column blocks in A. - !> See the documentation of CLATSQR for more details on the format of - !> Q(k)_in, where each Q(k)_in is represented by block Householder - !> transformations. This routine calls an auxiliary routine CLARFB_GETT, - !> where the computation is performed on each individual block. The - !> algorithm first sweeps NB-sized column blocks from the right to left - !> starting in the bottom row block and continues to the top row block - !> (hence _ROW in the routine name). This sweep is in reverse order of - !> the order in which CLATSQR generates the output blocks. + !! UNGTSQR_ROW generates an M-by-N complex matrix Q_out with + !! orthonormal columns from the output of CLATSQR. These N orthonormal + !! columns are the first N columns of a product of complex unitary + !! matrices Q(k)_in of order M, which are returned by CLATSQR in + !! a special format. + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! The input matrices Q(k)_in are stored in row and column blocks in A. + !! See the documentation of CLATSQR for more details on the format of + !! Q(k)_in, where each Q(k)_in is represented by block Householder + !! transformations. This routine calls an auxiliary routine CLARFB_GETT, + !! where the computation is performed on each individual block. The + !! algorithm first sweeps NB-sized column blocks from the right to left + !! starting in the bottom row block and continues to the top row block + !! (hence _ROW in the routine name). This sweep is in reverse order of + !! the order in which CLATSQR generates the output blocks. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cungtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) @@ -28836,15 +28832,15 @@ module stdlib_linalg_lapack interface unhr_col - !> UNHR_COL takes an M-by-N complex matrix Q_in with orthonormal columns - !> as input, stored in A, and performs Householder Reconstruction (HR), - !> i.e. reconstructs Householder vectors V(i) implicitly representing - !> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, - !> where S is an N-by-N diagonal matrix with diagonal entries - !> equal to +1 or -1. The Householder vectors (columns V(i) of V) are - !> stored in A on output, and the diagonal entries of S are stored in D. - !> Block reflectors are also returned in T - !> (same output format as CGEQRT). + !! UNHR_COL takes an M-by-N complex matrix Q_in with orthonormal columns + !! as input, stored in A, and performs Householder Reconstruction (HR), + !! i.e. reconstructs Householder vectors V(i) implicitly representing + !! another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, + !! where S is an N-by-N diagonal matrix with diagonal entries + !! equal to +1 or -1. The Householder vectors (columns V(i) of V) are + !! stored in A on output, and the diagonal entries of S are stored in D. + !! Block reflectors are also returned in T + !! (same output format as CGEQRT). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunhr_col( m, n, nb, a, lda, t, ldt, d, info ) import sp,dp,qp,ilp,lk @@ -28877,16 +28873,16 @@ module stdlib_linalg_lapack interface unm2l - !> UNM2L overwrites the general complex m-by-n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by CGEQLF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! UNM2L overwrites the general complex m-by-n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by CGEQLF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) @@ -28925,16 +28921,16 @@ module stdlib_linalg_lapack interface unm2r - !> UNM2R overwrites the general complex m-by-n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by CGEQRF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! UNM2R overwrites the general complex m-by-n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by CGEQRF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) @@ -28973,28 +28969,28 @@ module stdlib_linalg_lapack interface unmbr - !> If VECT = 'Q', UNMBR: 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 - !> If VECT = 'P', UNMBR overwrites the general complex M-by-N matrix C - !> with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': P * C C * P - !> TRANS = 'C': P**H * C C * P**H - !> Here Q and P**H are the unitary matrices determined by CGEBRD when - !> reducing a complex matrix A to bidiagonal form: A = Q * B * P**H. Q - !> and P**H are defined as products of elementary reflectors H(i) and - !> G(i) respectively. - !> Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the - !> order of the unitary matrix Q or P**H that is applied. - !> If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: - !> if nq >= k, Q = H(1) H(2) . . . H(k); - !> if nq < k, Q = H(1) H(2) . . . H(nq-1). - !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: - !> if k < nq, P = G(1) G(2) . . . G(k); - !> if k >= nq, P = G(1) G(2) . . . G(nq-1). + !! If VECT = 'Q', UNMBR: 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 + !! If VECT = 'P', UNMBR overwrites the general complex M-by-N matrix C + !! with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': P * C C * P + !! TRANS = 'C': P**H * C C * P**H + !! Here Q and P**H are the unitary matrices determined by CGEBRD when + !! reducing a complex matrix A to bidiagonal form: A = Q * B * P**H. Q + !! and P**H are defined as products of elementary reflectors H(i) and + !! G(i) respectively. + !! Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the + !! order of the unitary matrix Q or P**H that is applied. + !! If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: + !! if nq >= k, Q = H(1) H(2) . . . H(k); + !! if nq < k, Q = H(1) H(2) . . . H(nq-1). + !! If VECT = 'P', A is assumed to have been a K-by-NQ matrix: + !! if k < nq, P = G(1) G(2) . . . G(k); + !! if k >= nq, P = G(1) G(2) . . . G(nq-1). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, & lwork, info ) @@ -29033,14 +29029,14 @@ module stdlib_linalg_lapack interface unmhr - !> UNMHR 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 of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> IHI-ILO elementary reflectors, as returned by CGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! UNMHR 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 of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! IHI-ILO elementary reflectors, as returned by CGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, & lwork, info ) @@ -29079,15 +29075,15 @@ module stdlib_linalg_lapack interface unmlq - !> UNMLQ 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(k)**H . . . H(2)**H H(1)**H - !> as returned by CGELQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! UNMLQ 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(k)**H . . . H(2)**H H(1)**H + !! as returned by CGELQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29126,15 +29122,15 @@ module stdlib_linalg_lapack interface unmql - !> UNMQL 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(k) . . . H(2) H(1) - !> as returned by CGEQLF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! UNMQL 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(k) . . . H(2) H(1) + !! as returned by CGEQLF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29173,15 +29169,15 @@ module stdlib_linalg_lapack interface unmqr - !> UNMQR 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) - !> as returned by CGEQRF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! UNMQR 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) + !! as returned by CGEQRF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29220,15 +29216,15 @@ module stdlib_linalg_lapack interface unmrq - !> UNMRQ 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 H(2)**H . . . H(k)**H - !> as returned by CGERQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! UNMRQ 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 H(2)**H . . . H(k)**H + !! as returned by CGERQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29267,15 +29263,15 @@ module stdlib_linalg_lapack interface unmrz - !> UNMRZ 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) - !> as returned by CTZRZF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! UNMRZ 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) + !! as returned by CTZRZF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29314,15 +29310,15 @@ module stdlib_linalg_lapack interface unmtr - !> UNMTR 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 of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by CHETRD: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! UNMTR 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 of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by CHETRD: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29361,11 +29357,11 @@ module stdlib_linalg_lapack interface upgtr - !> UPGTR generates a complex unitary matrix Q which is defined as the - !> product of n-1 elementary reflectors H(i) of order n, as returned by - !> CHPTRD using packed storage: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! UPGTR generates a complex unitary matrix Q which is defined as the + !! product of n-1 elementary reflectors H(i) of order n, as returned by + !! CHPTRD using packed storage: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cupgtr( uplo, n, ap, tau, q, ldq, work, info ) import sp,dp,qp,ilp,lk @@ -29400,16 +29396,16 @@ module stdlib_linalg_lapack interface upmtr - !> UPMTR 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 of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by CHPTRD using packed - !> storage: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! UPMTR 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 of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by CHPTRD using packed + !! storage: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cupmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) diff --git a/src/stdlib_linalg_lapack_aux.fypp b/src/stdlib_linalg_lapack_aux.fypp index 059dbb878..593bc9b58 100644 --- a/src/stdlib_linalg_lapack_aux.fypp +++ b/src/stdlib_linalg_lapack_aux.fypp @@ -145,12 +145,12 @@ module stdlib_linalg_lapack_aux pure character function stdlib_chla_transtype( trans ) - !> This subroutine translates from a BLAST-specified integer constant to - !> the character string specifying a transposition operation. - !> CHLA_TRANSTYPE returns an CHARACTER*1. If CHLA_TRANSTYPE: is 'X', - !> then input is not an integer indicating a transposition operator. - !> Otherwise CHLA_TRANSTYPE returns the constant value corresponding to - !> TRANS. + !! This subroutine translates from a BLAST-specified integer constant to + !! the character string specifying a transposition operation. + !! CHLA_TRANSTYPE returns an CHARACTER*1. If CHLA_TRANSTYPE: is 'X', + !! then input is not an integer indicating a transposition operator. + !! Otherwise CHLA_TRANSTYPE returns the constant value corresponding to + !! TRANS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -177,16 +177,8 @@ module stdlib_linalg_lapack_aux pure real(dp) function stdlib_droundup_lwork( lwork ) - !> DROUNDUP_LWORK deals with a subtle bug with returning LWORK as a Float. - !> This routine guarantees it is rounded up instead of down by - !> multiplying LWORK by 1+eps when it is necessary, where eps is the relative machine precision. - !> E.g., - !> float( 9007199254740993 ) == 9007199254740992 - !> float( 9007199254740993 ) * (1.+eps) == 9007199254740994 - !> \return DROUNDUP_LWORK - !> - !> DROUNDUP_LWORK >= LWORK. - !> DROUNDUP_LWORK is guaranteed to have zero decimal part. + !! DROUNDUP_LWORK >= LWORK. + !! DROUNDUP_LWORK is guaranteed to have zero decimal part. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -207,9 +199,9 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_icmax1( n, cx, incx ) - !> ICMAX1 finds the index of the first vector element of maximum absolute value. - !> Based on ICAMAX from Level 1 BLAS. - !> The change is to use the 'genuine' absolute value. + !! ICMAX1 finds the index of the first vector element of maximum absolute value. + !! Based on ICAMAX from Level 1 BLAS. + !! The change is to use the 'genuine' absolute value. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -255,8 +247,8 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_ieeeck( ispec, zero, one ) - !> IEEECK is called from the ILAENV to verify that Infinity and - !> possibly NaN arithmetic is safe (i.e. will not trap). + !! IEEECK is called from the ILAENV to verify that Infinity and + !! possibly NaN arithmetic is safe (i.e. will not trap). ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -345,7 +337,7 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_ilaclc( m, n, a, lda ) - !> ILACLC scans A for its last non-zero column. + !! ILACLC scans A for its last non-zero column. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -378,7 +370,7 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_ilaclr( m, n, a, lda ) - !> ILACLR scans A for its last non-zero row. + !! ILACLR scans A for its last non-zero row. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -414,12 +406,12 @@ module stdlib_linalg_lapack_aux integer(ilp) function stdlib_iladiag( diag ) - !> This subroutine translated from a character string specifying if a - !> matrix has unit diagonal or not to the relevant BLAST-specified - !> integer constant. - !> ILADIAG returns an INTEGER. If ILADIAG: < 0, then the input is not a - !> character indicating a unit or non-unit diagonal. Otherwise ILADIAG - !> returns the constant value corresponding to DIAG. + !! This subroutine translated from a character string specifying if a + !! matrix has unit diagonal or not to the relevant BLAST-specified + !! integer constant. + !! ILADIAG returns an INTEGER. If ILADIAG: < 0, then the input is not a + !! character indicating a unit or non-unit diagonal. Otherwise ILADIAG + !! returns the constant value corresponding to DIAG. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -443,7 +435,7 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_iladlc( m, n, a, lda ) - !> ILADLC scans A for its last non-zero column. + !! ILADLC scans A for its last non-zero column. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -476,7 +468,7 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_iladlr( m, n, a, lda ) - !> ILADLR scans A for its last non-zero row. + !! ILADLR scans A for its last non-zero row. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -512,12 +504,12 @@ module stdlib_linalg_lapack_aux integer(ilp) function stdlib_ilaprec( prec ) - !> This subroutine translated from a character string specifying an - !> intermediate precision to the relevant BLAST-specified integer - !> constant. - !> ILAPREC returns an INTEGER. If ILAPREC: < 0, then the input is not a - !> character indicating a supported intermediate precision. Otherwise - !> ILAPREC returns the constant value corresponding to PREC. + !! This subroutine translated from a character string specifying an + !! intermediate precision to the relevant BLAST-specified integer + !! constant. + !! ILAPREC returns an INTEGER. If ILAPREC: < 0, then the input is not a + !! character indicating a supported intermediate precision. Otherwise + !! ILAPREC returns the constant value corresponding to PREC. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -547,7 +539,7 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_ilaslc( m, n, a, lda ) - !> ILASLC scans A for its last non-zero column. + !! ILASLC scans A for its last non-zero column. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -580,7 +572,7 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_ilaslr( m, n, a, lda ) - !> ILASLR scans A for its last non-zero row. + !! ILASLR scans A for its last non-zero row. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -616,12 +608,12 @@ module stdlib_linalg_lapack_aux integer(ilp) function stdlib_ilatrans( trans ) - !> This subroutine translates from a character string specifying a - !> transposition operation to the relevant BLAST-specified integer - !> constant. - !> ILATRANS returns an INTEGER. If ILATRANS: < 0, then the input is not - !> a character indicating a transposition operator. Otherwise ILATRANS - !> returns the constant value corresponding to TRANS. + !! This subroutine translates from a character string specifying a + !! transposition operation to the relevant BLAST-specified integer + !! constant. + !! ILATRANS returns an INTEGER. If ILATRANS: < 0, then the input is not + !! a character indicating a transposition operator. Otherwise ILATRANS + !! returns the constant value corresponding to TRANS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -648,12 +640,12 @@ module stdlib_linalg_lapack_aux integer(ilp) function stdlib_ilauplo( uplo ) - !> This subroutine translated from a character string specifying a - !> upper- or lower-triangular matrix to the relevant BLAST-specified - !> integer constant. - !> ILAUPLO returns an INTEGER. If ILAUPLO: < 0, then the input is not - !> a character indicating an upper- or lower-triangular matrix. - !> Otherwise ILAUPLO returns the constant value corresponding to UPLO. + !! This subroutine translated from a character string specifying a + !! upper- or lower-triangular matrix to the relevant BLAST-specified + !! integer constant. + !! ILAUPLO returns an INTEGER. If ILAUPLO: < 0, then the input is not + !! a character indicating an upper- or lower-triangular matrix. + !! Otherwise ILAUPLO returns the constant value corresponding to UPLO. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -677,7 +669,7 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_ilazlc( m, n, a, lda ) - !> ILAZLC scans A for its last non-zero column. + !! ILAZLC scans A for its last non-zero column. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -710,7 +702,7 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_ilazlr( m, n, a, lda ) - !> ILAZLR scans A for its last non-zero row. + !! ILAZLR scans A for its last non-zero row. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -746,10 +738,10 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_iparmq( ispec, name, opts, n, ilo, ihi, lwork ) - !> This program sets problem and machine dependent parameters - !> useful for xHSEQR and related subroutines for eigenvalue - !> problems. It is called whenever - !> IPARMQ is called with 12 <= ISPEC <= 16 + !! This program sets problem and machine dependent parameters + !! useful for xHSEQR and related subroutines for eigenvalue + !! problems. It is called whenever + !! IPARMQ is called with 12 <= ISPEC <= 16 ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -878,9 +870,9 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_izmax1( n, zx, incx ) - !> IZMAX1 finds the index of the first vector element of maximum absolute value. - !> Based on IZAMAX from Level 1 BLAS. - !> The change is to use the 'genuine' absolute value. + !! IZMAX1 finds the index of the first vector element of maximum absolute value. + !! Based on IZAMAX from Level 1 BLAS. + !! The change is to use the 'genuine' absolute value. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -926,11 +918,11 @@ module stdlib_linalg_lapack_aux pure logical(lk) function stdlib_lsamen( n, ca, cb ) - !> LSAMEN tests if the first N letters of CA are the same as the - !> first N letters of CB, regardless of case. - !> LSAMEN returns .TRUE. if CA and CB are equivalent except for case - !> and .FALSE. otherwise. LSAMEN also returns .FALSE. if LEN( CA ) - !> or LEN( CB ) is less than N. + !! LSAMEN tests if the first N letters of CA are the same as the + !! first N letters of CB, regardless of case. + !! LSAMEN returns .TRUE. if CA and CB are equivalent except for case + !! and .FALSE. otherwise. LSAMEN also returns .FALSE. if LEN( CA ) + !! or LEN( CB ) is less than N. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -957,16 +949,8 @@ module stdlib_linalg_lapack_aux pure real(sp) function stdlib_sroundup_lwork( lwork ) - !> SROUNDUP_LWORK deals with a subtle bug with returning LWORK as a Float. - !> This routine guarantees it is rounded up instead of down by - !> multiplying LWORK by 1+eps when it is necessary, where eps is the relative machine precision. - !> E.g., - !> float( 16777217 ) == 16777216 - !> float( 16777217 ) * (1.+eps) == 16777218 - !> \return SROUNDUP_LWORK - !> - !> SROUNDUP_LWORK >= LWORK. - !> SROUNDUP_LWORK is guaranteed to have zero decimal part. + !! SROUNDUP_LWORK >= LWORK. + !! SROUNDUP_LWORK is guaranteed to have zero decimal part. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -989,16 +973,8 @@ module stdlib_linalg_lapack_aux pure real(qp) function stdlib_qroundup_lwork( lwork ) - !> DROUNDUP_LWORK: deals with a subtle bug with returning LWORK as a Float. - !> This routine guarantees it is rounded up instead of down by - !> multiplying LWORK by 1+eps when it is necessary, where eps is the relative machine precision. - !> E.g., - !> float( 9007199254740993 ) == 9007199254740992 - !> float( 9007199254740993 ) * (1.+eps) == 9007199254740994 - !> \return DROUNDUP_LWORK - !> - !> DROUNDUP_LWORK >= LWORK. - !> DROUNDUP_LWORK is guaranteed to have zero decimal part. + !! DROUNDUP_LWORK >= LWORK. + !! DROUNDUP_LWORK is guaranteed to have zero decimal part. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1022,12 +998,12 @@ module stdlib_linalg_lapack_aux integer(ilp) function stdlib_ilaqiag( diag ) - !> This subroutine translated from a character string specifying if a - !> matrix has unit diagonal or not to the relevant BLAST-specified - !> integer constant. - !> ILADIAG: returns an INTEGER. If ILADIAG: < 0, then the input is not a - !> character indicating a unit or non-unit diagonal. Otherwise ILADIAG - !> returns the constant value corresponding to DIAG. + !! This subroutine translated from a character string specifying if a + !! matrix has unit diagonal or not to the relevant BLAST-specified + !! integer constant. + !! ILADIAG: returns an INTEGER. If ILADIAG: < 0, then the input is not a + !! character indicating a unit or non-unit diagonal. Otherwise ILADIAG + !! returns the constant value corresponding to DIAG. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1054,7 +1030,7 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_ilaqlc( m, n, a, lda ) - !> ILADLC: scans A for its last non-zero column. + !! ILADLC: scans A for its last non-zero column. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1090,7 +1066,7 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_ilaqlr( m, n, a, lda ) - !> ILADLR: scans A for its last non-zero row. + !! ILADLR: scans A for its last non-zero row. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1129,7 +1105,7 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_ilawlc( m, n, a, lda ) - !> ILAZLC: scans A for its last non-zero column. + !! ILAZLC: scans A for its last non-zero column. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1165,7 +1141,7 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_ilawlr( m, n, a, lda ) - !> ILAZLR: scans A for its last non-zero row. + !! ILAZLR: scans A for its last non-zero row. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1204,9 +1180,9 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_iwmax1( n, zx, incx ) - !> IZMAX1: finds the index of the first vector element of maximum absolute value. - !> Based on IZAMAX from Level 1 BLAS. - !> The change is to use the 'genuine' absolute value. + !! IZMAX1: finds the index of the first vector element of maximum absolute value. + !! Based on IZAMAX from Level 1 BLAS. + !! The change is to use the 'genuine' absolute value. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1253,19 +1229,19 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_ilaenv( ispec, name, opts, n1, n2, n3, n4 ) - !> ILAENV is called from the LAPACK routines to choose problem-dependent - !> parameters for the local environment. See ISPEC for a description of - !> the parameters. - !> ILAENV returns an INTEGER - !> if ILAENV >= 0: ILAENV returns the value of the parameter specified by ISPEC - !> if ILAENV < 0: if ILAENV = -k, the k-th argument had an illegal value. - !> This version provides a set of parameters which should give good, - !> but not optimal, performance on many of the currently available - !> computers. Users are encouraged to modify this subroutine to set - !> the tuning parameters for their particular machine using the option - !> and problem size information in the arguments. - !> This routine will not function correctly if it is converted to all - !> lower case. Converting it to all upper case is allowed. + !! ILAENV is called from the LAPACK routines to choose problem-dependent + !! parameters for the local environment. See ISPEC for a description of + !! the parameters. + !! ILAENV returns an INTEGER + !! if ILAENV >= 0: ILAENV returns the value of the parameter specified by ISPEC + !! if ILAENV < 0: if ILAENV = -k, the k-th argument had an illegal value. + !! This version provides a set of parameters which should give good, + !! but not optimal, performance on many of the currently available + !! computers. Users are encouraged to modify this subroutine to set + !! the tuning parameters for their particular machine using the option + !! and problem size information in the arguments. + !! This routine will not function correctly if it is converted to all + !! lower case. Converting it to all upper case is allowed. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1733,13 +1709,13 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_iparam2stage( ispec, name, opts,ni, nbi, ibi, nxi ) - !> This program sets problem and machine dependent parameters - !> useful for xHETRD_2STAGE, xHETRD_HE2HB, xHETRD_HB2ST, - !> xGEBRD_2STAGE, xGEBRD_GE2GB, xGEBRD_GB2BD - !> and related subroutines for eigenvalue problems. - !> It is called whenever ILAENV is called with 17 <= ISPEC <= 21. - !> It is called whenever ILAENV2STAGE is called with 1 <= ISPEC <= 5 - !> with a direct conversion ISPEC + 16. + !! This program sets problem and machine dependent parameters + !! useful for xHETRD_2STAGE, xHETRD_HE2HB, xHETRD_HB2ST, + !! xGEBRD_2STAGE, xGEBRD_GE2GB, xGEBRD_GB2BD + !! and related subroutines for eigenvalue problems. + !! It is called whenever ILAENV is called with 17 <= ISPEC <= 21. + !! It is called whenever ILAENV2STAGE is called with 1 <= ISPEC <= 5 + !! with a direct conversion ISPEC + 16. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1917,23 +1893,23 @@ module stdlib_linalg_lapack_aux pure integer(ilp) function stdlib_ilaenv2stage( ispec, name, opts, n1, n2, n3, n4 ) - !> ILAENV2STAGE is called from the LAPACK routines to choose problem-dependent - !> parameters for the local environment. See ISPEC for a description of - !> the parameters. - !> It sets problem and machine dependent parameters useful for *_2STAGE and - !> related subroutines. - !> ILAENV2STAGE returns an INTEGER - !> if ILAENV2STAGE >= 0: ILAENV2STAGE returns the value of the parameter - !> specified by ISPEC - !> if ILAENV2STAGE < 0: if ILAENV2STAGE = -k, the k-th argument had an - !> illegal value. - !> This version provides a set of parameters which should give good, - !> but not optimal, performance on many of the currently available - !> computers for the 2-stage solvers. Users are encouraged to modify this - !> subroutine to set the tuning parameters for their particular machine using - !> the option and problem size information in the arguments. - !> This routine will not function correctly if it is converted to all - !> lower case. Converting it to all upper case is allowed. + !! ILAENV2STAGE is called from the LAPACK routines to choose problem-dependent + !! parameters for the local environment. See ISPEC for a description of + !! the parameters. + !! It sets problem and machine dependent parameters useful for *_2STAGE and + !! related subroutines. + !! ILAENV2STAGE returns an INTEGER + !! if ILAENV2STAGE >= 0: ILAENV2STAGE returns the value of the parameter + !! specified by ISPEC + !! if ILAENV2STAGE < 0: if ILAENV2STAGE = -k, the k-th argument had an + !! illegal value. + !! This version provides a set of parameters which should give good, + !! but not optimal, performance on many of the currently available + !! computers for the 2-stage solvers. Users are encouraged to modify this + !! subroutine to set the tuning parameters for their particular machine using + !! the option and problem size information in the arguments. + !! This routine will not function correctly if it is converted to all + !! lower case. Converting it to all upper case is allowed. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_lapack_c.fypp b/src/stdlib_linalg_lapack_c.fypp index 58f1d549e..b127ab4eb 100644 --- a/src/stdlib_linalg_lapack_c.fypp +++ b/src/stdlib_linalg_lapack_c.fypp @@ -499,15 +499,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) - !> CGBEQU 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. + !! CGBEQU 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -634,21 +634,21 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) - !> CGBEQUB 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). + !! CGBEQUB 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). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -784,9 +784,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgbtf2( m, n, kl, ku, ab, ldab, ipiv, info ) - !> CGBTF2 computes an LU factorization of a complex m-by-n band matrix - !> A using partial pivoting with row interchanges. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! CGBTF2 computes an LU factorization of a complex m-by-n band matrix + !! A using partial pivoting with row interchanges. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -870,9 +870,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) - !> CGEBAK 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. + !! CGEBAK 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -967,14 +967,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgebal( job, n, a, lda, ilo, ihi, scale, info ) - !> CGEBAL 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. + !! CGEBAL 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1137,15 +1137,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) - !> CGEEQU 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. + !! CGEEQU 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1265,21 +1265,21 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) - !> CGEEQUB 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). + !! CGEEQUB 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). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1409,11 +1409,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgetc2( n, a, lda, ipiv, jpiv, info ) - !> CGETC2 computes an LU factorization, using complete pivoting, of the - !> n-by-n matrix A. The factorization has the form A = P * L * U * Q, - !> where P and Q are permutation matrices, L is lower triangular with - !> unit diagonal elements and U is upper triangular. - !> This is a level 1 BLAS version of the algorithm. + !! CGETC2 computes an LU factorization, using complete pivoting, of the + !! n-by-n matrix A. The factorization has the form A = P * L * U * Q, + !! where P and Q are permutation matrices, L is lower triangular with + !! unit diagonal elements and U is upper triangular. + !! This is a level 1 BLAS version of the algorithm. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1493,14 +1493,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgetf2( m, n, a, lda, ipiv, info ) - !> CGETF2 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 2 BLAS version of the algorithm. + !! CGETF2 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 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1566,10 +1566,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) - !> CGGBAK 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. + !! CGGBAK 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1679,15 +1679,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) - !> CGGBAL 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. + !! CGGBAL 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1983,12 +1983,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgtsv( n, nrhs, dl, d, du, b, ldb, info ) - !> CGTSV 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. + !! CGTSV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2075,13 +2075,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgttrf( n, dl, d, du, du2, ipiv, info ) - !> CGTTRF 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. + !! CGTTRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2171,10 +2171,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) - !> CGTTS2 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. + !! CGTTS2 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2342,8 +2342,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cheswapr( uplo, n, a, lda, i1, i2) - !> CHESWAPR applies an elementary permutation on the rows and the columns of - !> a hermitian matrix. + !! CHESWAPR applies an elementary permutation on the rows and the columns of + !! a hermitian matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2414,13 +2414,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetf2( uplo, n, a, lda, ipiv, info ) - !> CHETF2 computes the factorization of a complex Hermitian 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, 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. + !! CHETF2 computes the factorization of a complex Hermitian 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, 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2732,15 +2732,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetf2_rk( uplo, n, a, lda, e, ipiv, info ) - !> CHETF2_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. + !! CHETF2_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3263,13 +3263,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetf2_rook( uplo, n, a, lda, ipiv, info ) - !> CHETF2_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. + !! CHETF2_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3752,9 +3752,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetri( uplo, n, a, lda, ipiv, work, info ) - !> CHETRI 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. + !! CHETRI 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3956,9 +3956,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetri_rook( uplo, n, a, lda, ipiv, work, info ) - !> CHETRI_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. + !! CHETRI_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4224,15 +4224,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) - !> CHETRS_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. + !! CHETRS_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4384,14 +4384,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) - !> Level 3 BLAS like routine for C in RFP Format. - !> CHFRK 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. + !! Level 3 BLAS like routine for C in RFP Format. + !! CHFRK 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4644,13 +4644,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chpgst( itype, uplo, n, ap, bp, info ) - !> CHPGST 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. + !! CHPGST 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4773,12 +4773,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chptrf( uplo, n, ap, ipiv, info ) - !> CHPTRF 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. + !! CHPTRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5123,9 +5123,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chptri( uplo, n, ap, ipiv, work, info ) - !> CHPTRI 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. + !! CHPTRI 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5342,19 +5342,19 @@ module stdlib_linalg_lapack_c subroutine stdlib_cla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) - !> CLA_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. + !! CLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5537,12 +5537,12 @@ module stdlib_linalg_lapack_c pure real(sp) function stdlib_cla_gbrpvgrw( n, kl, ku, ncols, ab, ldab, afb,ldafb ) - !> CLA_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. + !! CLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5582,19 +5582,19 @@ module stdlib_linalg_lapack_c subroutine stdlib_cla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) - !> CLA_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. + !! CLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5771,12 +5771,12 @@ module stdlib_linalg_lapack_c pure real(sp) function stdlib_cla_gerpvgrw( n, ncols, a, lda, af, ldaf ) - !> CLA_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. + !! CLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5815,18 +5815,18 @@ module stdlib_linalg_lapack_c subroutine stdlib_cla_heamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6009,11 +6009,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cla_lin_berr( n, nz, nrhs, res, ayb, berr ) - !> CLA_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. + !! CLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6055,12 +6055,12 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_cla_porpvgrw( uplo, ncols, a, lda, af, ldaf, work ) - !> CLA_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. + !! CLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6148,18 +6148,18 @@ module stdlib_linalg_lapack_c subroutine stdlib_cla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6343,9 +6343,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cla_wwaddw( n, x, y, w ) - !> CLA_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. + !! CLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6370,7 +6370,7 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clacgv( n, x, incx ) - !> CLACGV conjugates a complex vector of length N. + !! CLACGV conjugates a complex vector of length N. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6401,8 +6401,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clacn2( n, v, x, est, kase, isave ) - !> CLACN2 estimates the 1-norm of a square, complex matrix A. - !> Reverse communication is used for evaluating matrix-vector products. + !! CLACN2 estimates the 1-norm of a square, complex matrix A. + !! Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6528,8 +6528,8 @@ module stdlib_linalg_lapack_c subroutine stdlib_clacon( n, v, x, est, kase ) - !> CLACON estimates the 1-norm of a square, complex matrix A. - !> Reverse communication is used for evaluating matrix-vector products. + !! CLACON estimates the 1-norm of a square, complex matrix A. + !! Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6655,8 +6655,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clacp2( uplo, m, n, a, lda, b, ldb ) - !> CLACP2 copies all or part of a real two-dimensional matrix A to a - !> complex matrix B. + !! CLACP2 copies all or part of a real two-dimensional matrix A to a + !! complex matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6696,8 +6696,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clacpy( uplo, m, n, a, lda, b, ldb ) - !> CLACPY copies all or part of a two-dimensional matrix A to another - !> matrix B. + !! CLACPY copies all or part of a two-dimensional matrix A to another + !! matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6737,10 +6737,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clacrm( m, n, a, lda, b, ldb, c, ldc, rwork ) - !> CLACRM 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. + !! CLACRM 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6791,10 +6791,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clacrt( n, cx, incx, cy, incy, c, s ) - !> CLACRT 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. + !! CLACRT 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6835,9 +6835,9 @@ module stdlib_linalg_lapack_c pure complex(sp) function stdlib_cladiv( x, y ) - !> CLADIV := X / Y, where X and Y are complex. The computation of X / Y - !> will not overflow on an intermediary step unless the results - !> overflows. + !! CLADIV := X / Y, where X and Y are complex. The computation of X / Y + !! will not overflow on an intermediary step unless the results + !! overflows. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6857,12 +6857,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claed8( k, n, qsiz, q, ldq, d, rho, cutpnt, z, dlamda,q2, ldq2, w, & - !> CLAED8 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. + !! CLAED8 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. indxp, indx, indxq, perm, givptr,givcol, givnum, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7060,15 +7060,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claesy( a, b, c, rt1, rt2, evscal, cs1, sn1 ) - !> CLAESY 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 ] + !! CLAESY 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 ] ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7150,14 +7150,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claev2( a, b, c, rt1, rt2, cs1, sn1 ) - !> CLAEV2 computes the eigendecomposition of a 2-by-2 Hermitian matrix - !> [ A B ] - !> [ CONJG(B) C ]. - !> On return, RT1 is the eigenvalue of larger absolute value, RT2 is the - !> eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right - !> eigenvector for RT1, giving the decomposition - !> [ CS1 CONJG(SN1) ] [ A B ] [ CS1 -CONJG(SN1) ] = [ RT1 0 ] - !> [-SN1 CS1 ] [ CONJG(B) C ] [ SN1 CS1 ] [ 0 RT2 ]. + !! CLAEV2 computes the eigendecomposition of a 2-by-2 Hermitian matrix + !! [ A B ] + !! [ CONJG(B) C ]. + !! On return, RT1 is the eigenvalue of larger absolute value, RT2 is the + !! eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right + !! eigenvector for RT1, giving the decomposition + !! [ CS1 CONJG(SN1) ] [ A B ] [ CS1 -CONJG(SN1) ] = [ RT1 0 ] + !! [-SN1 CS1 ] [ CONJG(B) C ] [ SN1 CS1 ] [ 0 RT2 ]. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7187,11 +7187,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clag2z( m, n, sa, ldsa, a, lda, info ) - !> CLAG2Z converts a COMPLEX matrix, SA, to a COMPLEX*16 matrix, A. - !> Note that while it is possible to overflow while converting - !> from double to single, it is not possible to overflow when - !> converting from single to double. - !> This is an auxiliary routine so there is no argument checking. + !! CLAG2Z converts a COMPLEX matrix, SA, to a COMPLEX*16 matrix, A. + !! Note that while it is possible to overflow while converting + !! from double to single, it is not possible to overflow when + !! converting from single to double. + !! This is an auxiliary routine so there is no argument checking. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7216,11 +7216,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) - !> CLAGTM 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. + !! CLAGTM 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7352,19 +7352,19 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clahef( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) - !> CLAHEF 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. - !> CLAHEF 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'). + !! CLAHEF 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. + !! CLAHEF 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'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7891,18 +7891,18 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clahef_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) - !> CLAHEF_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. - !> CLAHEF_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'). + !! CLAHEF_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. + !! CLAHEF_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'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8530,19 +8530,19 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clahef_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) - !> CLAHEF_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. - !> CLAHEF_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'). + !! CLAHEF_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. + !! CLAHEF_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'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9202,26 +9202,26 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claic1( job, j, x, sest, w, gamma, sestpr, s, c ) - !> CLAIC1 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 CLAIC1 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. + !! CLAIC1 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 CLAIC1 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9418,12 +9418,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clapmr( forwrd, m, n, x, ldx, k ) - !> CLAPMR 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. + !! CLAPMR 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9486,12 +9486,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clapmt( forwrd, m, n, x, ldx, k ) - !> CLAPMT 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. + !! CLAPMT 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9554,9 +9554,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) - !> CLAQGB 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. + !! CLAQGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -9624,8 +9624,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed ) - !> CLAQGE equilibrates a general M by N matrix A using the row and - !> column scaling factors in the vectors R and C. + !! CLAQGE equilibrates a general M by N matrix A using the row and + !! column scaling factors in the vectors R and C. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9690,8 +9690,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqhb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) - !> CLAQHB equilibrates an Hermitian band matrix A using the scaling - !> factors in the vector S. + !! CLAQHB equilibrates an Hermitian band matrix A using the scaling + !! factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9752,8 +9752,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqhe( uplo, n, a, lda, s, scond, amax, equed ) - !> CLAQHE equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. + !! CLAQHE equilibrates a Hermitian matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9814,8 +9814,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqhp( uplo, n, ap, s, scond, amax, equed ) - !> CLAQHP equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. + !! CLAQHP equilibrates a Hermitian matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9880,12 +9880,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqr1( n, h, ldh, s1, s2, v ) - !> Given a 2-by-2 or 3-by-3 matrix H, CLAQR1: 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. + !! Given a 2-by-2 or 3-by-3 matrix H, CLAQR1: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9943,8 +9943,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) - !> CLAQSB equilibrates a symmetric band matrix A using the scaling - !> factors in the vector S. + !! CLAQSB equilibrates a symmetric band matrix A using the scaling + !! factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10003,8 +10003,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqsp( uplo, n, ap, s, scond, amax, equed ) - !> CLAQSP equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. + !! CLAQSP equilibrates a symmetric matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10065,8 +10065,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqsy( uplo, n, a, lda, s, scond, amax, equed ) - !> CLAQSY equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. + !! CLAQSY equilibrates a symmetric matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10123,21 +10123,21 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & - !> CLAR1V 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. + !! CLAR1V 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. negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10346,13 +10346,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clar2v( n, x, y, z, incx, c, s, incc ) - !> CLAR2V 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) ) + !! CLAR2V 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) ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10400,10 +10400,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clarcm( m, n, a, lda, b, ldb, c, ldc, rwork ) - !> CLARCM 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. + !! CLARCM 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10454,14 +10454,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clarf( side, m, n, v, incv, tau, c, ldc, work ) - !> CLARF 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. + !! CLARF 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10534,8 +10534,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, ldc, & - !> CLARFB 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. + !! CLARFB 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. work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10862,13 +10862,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) - !> CLARFB_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. + !! CLARFB_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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -11001,19 +11001,19 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clarfg( n, alpha, x, incx, tau ) - !> CLARFG 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 . + !! CLARFG 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 . ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11075,18 +11075,18 @@ module stdlib_linalg_lapack_c subroutine stdlib_clarfgp( n, alpha, x, incx, tau ) - !> CLARFGP 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. + !! CLARFGP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11211,16 +11211,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clarft( direct, storev, n, k, v, ldv, tau, t, ldt ) - !> CLARFT 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 + !! CLARFT 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 ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11338,13 +11338,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clarfx( side, m, n, v, tau, c, ldc, work ) - !> CLARFX 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 - !> This version uses inline code if H has order < 11. + !! CLARFX 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 + !! This version uses inline code if H has order < 11. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11842,12 +11842,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clarfy( uplo, n, v, incv, tau, c, ldc, work ) - !> CLARFY 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. + !! CLARFY 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. ! -- lapack test routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11876,8 +11876,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clarnv( idist, iseed, n, x ) - !> CLARNV returns a vector of n random complex numbers from a uniform or - !> normal distribution. + !! CLARNV returns a vector of n random complex numbers from a uniform or + !! normal distribution. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11941,30 +11941,28 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clartg( f, g, c, s, r ) - !> ! - !> - !> CLARTG 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 CLARTG. - !> 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. + !! CLARTG 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 CLARTG. + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12061,10 +12059,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clartv( n, x, incx, y, incy, c, s, incc ) - !> CLARTV 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) ) + !! CLARTV 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) ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12098,15 +12096,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clarz( side, m, n, l, v, incv, tau, c, ldc, work ) - !> CLARZ 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. + !! CLARZ 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12157,9 +12155,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & - !> CLARZB 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. + !! CLARZB 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. ldc, work, ldwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12259,18 +12257,18 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) - !> CLARZT 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. + !! CLARZT 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12323,11 +12321,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) - !> CLASCL 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. + !! CLASCL 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12493,8 +12491,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claset( uplo, m, n, alpha, beta, a, lda ) - !> CLASET initializes a 2-D array A to BETA on the diagonal and - !> ALPHA on the offdiagonals. + !! CLASET initializes a 2-D array A to BETA on the diagonal and + !! ALPHA on the offdiagonals. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12549,57 +12547,57 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clasr( side, pivot, direct, m, n, c, s, a, lda ) - !> CLASR 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. + !! CLASR 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12809,26 +12807,24 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_classq( n, x, incx, scl, sumsq ) - !> ! - !> - !> CLASSQ 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. + !! CLASSQ 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12935,8 +12931,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claswp( n, a, lda, k1, k2, ipiv, incx ) - !> CLASWP performs a series of row interchanges on the matrix A. - !> One row interchange is initiated for each of rows K1 through K2 of A. + !! CLASWP performs a series of row interchanges on the matrix A. + !! One row interchange is initiated for each of rows K1 through K2 of A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13002,19 +12998,19 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) - !> CLASYF 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. - !> CLASYF 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'). + !! CLASYF 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. + !! CLASYF 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'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13446,18 +13442,18 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) - !> CLASYF_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. - !> CLASYF_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'). + !! CLASYF_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. + !! CLASYF_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'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13892,18 +13888,18 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) - !> CLASYF_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. - !> CLASYF_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'). + !! CLASYF_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. + !! CLASYF_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'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14358,16 +14354,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & - !> CLATBS 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. + !! CLATBS 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. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -14913,17 +14909,17 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) - !> CLATPS 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. + !! CLATPS 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15463,15 +15459,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) - !> CLATRD reduces NB rows and columns of a complex Hermitian matrix A to - !> Hermitian tridiagonal form by a unitary similarity - !> transformation Q**H * A * Q, and returns the matrices V and W which are - !> needed to apply the transformation to the unreduced part of A. - !> If UPLO = 'U', CLATRD reduces the last NB rows and columns of a - !> matrix, of which the upper triangle is supplied; - !> if UPLO = 'L', CLATRD reduces the first NB rows and columns of a - !> matrix, of which the lower triangle is supplied. - !> This is an auxiliary routine called by CHETRD. + !! CLATRD reduces NB rows and columns of a complex Hermitian matrix A to + !! Hermitian tridiagonal form by a unitary similarity + !! transformation Q**H * A * Q, and returns the matrices V and W which are + !! needed to apply the transformation to the unreduced part of A. + !! If UPLO = 'U', CLATRD reduces the last NB rows and columns of a + !! matrix, of which the upper triangle is supplied; + !! if UPLO = 'L', CLATRD reduces the first NB rows and columns of a + !! matrix, of which the lower triangle is supplied. + !! This is an auxiliary routine called by CHETRD. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15579,16 +15575,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) - !> CLATRS 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. Here A is an upper or lower - !> triangular matrix, 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 - !> CTRSV 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. + !! CLATRS 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. Here A is an upper or lower + !! triangular matrix, 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 + !! CTRSV 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16107,10 +16103,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clatrz( m, n, l, a, lda, tau, work ) - !> CLATRZ factors the M-by-(M+L) complex upper trapezoidal matrix - !> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z by means - !> of unitary transformations, where Z is an (M+L)-by-(M+L) unitary - !> matrix and, R and A1 are M-by-M upper triangular matrices. + !! CLATRZ factors the M-by-(M+L) complex upper trapezoidal matrix + !! [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z by means + !! of unitary transformations, where Z is an (M+L)-by-(M+L) unitary + !! matrix and, R and A1 are M-by-M upper triangular matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16153,54 +16149,54 @@ module stdlib_linalg_lapack_c pure recursive subroutine stdlib_claunhr_col_getrfnp2( m, n, a, lda, d, info ) - !> CLAUNHR_COL_GETRFNP2 computes the modified LU factorization without - !> pivoting of a complex 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 CUNHR_COL. In CUNHR_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]. - !> CLAUNHR_COL_GETRFNP2 is called to factorize a block by the blocked - !> routine CLAUNHR_COL_GETRFNP, which uses blocked code calling - !> Level 3 BLAS to update the submatrix. However, CLAUNHR_COL_GETRFNP2 - !> is self-sufficient and can be used without CLAUNHR_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. + !! CLAUNHR_COL_GETRFNP2 computes the modified LU factorization without + !! pivoting of a complex 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 CUNHR_COL. In CUNHR_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]. + !! CLAUNHR_COL_GETRFNP2 is called to factorize a block by the blocked + !! routine CLAUNHR_COL_GETRFNP, which uses blocked code calling + !! Level 3 BLAS to update the submatrix. However, CLAUNHR_COL_GETRFNP2 + !! is self-sufficient and can be used without CLAUNHR_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16289,14 +16285,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clauu2( uplo, n, a, lda, info ) - !> CLAUU2 computes the product U * U**H or L**H * L, where the triangular - !> factor U or L is stored in the upper or lower triangular part of - !> the array A. - !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, - !> overwriting the factor U in A. - !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, - !> overwriting the factor L in A. - !> This is the unblocked form of the algorithm, calling Level 2 BLAS. + !! CLAUU2 computes the product U * U**H or L**H * L, where the triangular + !! factor U or L is stored in the upper or lower triangular part of + !! the array A. + !! If UPLO = 'U' or 'u' then the upper triangle of the result is stored, + !! overwriting the factor U in A. + !! If UPLO = 'L' or 'l' then the lower triangle of the result is stored, + !! overwriting the factor L in A. + !! This is the unblocked form of the algorithm, calling Level 2 BLAS. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16367,14 +16363,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clauum( uplo, n, a, lda, info ) - !> CLAUUM computes the product U * U**H or L**H * L, where the triangular - !> factor U or L is stored in the upper or lower triangular part of - !> the array A. - !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, - !> overwriting the factor U in A. - !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, - !> overwriting the factor L in A. - !> This is the blocked form of the algorithm, calling Level 3 BLAS. + !! CLAUUM computes the product U * U**H or L**H * L, where the triangular + !! factor U or L is stored in the upper or lower triangular part of + !! the array A. + !! If UPLO = 'U' or 'u' then the upper triangle of the result is stored, + !! overwriting the factor U in A. + !! If UPLO = 'L' or 'l' then the lower triangle of the result is stored, + !! overwriting the factor L in A. + !! This is the blocked form of the algorithm, calling Level 3 BLAS. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16451,14 +16447,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) - !> CPBEQU computes row and column scalings intended to equilibrate a - !> Hermitian positive definite band matrix A and reduce its condition - !> number (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. + !! CPBEQU computes row and column scalings intended to equilibrate a + !! Hermitian positive definite band matrix A and reduce its condition + !! number (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16538,15 +16534,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpbstf( uplo, n, kd, ab, ldab, info ) - !> CPBSTF computes a split Cholesky factorization of a complex - !> Hermitian positive definite band matrix A. - !> This routine is designed to be used in conjunction with CHBGST. - !> The factorization has the form A = S**H*S where S is a band matrix - !> of the same bandwidth as A and the following structure: - !> S = ( U ) - !> ( M L ) - !> where U is upper triangular of order m = (n+kd)/2, and L is lower - !> triangular of order n-m. + !! CPBSTF computes a split Cholesky factorization of a complex + !! Hermitian positive definite band matrix A. + !! This routine is designed to be used in conjunction with CHBGST. + !! The factorization has the form A = S**H*S where S is a band matrix + !! of the same bandwidth as A and the following structure: + !! S = ( U ) + !! ( M L ) + !! where U is upper triangular of order m = (n+kd)/2, and L is lower + !! triangular of order n-m. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16672,14 +16668,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpbtf2( uplo, n, kd, ab, ldab, info ) - !> CPBTF2 computes the Cholesky factorization of a complex Hermitian - !> positive definite band matrix A. - !> The factorization has the form - !> A = U**H * U , if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix, U**H is the conjugate transpose - !> of U, and L is lower triangular. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! CPBTF2 computes the Cholesky factorization of a complex Hermitian + !! positive definite band matrix A. + !! The factorization has the form + !! A = U**H * U , if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix, U**H is the conjugate transpose + !! of U, and L is lower triangular. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16767,9 +16763,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) - !> CPBTRS solves a system of linear equations A*X = B with a Hermitian - !> positive definite band matrix A using the Cholesky factorization - !> A = U**H*U or A = L*L**H computed by CPBTRF. + !! CPBTRS solves a system of linear equations A*X = B with a Hermitian + !! positive definite band matrix A using the Cholesky factorization + !! A = U**H*U or A = L*L**H computed by CPBTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16835,14 +16831,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpoequ( n, a, lda, s, scond, amax, info ) - !> CPOEQU computes row and column scalings intended to equilibrate a - !> Hermitian positive definite matrix A and reduce its condition number - !> (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. + !! CPOEQU computes row and column scalings intended to equilibrate a + !! Hermitian positive definite matrix A and reduce its condition number + !! (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16909,19 +16905,19 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpoequb( n, a, lda, s, scond, amax, info ) - !> CPOEQUB computes row and column scalings intended to equilibrate a - !> Hermitian positive definite matrix A and reduce its condition number - !> (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. - !> This routine differs from CPOEQU 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 diagonal entries are no longer approximately 1 but lie - !> between sqrt(radix) and 1/sqrt(radix). + !! CPOEQUB computes row and column scalings intended to equilibrate a + !! Hermitian positive definite matrix A and reduce its condition number + !! (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. + !! This routine differs from CPOEQU 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 diagonal entries are no longer approximately 1 but lie + !! between sqrt(radix) and 1/sqrt(radix). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16991,13 +16987,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpotf2( uplo, n, a, lda, info ) - !> CPOTF2 computes the Cholesky factorization of a complex Hermitian - !> positive definite matrix A. - !> The factorization has the form - !> A = U**H * U , if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! CPOTF2 computes the Cholesky factorization of a complex Hermitian + !! positive definite matrix A. + !! The factorization has the form + !! A = U**H * U , if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17085,19 +17081,19 @@ module stdlib_linalg_lapack_c pure recursive subroutine stdlib_cpotrf2( uplo, n, a, lda, info ) - !> CPOTRF2 computes the Cholesky factorization of a Hermitian - !> positive definite matrix A using the recursive algorithm. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> 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 = n/2 - !> [ A21 | A22 ] n2 = n-n1 - !> The subroutine calls itself to factor A11. Update and scale A21 - !> or A12, update A22 then calls itself to factor A22. + !! CPOTRF2 computes the Cholesky factorization of a Hermitian + !! positive definite matrix A using the recursive algorithm. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! 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 = n/2 + !! [ A21 | A22 ] n2 = n-n1 + !! The subroutine calls itself to factor A11. Update and scale A21 + !! or A12, update A22 then calls itself to factor A22. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17186,9 +17182,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpotrs( uplo, n, nrhs, a, lda, b, ldb, info ) - !> CPOTRS solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A using the Cholesky factorization - !> A = U**H*U or A = L*L**H computed by CPOTRF. + !! CPOTRS solves a system of linear equations A*X = B with a Hermitian + !! positive definite matrix A using the Cholesky factorization + !! A = U**H*U or A = L*L**H computed by CPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17248,14 +17244,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cppequ( uplo, n, ap, s, scond, amax, info ) - !> CPPEQU computes row and column scalings intended to equilibrate a - !> Hermitian positive definite matrix A in packed storage and reduce - !> its condition number (with respect to the two-norm). S contains the - !> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix - !> B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal. - !> This choice of S puts the condition number of B within a factor N of - !> the smallest possible condition number over all possible diagonal - !> scalings. + !! CPPEQU computes row and column scalings intended to equilibrate a + !! Hermitian positive definite matrix A in packed storage and reduce + !! its condition number (with respect to the two-norm). S contains the + !! scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix + !! B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal. + !! This choice of S puts the condition number of B within a factor N of + !! the smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17341,12 +17337,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpptrf( uplo, n, ap, info ) - !> CPPTRF computes the Cholesky factorization of a complex Hermitian - !> positive definite matrix A stored in packed format. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. + !! CPPTRF computes the Cholesky factorization of a complex Hermitian + !! positive definite matrix A stored in packed format. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17427,9 +17423,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpptrs( uplo, n, nrhs, ap, b, ldb, info ) - !> CPPTRS solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A in packed storage using the Cholesky - !> factorization A = U**H*U or A = L*L**H computed by CPPTRF. + !! CPPTRS solves a system of linear equations A*X = B with a Hermitian + !! positive definite matrix A in packed storage using the Cholesky + !! factorization A = U**H*U or A = L*L**H computed by CPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17491,15 +17487,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpstf2( uplo, n, a, lda, piv, rank, tol, work, info ) - !> CPSTF2 computes the Cholesky factorization with complete - !> pivoting of a complex Hermitian positive semidefinite matrix A. - !> The factorization has the form - !> P**T * A * P = U**H * U , if UPLO = 'U', - !> P**T * A * P = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular, and - !> P is stored as vector PIV. - !> This algorithm does not attempt to check that A is positive - !> semidefinite. This version of the algorithm calls level 2 BLAS. + !! CPSTF2 computes the Cholesky factorization with complete + !! pivoting of a complex Hermitian positive semidefinite matrix A. + !! The factorization has the form + !! P**T * A * P = U**H * U , if UPLO = 'U', + !! P**T * A * P = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular, and + !! P is stored as vector PIV. + !! This algorithm does not attempt to check that A is positive + !! semidefinite. This version of the algorithm calls level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17685,15 +17681,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) - !> CPSTRF computes the Cholesky factorization with complete - !> pivoting of a complex Hermitian positive semidefinite matrix A. - !> The factorization has the form - !> P**T * A * P = U**H * U , if UPLO = 'U', - !> P**T * A * P = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular, and - !> P is stored as vector PIV. - !> This algorithm does not attempt to check that A is positive - !> semidefinite. This version of the algorithm calls level 3 BLAS. + !! CPSTRF computes the Cholesky factorization with complete + !! pivoting of a complex Hermitian positive semidefinite matrix A. + !! The factorization has the form + !! P**T * A * P = U**H * U , if UPLO = 'U', + !! P**T * A * P = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular, and + !! P is stored as vector PIV. + !! This algorithm does not attempt to check that A is positive + !! semidefinite. This version of the algorithm calls level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17911,13 +17907,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cptcon( n, d, e, anorm, rcond, rwork, info ) - !> CPTCON computes the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite tridiagonal matrix - !> using the factorization A = L*D*L**H or A = U**H*D*U computed by - !> CPTTRF. - !> Norm(inv(A)) is computed by a direct method, and the reciprocal of - !> the condition number is computed as - !> RCOND = 1 / (ANORM * norm(inv(A))). + !! CPTCON computes the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite tridiagonal matrix + !! using the factorization A = L*D*L**H or A = U**H*D*U computed by + !! CPTTRF. + !! Norm(inv(A)) is computed by a direct method, and the reciprocal of + !! the condition number is computed as + !! RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17985,9 +17981,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpttrf( n, d, e, info ) - !> CPTTRF computes the L*D*L**H factorization of a complex Hermitian - !> positive definite tridiagonal matrix A. The factorization may also - !> be regarded as having the form A = U**H *D*U. + !! CPTTRF computes the L*D*L**H factorization of a complex Hermitian + !! positive definite tridiagonal matrix A. The factorization may also + !! be regarded as having the form A = U**H *D*U. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18084,12 +18080,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cptts2( iuplo, n, nrhs, d, e, b, ldb ) - !> CPTTS2 solves a tridiagonal system of the form - !> A * X = B - !> using the factorization A = U**H*D*U or A = L*D*L**H computed by CPTTRF. - !> D is a diagonal matrix specified in the vector D, U (or L) is a unit - !> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in - !> the vector E, and X and B are N by NRHS matrices. + !! CPTTS2 solves a tridiagonal system of the form + !! A * X = B + !! using the factorization A = U**H*D*U or A = L*D*L**H computed by CPTTRF. + !! D is a diagonal matrix specified in the vector D, U (or L) is a unit + !! bidiagonal matrix whose superdiagonal (subdiagonal) is specified in + !! the vector E, and X and B are N by NRHS matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18184,8 +18180,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_crot( n, cx, incx, cy, incy, c, s ) - !> CROT applies a plane rotation, where the cos (C) is real and the - !> sin (S) is complex, and the vectors CX and CY are complex. + !! CROT applies a plane rotation, where the cos (C) is real and the + !! sin (S) is complex, and the vectors CX and CY are complex. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18229,10 +18225,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cspmv( uplo, n, alpha, ap, x, incx, beta, y, incy ) - !> CSPMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix, supplied in packed form. + !! CSPMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix, supplied in packed form. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18387,10 +18383,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cspr( uplo, n, alpha, x, incx, ap ) - !> CSPR performs the symmetric rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a complex scalar, x is an n element vector and A is an - !> n by n symmetric matrix, supplied in packed form. + !! CSPR performs the symmetric rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a complex scalar, x is an n element vector and A is an + !! n by n symmetric matrix, supplied in packed form. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18507,13 +18503,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csptrf( uplo, n, ap, ipiv, info ) - !> CSPTRF computes the factorization of a complex symmetric matrix A - !> stored in packed format using the Bunch-Kaufman diagonal pivoting - !> method: - !> 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 symmetric and block diagonal with - !> 1-by-1 and 2-by-2 diagonal blocks. + !! CSPTRF computes the factorization of a complex symmetric matrix A + !! stored in packed format using the Bunch-Kaufman diagonal pivoting + !! method: + !! 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 symmetric and block diagonal with + !! 1-by-1 and 2-by-2 diagonal blocks. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18836,9 +18832,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csptri( uplo, n, ap, ipiv, work, info ) - !> CSPTRI computes the inverse of a complex symmetric indefinite matrix - !> A in packed storage using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by CSPTRF. + !! CSPTRI computes the inverse of a complex symmetric indefinite matrix + !! A in packed storage using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by CSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19047,9 +19043,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> CSPTRS solves a system of linear equations A*X = B with a complex - !> symmetric matrix A stored in packed format using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by CSPTRF. + !! CSPTRS solves a system of linear equations A*X = B with a complex + !! symmetric matrix A stored in packed format using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by CSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19267,9 +19263,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csrscl( n, sa, sx, incx ) - !> CSRSCL multiplies an n-element complex vector x by the real scalar - !> 1/a. This is done without overflow or underflow as long as - !> the final result x/a does not overflow or underflow. + !! CSRSCL multiplies an n-element complex vector x by the real scalar + !! 1/a. This is done without overflow or underflow as long as + !! the final result x/a does not overflow or underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19321,15 +19317,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & - !> CSTEIN computes the eigenvectors of a real symmetric tridiagonal - !> matrix T corresponding to specified eigenvalues, using inverse - !> iteration. - !> The maximum number of iterations allowed for each eigenvector is - !> specified by an internal parameter MAXITS (currently set to 5). - !> Although the eigenvectors are real, they are stored in a complex - !> array, which may be passed to CUNMTR or CUPMTR for back - !> transformation to the eigenvectors of a complex Hermitian matrix - !> which was reduced to tridiagonal form. + !! CSTEIN computes the eigenvectors of a real symmetric tridiagonal + !! matrix T corresponding to specified eigenvalues, using inverse + !! iteration. + !! The maximum number of iterations allowed for each eigenvector is + !! specified by an internal parameter MAXITS (currently set to 5). + !! Although the eigenvectors are real, they are stored in a complex + !! array, which may be passed to CUNMTR or CUPMTR for back + !! transformation to the eigenvectors of a complex Hermitian matrix + !! which was reduced to tridiagonal form. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19531,11 +19527,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csteqr( compz, n, d, e, z, ldz, work, info ) - !> CSTEQR computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric tridiagonal matrix using the implicit QL or QR method. - !> The eigenvectors of a full or band complex Hermitian matrix can also - !> be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this - !> matrix to tridiagonal form. + !! CSTEQR computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric tridiagonal matrix using the implicit QL or QR method. + !! The eigenvectors of a full or band complex Hermitian matrix can also + !! be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this + !! matrix to tridiagonal form. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19851,9 +19847,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csyconv( uplo, way, n, a, lda, ipiv, e, info ) - !> CSYCONV convert A given by TRF into L and D and vice-versa. - !> Get Non-diag elements of D (returned in workspace) and - !> apply or reverse permutation done in TRF. + !! CSYCONV convert A given by TRF into L and D and vice-versa. + !! Get Non-diag elements of D (returned in workspace) and + !! apply or reverse permutation done in TRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20056,23 +20052,23 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csyconvf( uplo, way, n, a, lda, e, ipiv, info ) - !> If parameter WAY = 'C': - !> CSYCONVF converts the factorization output format used in - !> CSYTRF provided on entry in parameter A into the factorization - !> output format used in CSYTRF_RK (or CSYTRF_BK) that is stored - !> on exit in parameters A and E. It also converts in place details of - !> the intechanges stored in IPIV from the format used in CSYTRF into - !> the format used in CSYTRF_RK (or CSYTRF_BK). - !> If parameter WAY = 'R': - !> CSYCONVF performs the conversion in reverse direction, i.e. - !> converts the factorization output format used in CSYTRF_RK - !> (or CSYTRF_BK) provided on entry in parameters A and E into - !> the factorization output format used in CSYTRF that is stored - !> on exit in parameter A. It also converts in place details of - !> the intechanges stored in IPIV from the format used in CSYTRF_RK - !> (or CSYTRF_BK) into the format used in CSYTRF. - !> CSYCONVF can also convert in Hermitian matrix case, i.e. between - !> formats used in CHETRF and CHETRF_RK (or CHETRF_BK). + !! If parameter WAY = 'C': + !! CSYCONVF converts the factorization output format used in + !! CSYTRF provided on entry in parameter A into the factorization + !! output format used in CSYTRF_RK (or CSYTRF_BK) that is stored + !! on exit in parameters A and E. It also converts in place details of + !! the intechanges stored in IPIV from the format used in CSYTRF into + !! the format used in CSYTRF_RK (or CSYTRF_BK). + !! If parameter WAY = 'R': + !! CSYCONVF performs the conversion in reverse direction, i.e. + !! converts the factorization output format used in CSYTRF_RK + !! (or CSYTRF_BK) provided on entry in parameters A and E into + !! the factorization output format used in CSYTRF that is stored + !! on exit in parameter A. It also converts in place details of + !! the intechanges stored in IPIV from the format used in CSYTRF_RK + !! (or CSYTRF_BK) into the format used in CSYTRF. + !! CSYCONVF can also convert in Hermitian matrix case, i.e. between + !! formats used in CHETRF and CHETRF_RK (or CHETRF_BK). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20313,21 +20309,21 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) - !> If parameter WAY = 'C': - !> CSYCONVF_ROOK converts the factorization output format used in - !> CSYTRF_ROOK provided on entry in parameter A into the factorization - !> output format used in CSYTRF_RK (or CSYTRF_BK) that is stored - !> on exit in parameters A and E. IPIV format for CSYTRF_ROOK and - !> CSYTRF_RK (or CSYTRF_BK) is the same and is not converted. - !> If parameter WAY = 'R': - !> CSYCONVF_ROOK performs the conversion in reverse direction, i.e. - !> converts the factorization output format used in CSYTRF_RK - !> (or CSYTRF_BK) provided on entry in parameters A and E into - !> the factorization output format used in CSYTRF_ROOK that is stored - !> on exit in parameter A. IPIV format for CSYTRF_ROOK and - !> CSYTRF_RK (or CSYTRF_BK) is the same and is not converted. - !> CSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between - !> formats used in CHETRF_ROOK and CHETRF_RK (or CHETRF_BK). + !! If parameter WAY = 'C': + !! CSYCONVF_ROOK converts the factorization output format used in + !! CSYTRF_ROOK provided on entry in parameter A into the factorization + !! output format used in CSYTRF_RK (or CSYTRF_BK) that is stored + !! on exit in parameters A and E. IPIV format for CSYTRF_ROOK and + !! CSYTRF_RK (or CSYTRF_BK) is the same and is not converted. + !! If parameter WAY = 'R': + !! CSYCONVF_ROOK performs the conversion in reverse direction, i.e. + !! converts the factorization output format used in CSYTRF_RK + !! (or CSYTRF_BK) provided on entry in parameters A and E into + !! the factorization output format used in CSYTRF_ROOK that is stored + !! on exit in parameter A. IPIV format for CSYTRF_ROOK and + !! CSYTRF_RK (or CSYTRF_BK) is the same and is not converted. + !! CSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between + !! formats used in CHETRF_ROOK and CHETRF_RK (or CHETRF_BK). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20568,13 +20564,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csyequb( uplo, n, a, lda, s, scond, amax, work, info ) - !> CSYEQUB computes row and column scalings intended to equilibrate a - !> symmetric 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. + !! CSYEQUB computes row and column scalings intended to equilibrate a + !! symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20750,10 +20746,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csymv( uplo, n, alpha, a, lda, x, incx, beta, y, incy ) - !> CSYMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix. + !! CSYMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20904,10 +20900,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csyr( uplo, n, alpha, x, incx, a, lda ) - !> CSYR performs the symmetric rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a complex scalar, x is an n element vector and A is an - !> n by n symmetric matrix. + !! CSYR performs the symmetric rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a complex scalar, x is an n element vector and A is an + !! n by n symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21008,8 +21004,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csyswapr( uplo, n, a, lda, i1, i2) - !> CSYSWAPR applies an elementary permutation on the rows and the columns of - !> a symmetric matrix. + !! CSYSWAPR applies an elementary permutation on the rows and the columns of + !! a symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21076,13 +21072,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csytf2( uplo, n, a, lda, ipiv, info ) - !> CSYTF2 computes the factorization of a complex symmetric matrix A - !> using the Bunch-Kaufman diagonal pivoting method: - !> 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, U**T is the transpose of U, and D is symmetric 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. + !! CSYTF2 computes the factorization of a complex symmetric matrix A + !! using the Bunch-Kaufman diagonal pivoting method: + !! 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, U**T is the transpose of U, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21367,15 +21363,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csytf2_rk( uplo, n, a, lda, e, ipiv, info ) - !> CSYTF2_RK computes the factorization of a complex symmetric matrix A - !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric 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. + !! CSYTF2_RK computes the factorization of a complex symmetric matrix A + !! using the bounded Bunch-Kaufman (rook) diagonal pivoting method: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21824,13 +21820,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csytf2_rook( uplo, n, a, lda, ipiv, info ) - !> CSYTF2_ROOK computes the factorization of a complex symmetric matrix A - !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: - !> 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, U**T is the transpose of U, and D is symmetric 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. + !! CSYTF2_ROOK computes the factorization of a complex symmetric matrix A + !! using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: + !! 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, U**T is the transpose of U, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22240,14 +22236,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csytrf( uplo, n, a, lda, ipiv, work, lwork, info ) - !> CSYTRF computes the factorization of a complex symmetric matrix A - !> using the Bunch-Kaufman 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 symmetric 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. + !! CSYTRF computes the factorization of a complex symmetric matrix A + !! using the Bunch-Kaufman 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 symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22366,15 +22362,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) - !> CSYTRF_RK computes the factorization of a complex symmetric matrix A - !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric 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. + !! CSYTRF_RK computes the factorization of a complex symmetric matrix A + !! using the bounded Bunch-Kaufman (rook) diagonal pivoting method: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22532,14 +22528,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) - !> CSYTRF_ROOK computes the factorization of a complex symmetric 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 symmetric 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. + !! CSYTRF_ROOK computes the factorization of a complex symmetric 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 symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22660,9 +22656,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csytri( uplo, n, a, lda, ipiv, work, info ) - !> CSYTRI computes the inverse of a complex symmetric indefinite matrix - !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by - !> CSYTRF. + !! CSYTRI computes the inverse of a complex symmetric indefinite matrix + !! A using the factorization A = U*D*U**T or A = L*D*L**T computed by + !! CSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22848,9 +22844,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csytri_rook( uplo, n, a, lda, ipiv, work, info ) - !> CSYTRI_ROOK computes the inverse of a complex symmetric - !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T - !> computed by CSYTRF_ROOK. + !! CSYTRI_ROOK computes the inverse of a complex symmetric + !! matrix A using the factorization A = U*D*U**T or A = L*D*L**T + !! computed by CSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23076,9 +23072,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) - !> CSYTRS solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by CSYTRF. + !! CSYTRS solves a system of linear equations A*X = B with a complex + !! symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by CSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23286,9 +23282,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) - !> CSYTRS2 solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by CSYTRF and converted by CSYCONV. + !! CSYTRS2 solves a system of linear equations A*X = B with a complex + !! symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by CSYTRF and converted by CSYCONV. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23464,15 +23460,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) - !> CSYTRS_3 solves a system of linear equations A * X = B with a complex - !> symmetric matrix A using the factorization computed - !> by CSYTRF_RK or CSYTRF_BK: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric and block - !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. - !> This algorithm is using Level 3 BLAS. + !! CSYTRS_3 solves a system of linear equations A * X = B with a complex + !! symmetric matrix A using the factorization computed + !! by CSYTRF_RK or CSYTRF_BK: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric and block + !! diagonal with 1-by-1 and 2-by-2 diagonal blocks. + !! This algorithm is using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23621,9 +23617,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) - !> CSYTRS_AA solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U**T*T*U or - !> A = L*T*L**T computed by CSYTRF_AA. + !! CSYTRS_AA solves a system of linear equations A*X = B with a complex + !! symmetric matrix A using the factorization A = U**T*T*U or + !! A = L*T*L**T computed by CSYTRF_AA. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23740,9 +23736,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) - !> CSYTRS_ROOK solves a system of linear equations A*X = B with - !> a complex symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by CSYTRF_ROOK. + !! CSYTRS_ROOK solves a system of linear equations A*X = B with + !! a complex symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by CSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23962,12 +23958,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& - !> CTBRFS provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular band - !> coefficient matrix. - !> The solution matrix X must be computed by CTBTRS or some other - !> means before entering this routine. CTBRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! CTBRFS provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular band + !! coefficient matrix. + !! The solution matrix X must be computed by CTBTRS or some other + !! means before entering this routine. CTBRFS does not do iterative + !! refinement because doing so cannot improve the backward error. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24205,10 +24201,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) - !> CTBTRS solves a triangular system of the form - !> A * X = B, A**T * X = B, or A**H * X = B, - !> where A is a triangular band matrix of order N, and B is an - !> N-by-NRHS matrix. A check is made to verify that A is nonsingular. + !! CTBTRS solves a triangular system of the form + !! A * X = B, A**T * X = B, or A**H * X = B, + !! where A is a triangular band matrix of order N, and B is an + !! N-by-NRHS matrix. A check is made to verify that A is nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24278,14 +24274,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) - !> Level 3 BLAS like routine for A in RFP Format. - !> CTFSM solves the matrix equation - !> op( A )*X = alpha*B or X*op( A ) = alpha*B - !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**H. - !> A is in Rectangular Full Packed (RFP) Format. - !> The matrix X is overwritten on B. + !! Level 3 BLAS like routine for A in RFP Format. + !! CTFSM solves the matrix equation + !! op( A )*X = alpha*B or X*op( A ) = alpha*B + !! where alpha is a scalar, X and B are m by n matrices, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**H. + !! A is in Rectangular Full Packed (RFP) Format. + !! The matrix X is overwritten on B. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24780,8 +24776,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctfttp( transr, uplo, n, arf, ap, info ) - !> CTFTTP copies a triangular matrix A from rectangular full packed - !> format (TF) to standard packed format (TP). + !! CTFTTP copies a triangular matrix A from rectangular full packed + !! format (TF) to standard packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25039,8 +25035,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctfttr( transr, uplo, n, arf, a, lda, info ) - !> CTFTTR copies a triangular matrix A from rectangular full packed - !> format (TF) to standard full format (TR). + !! CTFTTR copies a triangular matrix A from rectangular full packed + !! format (TF) to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25289,24 +25285,24 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & - !> CTGEVC computes some or all of the right and/or left eigenvectors of - !> a pair of complex matrices (S,P), where S and P are upper triangular. - !> Matrix pairs of this type are produced by the generalized Schur - !> factorization of a complex matrix pair (A,B): - !> A = Q*S*Z**H, B = Q*P*Z**H - !> as computed by CGGHRD + CHGEQZ. - !> The right eigenvector x and the left eigenvector y of (S,P) - !> corresponding to an eigenvalue w are defined by: - !> S*x = w*P*x, (y**H)*S = w*(y**H)*P, - !> where y**H denotes the conjugate tranpose of y. - !> The eigenvalues are not input to this routine, but are computed - !> directly from the diagonal elements of S and P. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of (S,P), or the products Z*X and/or Q*Y, - !> where Z and Q are input matrices. - !> If Q and Z are the unitary factors from the generalized Schur - !> factorization of a matrix pair (A,B), then Z*X and Q*Y - !> are the matrices of right and left eigenvectors of (A,B). + !! CTGEVC computes some or all of the right and/or left eigenvectors of + !! a pair of complex matrices (S,P), where S and P are upper triangular. + !! Matrix pairs of this type are produced by the generalized Schur + !! factorization of a complex matrix pair (A,B): + !! A = Q*S*Z**H, B = Q*P*Z**H + !! as computed by CGGHRD + CHGEQZ. + !! The right eigenvector x and the left eigenvector y of (S,P) + !! corresponding to an eigenvalue w are defined by: + !! S*x = w*P*x, (y**H)*S = w*(y**H)*P, + !! where y**H denotes the conjugate tranpose of y. + !! The eigenvalues are not input to this routine, but are computed + !! directly from the diagonal elements of S and P. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of (S,P), or the products Z*X and/or Q*Y, + !! where Z and Q are input matrices. + !! If Q and Z are the unitary factors from the generalized Schur + !! factorization of a matrix pair (A,B), then Z*X and Q*Y + !! are the matrices of right and left eigenvectors of (A,B). mm, m, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25702,15 +25698,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, info ) - !> CTGEX2 swaps adjacent diagonal 1 by 1 blocks (A11,B11) and (A22,B22) - !> in an upper triangular matrix pair (A, B) by an unitary equivalence - !> transformation. - !> (A, B) must be in generalized Schur canonical form, that is, A and - !> B are both upper triangular. - !> Optionally, the matrices Q and Z of generalized Schur vectors are - !> updated. - !> Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H - !> Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H + !! CTGEX2 swaps adjacent diagonal 1 by 1 blocks (A11,B11) and (A22,B22) + !! in an upper triangular matrix pair (A, B) by an unitary equivalence + !! transformation. + !! (A, B) must be in generalized Schur canonical form, that is, A and + !! B are both upper triangular. + !! Optionally, the matrices Q and Z of generalized Schur vectors are + !! updated. + !! Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H + !! Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25842,16 +25838,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & - !> CTGEXC reorders the generalized Schur decomposition of a complex - !> matrix pair (A,B), using an unitary equivalence transformation - !> (A, B) := Q * (A, B) * Z**H, so that the diagonal block of (A, B) with - !> row index IFST is moved to row ILST. - !> (A, B) must be in generalized Schur canonical form, that is, A and - !> B are both upper triangular. - !> Optionally, the matrices Q and Z of generalized Schur vectors are - !> updated. - !> Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H - !> Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H + !! CTGEXC reorders the generalized Schur decomposition of a complex + !! matrix pair (A,B), using an unitary equivalence transformation + !! (A, B) := Q * (A, B) * Z**H, so that the diagonal block of (A, B) with + !! row index IFST is moved to row ILST. + !! (A, B) must be in generalized Schur canonical form, that is, A and + !! B are both upper triangular. + !! Optionally, the matrices Q and Z of generalized Schur vectors are + !! updated. + !! Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H + !! Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25926,9 +25922,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) - !> CTPLQT2 computes a LQ a factorization of a complex "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. + !! CTPLQT2 computes a LQ a factorization of a complex "triangular-pentagonal" + !! matrix C, which is composed of a triangular block A and pentagonal block B, + !! using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26042,9 +26038,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) - !> CTPQRT2 computes a QR factorization of a complex "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. + !! CTPQRT2 computes a QR factorization of a complex "triangular-pentagonal" + !! matrix C, which is composed of a triangular block A and pentagonal block B, + !! using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26133,9 +26129,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & - !> CTPRFB applies a complex "triangular-pentagonal" block reflector H or its - !> conjugate transpose H**H to a complex matrix C, which is composed of two - !> blocks A and B, either from the left or right. + !! CTPRFB applies a complex "triangular-pentagonal" block reflector H or its + !! conjugate transpose H**H to a complex matrix C, which is composed of two + !! blocks A and B, either from the left or right. lda, b, ldb, work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26553,12 +26549,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & - !> CTPRFS provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular packed - !> coefficient matrix. - !> The solution matrix X must be computed by CTPTRS or some other - !> means before entering this routine. CTPRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! CTPRFS provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular packed + !! coefficient matrix. + !! The solution matrix X must be computed by CTPTRS or some other + !! means before entering this routine. CTPRFS does not do iterative + !! refinement because doing so cannot improve the backward error. work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26804,8 +26800,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctptri( uplo, diag, n, ap, info ) - !> CTPTRI computes the inverse of a complex upper or lower triangular - !> matrix A stored in packed format. + !! CTPTRI computes the inverse of a complex upper or lower triangular + !! matrix A stored in packed format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26894,11 +26890,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) - !> CTPTRS solves a triangular system of the form - !> A * X = B, A**T * X = B, or A**H * X = B, - !> where A is a triangular matrix of order N stored in packed format, - !> and B is an N-by-NRHS matrix. A check is made to verify that A is - !> nonsingular. + !! CTPTRS solves a triangular system of the form + !! A * X = B, A**T * X = B, or A**H * X = B, + !! where A is a triangular matrix of order N stored in packed format, + !! and B is an N-by-NRHS matrix. A check is made to verify that A is + !! nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26967,8 +26963,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctpttf( transr, uplo, n, ap, arf, info ) - !> CTPTTF copies a triangular matrix A from standard packed format (TP) - !> to rectangular full packed format (TF). + !! CTPTTF copies a triangular matrix A from standard packed format (TP) + !! to rectangular full packed format (TF). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27225,8 +27221,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctpttr( uplo, n, ap, a, lda, info ) - !> CTPTTR copies a triangular matrix A from standard packed format (TP) - !> to standard full format (TR). + !! CTPTTR copies a triangular matrix A from standard packed format (TP) + !! to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27279,21 +27275,21 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & - !> CTREVC computes some or all of the right and/or left eigenvectors of - !> a complex upper triangular matrix T. - !> Matrices of this type are produced by the Schur factorization of - !> a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. - !> The right eigenvector x and the left eigenvector y of T corresponding - !> to an eigenvalue w are defined by: - !> T*x = w*x, (y**H)*T = w*(y**H) - !> where y**H denotes the conjugate transpose of the vector y. - !> The eigenvalues are not input to this routine, but are read directly - !> from the diagonal of T. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an - !> input matrix. If Q is the unitary factor that reduces a matrix A to - !> Schur form T, then Q*X and Q*Y are the matrices of right and left - !> eigenvectors of A. + !! CTREVC computes some or all of the right and/or left eigenvectors of + !! a complex upper triangular matrix T. + !! Matrices of this type are produced by the Schur factorization of + !! a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. + !! The right eigenvector x and the left eigenvector y of T corresponding + !! to an eigenvalue w are defined by: + !! T*x = w*x, (y**H)*T = w*(y**H) + !! where y**H denotes the conjugate transpose of the vector y. + !! The eigenvalues are not input to this routine, but are read directly + !! from the diagonal of T. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an + !! input matrix. If Q is the unitary factor that reduces a matrix A to + !! Schur form T, then Q*X and Q*Y are the matrices of right and left + !! eigenvectors of A. work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27479,22 +27475,22 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctrevc3( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & - !> CTREVC3 computes some or all of the right and/or left eigenvectors of - !> a complex upper triangular matrix T. - !> Matrices of this type are produced by the Schur factorization of - !> a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. - !> The right eigenvector x and the left eigenvector y of T corresponding - !> to an eigenvalue w are defined by: - !> T*x = w*x, (y**H)*T = w*(y**H) - !> where y**H denotes the conjugate transpose of the vector y. - !> The eigenvalues are not input to this routine, but are read directly - !> from the diagonal of T. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an - !> input matrix. If Q is the unitary factor that reduces a matrix A to - !> Schur form T, then Q*X and Q*Y are the matrices of right and left - !> eigenvectors of A. - !> This uses a Level 3 BLAS version of the back transformation. + !! CTREVC3 computes some or all of the right and/or left eigenvectors of + !! a complex upper triangular matrix T. + !! Matrices of this type are produced by the Schur factorization of + !! a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. + !! The right eigenvector x and the left eigenvector y of T corresponding + !! to an eigenvalue w are defined by: + !! T*x = w*x, (y**H)*T = w*(y**H) + !! where y**H denotes the conjugate transpose of the vector y. + !! The eigenvalues are not input to this routine, but are read directly + !! from the diagonal of T. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an + !! input matrix. If Q is the unitary factor that reduces a matrix A to + !! Schur form T, then Q*X and Q*Y are the matrices of right and left + !! eigenvectors of A. + !! This uses a Level 3 BLAS version of the back transformation. work, lwork, rwork, lrwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27776,12 +27772,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctrexc( compq, n, t, ldt, q, ldq, ifst, ilst, info ) - !> CTREXC reorders the Schur factorization of a complex matrix - !> A = Q*T*Q**H, so that the diagonal element of T with row index IFST - !> is moved to row ILST. - !> The Schur form T is reordered by a unitary similarity transformation - !> Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by - !> postmultplying it with Z. + !! CTREXC reorders the Schur factorization of a complex matrix + !! A = Q*T*Q**H, so that the diagonal element of T with row index IFST + !! is moved to row ILST. + !! The Schur form T is reordered by a unitary similarity transformation + !! Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by + !! postmultplying it with Z. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27855,12 +27851,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& - !> CTRRFS provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular - !> coefficient matrix. - !> The solution matrix X must be computed by CTRTRS or some other - !> means before entering this routine. CTRRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! CTRRFS provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular + !! coefficient matrix. + !! The solution matrix X must be computed by CTRTRS or some other + !! means before entering this routine. CTRRFS does not do iterative + !! refinement because doing so cannot improve the backward error. work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28096,9 +28092,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctrsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm,& - !> CTRSNA estimates reciprocal condition numbers for specified - !> eigenvalues and/or right eigenvectors of a complex upper triangular - !> matrix T (or of any matrix Q*T*Q**H with Q unitary). + !! CTRSNA estimates reciprocal condition numbers for specified + !! eigenvalues and/or right eigenvectors of a complex upper triangular + !! matrix T (or of any matrix Q*T*Q**H with Q unitary). m, work, ldwork, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28245,9 +28241,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctrti2( uplo, diag, n, a, lda, info ) - !> CTRTI2 computes the inverse of a complex upper or lower triangular - !> matrix. - !> This is the Level 2 BLAS version of the algorithm. + !! CTRTI2 computes the inverse of a complex upper or lower triangular + !! matrix. + !! This is the Level 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28319,9 +28315,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctrtri( uplo, diag, n, a, lda, info ) - !> CTRTRI computes the inverse of a complex upper or lower triangular - !> matrix A. - !> This is the Level 3 BLAS version of the algorithm. + !! CTRTRI computes the inverse of a complex upper or lower triangular + !! matrix A. + !! This is the Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28406,10 +28402,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) - !> CTRTRS solves a triangular system of the form - !> A * X = B, A**T * X = B, or A**H * X = B, - !> where A is a triangular matrix of order N, and B is an N-by-NRHS - !> matrix. A check is made to verify that A is nonsingular. + !! CTRTRS solves a triangular system of the form + !! A * X = B, A**T * X = B, or A**H * X = B, + !! where A is a triangular matrix of order N, and B is an N-by-NRHS + !! matrix. A check is made to verify that A is nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28466,8 +28462,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctrttf( transr, uplo, n, a, lda, arf, info ) - !> CTRTTF copies a triangular matrix A from standard full format (TR) - !> to rectangular full packed format (TF) . + !! CTRTTF copies a triangular matrix A from standard full format (TR) + !! to rectangular full packed format (TF) . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28715,8 +28711,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctrttp( uplo, n, a, lda, ap, info ) - !> CTRTTP copies a triangular matrix A from full format (TR) to standard - !> packed format (TP). + !! CTRTTP copies a triangular matrix A from full format (TR) to standard + !! packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28769,12 +28765,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctzrzf( m, n, a, lda, tau, work, lwork, info ) - !> CTZRZF reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A - !> to upper triangular form by means of unitary transformations. - !> The upper trapezoidal matrix A is factored as - !> A = ( R 0 ) * Z, - !> where Z is an N-by-N unitary matrix and R is an M-by-M upper - !> triangular matrix. + !! CTZRZF reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A + !! to upper triangular form by means of unitary transformations. + !! The upper trapezoidal matrix A is factored as + !! A = ( R 0 ) * Z, + !! where Z is an N-by-N unitary matrix and R is an M-by-M upper + !! triangular matrix. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28885,22 +28881,22 @@ module stdlib_linalg_lapack_c subroutine stdlib_cunbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & - !> CUNBDB simultaneously bidiagonalizes the blocks of an M-by-M - !> partitioned unitary matrix X: - !> [ B11 | B12 0 0 ] - !> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**H - !> X = [-----------] = [---------] [----------------] [---------] . - !> [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] - !> [ 0 | 0 0 I ] - !> X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is - !> not the case, 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 unitary matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- - !> (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are - !> represented implicitly by Householder vectors. - !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! CUNBDB simultaneously bidiagonalizes the blocks of an M-by-M + !! partitioned unitary matrix X: + !! [ B11 | B12 0 0 ] + !! [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**H + !! X = [-----------] = [---------] [----------------] [---------] . + !! [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] + !! [ 0 | 0 0 I ] + !! X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is + !! not the case, 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 unitary matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- + !! (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are + !! represented implicitly by Householder vectors. + !! B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented + !! implicitly by angles THETA, PHI. ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29208,15 +29204,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & - !> CUNBDB6 orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then the zero vector is returned. + !! CUNBDB6 orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then the zero vector is returned. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29336,11 +29332,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cung2l( m, n, k, a, lda, tau, work, info ) - !> CUNG2L generates an m by n complex matrix Q with orthonormal columns, - !> which is defined as the last n columns of a product of k elementary - !> reflectors of order m - !> Q = H(k) . . . H(2) H(1) - !> as returned by CGEQLF. + !! CUNG2L generates an m by n complex matrix Q with orthonormal columns, + !! which is defined as the last n columns of a product of k elementary + !! reflectors of order m + !! Q = H(k) . . . H(2) H(1) + !! as returned by CGEQLF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29400,11 +29396,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cung2r( m, n, k, a, lda, tau, work, info ) - !> CUNG2R generates an m by n complex matrix Q with orthonormal columns, - !> which is defined as the first n columns of a product of k elementary - !> reflectors of order m - !> Q = H(1) H(2) . . . H(k) - !> as returned by CGEQRF. + !! CUNG2R generates an m by n complex matrix Q with orthonormal columns, + !! which is defined as the first n columns of a product of k elementary + !! reflectors of order m + !! Q = H(1) H(2) . . . H(k) + !! as returned by CGEQRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29465,11 +29461,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cungl2( m, n, k, a, lda, tau, work, info ) - !> CUNGL2 generates an m-by-n complex matrix Q with orthonormal rows, - !> which is defined as the first m rows of a product of k elementary - !> reflectors of order n - !> Q = H(k)**H . . . H(2)**H H(1)**H - !> as returned by CGELQF. + !! CUNGL2 generates an m-by-n complex matrix Q with orthonormal rows, + !! which is defined as the first m rows of a product of k elementary + !! reflectors of order n + !! Q = H(k)**H . . . H(2)**H H(1)**H + !! as returned by CGELQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29536,11 +29532,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunglq( m, n, k, a, lda, tau, work, lwork, info ) - !> CUNGLQ generates an M-by-N complex matrix Q with orthonormal rows, - !> which is defined as the first M rows of a product of K elementary - !> reflectors of order N - !> Q = H(k)**H . . . H(2)**H H(1)**H - !> as returned by CGELQF. + !! CUNGLQ generates an M-by-N complex matrix Q with orthonormal rows, + !! which is defined as the first M rows of a product of K elementary + !! reflectors of order N + !! Q = H(k)**H . . . H(2)**H H(1)**H + !! as returned by CGELQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29652,11 +29648,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cungql( m, n, k, a, lda, tau, work, lwork, info ) - !> CUNGQL generates an M-by-N complex matrix Q with orthonormal columns, - !> which is defined as the last N columns of a product of K elementary - !> reflectors of order M - !> Q = H(k) . . . H(2) H(1) - !> as returned by CGEQLF. + !! CUNGQL generates an M-by-N complex matrix Q with orthonormal columns, + !! which is defined as the last N columns of a product of K elementary + !! reflectors of order M + !! Q = H(k) . . . H(2) H(1) + !! as returned by CGEQLF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29773,11 +29769,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cungqr( m, n, k, a, lda, tau, work, lwork, info ) - !> CUNGQR generates an M-by-N complex matrix Q with orthonormal columns, - !> which is defined as the first N columns of a product of K elementary - !> reflectors of order M - !> Q = H(1) H(2) . . . H(k) - !> as returned by CGEQRF. + !! CUNGQR generates an M-by-N complex matrix Q with orthonormal columns, + !! which is defined as the first N columns of a product of K elementary + !! reflectors of order M + !! Q = H(1) H(2) . . . H(k) + !! as returned by CGEQRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29889,11 +29885,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cungr2( m, n, k, a, lda, tau, work, info ) - !> CUNGR2 generates an m by n complex matrix Q with orthonormal rows, - !> which is defined as the last m rows of a product of k elementary - !> reflectors of order n - !> Q = H(1)**H H(2)**H . . . H(k)**H - !> as returned by CGERQF. + !! CUNGR2 generates an m by n complex matrix Q with orthonormal rows, + !! which is defined as the last m rows of a product of k elementary + !! reflectors of order n + !! Q = H(1)**H H(2)**H . . . H(k)**H + !! as returned by CGERQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29957,11 +29953,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cungrq( m, n, k, a, lda, tau, work, lwork, info ) - !> CUNGRQ generates an M-by-N complex matrix Q with orthonormal rows, - !> which is defined as the last M rows of a product of K elementary - !> reflectors of order N - !> Q = H(1)**H H(2)**H . . . H(k)**H - !> as returned by CGERQF. + !! CUNGRQ generates an M-by-N complex matrix Q with orthonormal rows, + !! which is defined as the last M rows of a product of K elementary + !! reflectors of order N + !! Q = H(1)**H H(2)**H . . . H(k)**H + !! as returned by CGERQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30079,21 +30075,21 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cungtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) - !> CUNGTSQR_ROW generates an M-by-N complex matrix Q_out with - !> orthonormal columns from the output of CLATSQR. These N orthonormal - !> columns are the first N columns of a product of complex unitary - !> matrices Q(k)_in of order M, which are returned by CLATSQR in - !> a special format. - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> The input matrices Q(k)_in are stored in row and column blocks in A. - !> See the documentation of CLATSQR for more details on the format of - !> Q(k)_in, where each Q(k)_in is represented by block Householder - !> transformations. This routine calls an auxiliary routine CLARFB_GETT, - !> where the computation is performed on each individual block. The - !> algorithm first sweeps NB-sized column blocks from the right to left - !> starting in the bottom row block and continues to the top row block - !> (hence _ROW in the routine name). This sweep is in reverse order of - !> the order in which CLATSQR generates the output blocks. + !! CUNGTSQR_ROW generates an M-by-N complex matrix Q_out with + !! orthonormal columns from the output of CLATSQR. These N orthonormal + !! columns are the first N columns of a product of complex unitary + !! matrices Q(k)_in of order M, which are returned by CLATSQR in + !! a special format. + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! The input matrices Q(k)_in are stored in row and column blocks in A. + !! See the documentation of CLATSQR for more details on the format of + !! Q(k)_in, where each Q(k)_in is represented by block Householder + !! transformations. This routine calls an auxiliary routine CLARFB_GETT, + !! where the computation is performed on each individual block. The + !! algorithm first sweeps NB-sized column blocks from the right to left + !! starting in the bottom row block and continues to the top row block + !! (hence _ROW in the routine name). This sweep is in reverse order of + !! the order in which CLATSQR generates the output blocks. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30404,16 +30400,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> CUNM2L overwrites the general complex m-by-n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by CGEQLF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! CUNM2L overwrites the general complex m-by-n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by CGEQLF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30503,16 +30499,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> CUNM2R overwrites the general complex m-by-n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by CGEQRF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! CUNM2R overwrites the general complex m-by-n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by CGEQRF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30606,16 +30602,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> CUNML2 overwrites the general complex m-by-n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(k)**H . . . H(2)**H H(1)**H - !> as returned by CGELQF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! CUNML2 overwrites the general complex m-by-n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(k)**H . . . H(2)**H H(1)**H + !! as returned by CGELQF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30712,15 +30708,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunmlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> CUNMLQ 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(k)**H . . . H(2)**H H(1)**H - !> as returned by CGELQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! CUNMLQ 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(k)**H . . . H(2)**H H(1)**H + !! as returned by CGELQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30860,15 +30856,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunmql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> CUNMQL 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(k) . . . H(2) H(1) - !> as returned by CGEQLF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! CUNMQL 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(k) . . . H(2) H(1) + !! as returned by CGEQLF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30998,15 +30994,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunmqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> CUNMQR 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) - !> as returned by CGEQRF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! CUNMQR 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) + !! as returned by CGEQRF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31135,16 +31131,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunmr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> CUNMR2 overwrites the general complex m-by-n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(1)**H H(2)**H . . . H(k)**H - !> as returned by CGERQF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! CUNMR2 overwrites the general complex m-by-n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(1)**H H(2)**H . . . H(k)**H + !! as returned by CGERQF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31236,16 +31232,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunmr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) - !> CUNMR3 overwrites the general complex m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by CTZRZF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! CUNMR3 overwrites the general complex m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by CTZRZF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31341,15 +31337,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunmrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> CUNMRQ 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 H(2)**H . . . H(k)**H - !> as returned by CGERQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! CUNMRQ 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 H(2)**H . . . H(k)**H + !! as returned by CGERQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31484,15 +31480,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunmrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & - !> CUNMRZ 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) - !> as returned by CTZRZF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! CUNMRZ 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) + !! as returned by CTZRZF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31638,27 +31634,27 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cbbcsd( jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q,theta, phi, u1, & - !> CBBCSD 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. + !! CBBCSD 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. ldu1, u2, ldu2, v1t, ldv1t,v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e,b22d, b22e, rwork, & lrwork, info ) ! -- lapack computational routine -- @@ -32251,30 +32247,30 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, rwork,& - !> CBDSQR 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. + !! CBDSQR 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32714,12 +32710,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, rwork, & - !> CGBCON 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)) ). + !! CGBCON 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)) ). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32848,9 +32844,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) - !> CGBTRF 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. + !! CGBTRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33098,10 +33094,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) - !> CGBTRS 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. + !! CGBTRS 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33211,9 +33207,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgebd2( m, n, a, lda, d, e, tauq, taup, work, info ) - !> CGEBD2 reduces a complex general m by n matrix A to upper or lower - !> real 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. + !! CGEBD2 reduces a complex general m by n matrix A to upper or lower + !! real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33309,12 +33305,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgecon( norm, n, a, lda, anorm, rcond, work, rwork,info ) - !> CGECON 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)) ). + !! CGECON 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)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33415,8 +33411,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgehd2( n, ilo, ihi, a, lda, tau, work, info ) - !> CGEHD2 reduces a complex general matrix A to upper Hessenberg form H - !> by a unitary similarity transformation: Q**H * A * Q = H . + !! CGEHD2 reduces a complex general matrix A to upper Hessenberg form H + !! by a unitary similarity transformation: Q**H * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33467,12 +33463,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgelq2( m, n, a, lda, tau, work, info ) - !> CGELQ2 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. + !! CGELQ2 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33523,12 +33519,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgelqf( m, n, a, lda, tau, work, lwork, info ) - !> CGELQF 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. + !! CGELQF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33620,10 +33616,10 @@ module stdlib_linalg_lapack_c pure recursive subroutine stdlib_cgelqt3( m, n, a, lda, t, ldt, info ) - !> CGELQT3 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. + !! CGELQT3 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33710,15 +33706,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) - !> CGEMLQT 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'. + !! CGEMLQT 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33808,15 +33804,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) - !> CGEMQRT 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'. + !! CGEMQRT 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33906,8 +33902,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgeql2( m, n, a, lda, tau, work, info ) - !> CGEQL2 computes a QL factorization of a complex m by n matrix A: - !> A = Q * L. + !! CGEQL2 computes a QL factorization of a complex m by n matrix A: + !! A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33955,8 +33951,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgeqlf( m, n, a, lda, tau, work, lwork, info ) - !> CGEQLF computes a QL factorization of a complex M-by-N matrix A: - !> A = Q * L. + !! CGEQLF computes a QL factorization of a complex M-by-N matrix A: + !! A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34061,13 +34057,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgeqr2( m, n, a, lda, tau, work, info ) - !> CGEQR2 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. + !! CGEQR2 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34116,14 +34112,14 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgeqr2p( m, n, a, lda, tau, work, info ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34172,13 +34168,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgeqrf( m, n, a, lda, tau, work, lwork, info ) - !> CGEQRF 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. + !! CGEQRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34274,14 +34270,14 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgeqrfp( m, n, a, lda, tau, work, lwork, info ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34373,8 +34369,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgeqrt2( m, n, a, lda, t, ldt, info ) - !> CGEQRT2 computes a QR factorization of a complex M-by-N matrix A, - !> using the compact WY representation of Q. + !! CGEQRT2 computes a QR factorization of a complex M-by-N matrix A, + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34441,10 +34437,10 @@ module stdlib_linalg_lapack_c pure recursive subroutine stdlib_cgeqrt3( m, n, a, lda, t, ldt, info ) - !> CGEQRT3 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. + !! CGEQRT3 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34529,8 +34525,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgerq2( m, n, a, lda, tau, work, info ) - !> CGERQ2 computes an RQ factorization of a complex m by n matrix A: - !> A = R * Q. + !! CGERQ2 computes an RQ factorization of a complex m by n matrix A: + !! A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34580,8 +34576,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgerqf( m, n, a, lda, tau, work, lwork, info ) - !> CGERQF computes an RQ factorization of a complex M-by-N matrix A: - !> A = R * Q. + !! CGERQF computes an RQ factorization of a complex M-by-N matrix A: + !! A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34686,10 +34682,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) - !> CGESC2 solves a system of linear equations - !> A * X = scale* RHS - !> with a general N-by-N matrix A using the LU factorization with - !> complete pivoting computed by CGETC2. + !! CGESC2 solves a system of linear equations + !! A * X = scale* RHS + !! with a general N-by-N matrix A using the LU factorization with + !! complete pivoting computed by CGETC2. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34745,25 +34741,25 @@ module stdlib_linalg_lapack_c pure recursive subroutine stdlib_cgetrf2( m, n, a, lda, ipiv, info ) - !> CGETRF2 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. + !! CGETRF2 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34861,10 +34857,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgetri( n, a, lda, ipiv, work, lwork, info ) - !> CGETRI 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). + !! CGETRI 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). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34963,10 +34959,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) - !> CGETRS 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. + !! CGETRS 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35032,29 +35028,29 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & - !> CGGHRD 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 CGGHRD reduces the original - !> problem to generalized Hessenberg form. + !! CGGHRD 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 CGGHRD reduces the original + !! problem to generalized Hessenberg form. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35164,24 +35160,24 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) - !> CGGQRF 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. + !! CGGQRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35242,24 +35238,24 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) - !> CGGRQF 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. + !! CGGRQF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35320,10 +35316,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) - !> CGTTRS 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. + !! CGTTRS 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35386,8 +35382,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, lda, & - !> CHB2ST_KERNELS is an internal routine used by the CHETRD_HB2ST - !> subroutine. + !! CHB2ST_KERNELS is an internal routine used by the CHETRD_HB2ST + !! subroutine. v, tau, ldvt, work) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35531,13 +35527,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cheequb( uplo, n, a, lda, s, scond, amax, work, info ) - !> CHEEQUB 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. + !! CHEEQUB 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35713,13 +35709,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chegs2( itype, uplo, n, a, lda, b, ldb, info ) - !> CHEGS2 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 ZPOTRF. + !! CHEGS2 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 ZPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35846,13 +35842,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chegst( itype, uplo, n, a, lda, b, ldb, info ) - !> CHEGST 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. + !! CHEGST 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35985,9 +35981,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetd2( uplo, n, a, lda, d, e, tau, info ) - !> CHETD2 reduces a complex Hermitian matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. + !! CHETD2 reduces a complex Hermitian matrix A to real symmetric + !! tridiagonal form T by a unitary similarity transformation: + !! Q**H * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36089,9 +36085,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) - !> CHETRD reduces a complex Hermitian matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. + !! CHETRD reduces a complex Hermitian matrix A to real symmetric + !! tridiagonal form T by a unitary similarity transformation: + !! Q**H * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36217,9 +36213,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & - !> CHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. + !! CHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric + !! tridiagonal form T by a unitary similarity transformation: + !! Q**H * A * Q = T. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36490,9 +36486,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) - !> CHETRD_HE2HB reduces a complex Hermitian matrix A to complex Hermitian - !> band-diagonal form AB by a unitary similarity transformation: - !> Q**H * A * Q = AB. + !! CHETRD_HE2HB reduces a complex Hermitian matrix A to complex Hermitian + !! band-diagonal form AB by a unitary similarity transformation: + !! Q**H * A * Q = AB. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36666,14 +36662,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetrf( uplo, n, a, lda, ipiv, work, lwork, info ) - !> CHETRF 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. + !! CHETRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36792,15 +36788,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) - !> CHETRF_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. + !! CHETRF_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36958,14 +36954,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) - !> CHETRF_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. + !! CHETRF_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37086,9 +37082,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) - !> CHETRS 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. + !! CHETRS 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37317,9 +37313,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) - !> CHETRS2 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. + !! CHETRS2 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37498,9 +37494,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) - !> CHETRS_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. + !! CHETRS_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37627,9 +37623,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) - !> CHETRS_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. + !! CHETRS_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37866,9 +37862,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chptrd( uplo, n, ap, d, e, tau, info ) - !> CHPTRD 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. + !! CHPTRD 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37970,9 +37966,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> CHPTRS 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. + !! CHPTRS 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38211,8 +38207,8 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_cla_gbrcond_c( trans, n, kl, ku, ab, ldab, afb,ldafb, ipiv, c, & - !> CLA_GBRCOND_C Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a REAL vector. + !! CLA_GBRCOND_C Computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a REAL vector. capply, info, work,rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38359,8 +38355,8 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_cla_gercond_c( trans, n, a, lda, af, ldaf, ipiv, c,capply, info, & - !> CLA_GERCOND_C computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a REAL vector. + !! CLA_GERCOND_C computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a REAL vector. work, rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38500,8 +38496,8 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_cla_hercond_c( uplo, n, a, lda, af, ldaf, ipiv, c,capply, info, & - !> CLA_HERCOND_C computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a REAL vector. + !! CLA_HERCOND_C computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a REAL vector. work, rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38650,12 +38646,12 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_cla_herpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work ) - !> CLA_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. + !! CLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38839,8 +38835,8 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_cla_porcond_c( uplo, n, a, lda, af, ldaf, c, capply,info, work, & - !> CLA_PORCOND_C Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a REAL vector + !! CLA_PORCOND_C Computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a REAL vector rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38989,8 +38985,8 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_cla_syrcond_c( uplo, n, a, lda, af, ldaf, ipiv, c,capply, info, & - !> CLA_SYRCOND_C Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a REAL vector. + !! CLA_SYRCOND_C Computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a REAL vector. work, rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39140,12 +39136,12 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_cla_syrpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work ) - !> CLA_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. + !! CLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39329,13 +39325,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) - !> CLABRD 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 + !! CLABRD 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 ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39479,30 +39475,30 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claed7( n, cutpnt, qsiz, tlvls, curlvl, curpbm, d, q,ldq, rho, indxq, & - !> CLAED7 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. + !! CLAED7 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. qstore, qptr, prmptr, perm,givptr, givcol, givnum, work, rwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39606,9 +39602,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claein( rightv, noinit, n, h, ldh, w, v, b, ldb, rwork,eps3, smlnum, & - !> CLAEIN uses inverse iteration to find a right or left eigenvector - !> corresponding to the eigenvalue W of a complex upper Hessenberg - !> matrix H. + !! CLAEIN uses inverse iteration to find a right or left eigenvector + !! corresponding to the eigenvalue W of a complex upper Hessenberg + !! matrix H. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39750,30 +39746,30 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) - !> CLAGS2 computes 2-by-2 unitary matrices U, V and Q, such - !> that if ( UPPER ) then - !> U**H *A*Q = U**H *( A1 A2 )*Q = ( x 0 ) - !> ( 0 A3 ) ( x x ) - !> and - !> V**H*B*Q = V**H *( B1 B2 )*Q = ( x 0 ) - !> ( 0 B3 ) ( x x ) - !> or if ( .NOT.UPPER ) then - !> U**H *A*Q = U**H *( A1 0 )*Q = ( x x ) - !> ( A2 A3 ) ( 0 x ) - !> and - !> V**H *B*Q = V**H *( B1 0 )*Q = ( x x ) - !> ( B2 B3 ) ( 0 x ) - !> where - !> U = ( CSU SNU ), V = ( CSV SNV ), - !> ( -SNU**H CSU ) ( -SNV**H CSV ) - !> Q = ( CSQ SNQ ) - !> ( -SNQ**H CSQ ) - !> The rows of the transformed A and B are parallel. Moreover, if the - !> input 2-by-2 matrix A is not zero, then the transformed (1,1) entry - !> of A is not zero. If the input matrices A and B are both not zero, - !> then the transformed (2,2) element of B is not zero, except when the - !> first rows of input A and B are parallel and the second rows are - !> zero. + !! CLAGS2 computes 2-by-2 unitary matrices U, V and Q, such + !! that if ( UPPER ) then + !! U**H *A*Q = U**H *( A1 A2 )*Q = ( x 0 ) + !! ( 0 A3 ) ( x x ) + !! and + !! V**H*B*Q = V**H *( B1 B2 )*Q = ( x 0 ) + !! ( 0 B3 ) ( x x ) + !! or if ( .NOT.UPPER ) then + !! U**H *A*Q = U**H *( A1 0 )*Q = ( x x ) + !! ( A2 A3 ) ( 0 x ) + !! and + !! V**H *B*Q = V**H *( B1 0 )*Q = ( x x ) + !! ( B2 B3 ) ( 0 x ) + !! where + !! U = ( CSU SNU ), V = ( CSV SNV ), + !! ( -SNU**H CSU ) ( -SNV**H CSV ) + !! Q = ( CSQ SNQ ) + !! ( -SNQ**H CSQ ) + !! The rows of the transformed A and B are parallel. Moreover, if the + !! input 2-by-2 matrix A is not zero, then the transformed (1,1) entry + !! of A is not zero. If the input matrices A and B are both not zero, + !! then the transformed (2,2) element of B is not zero, except when the + !! first rows of input A and B are parallel and the second rows are + !! zero. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39937,10 +39933,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, info & - !> CLAHQR 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. + !! CLAHQR 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. ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40223,12 +40219,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) - !> CLAHR2 reduces the first NB columns of A complex general n-BY-(n-k+1) - !> matrix A so that elements below the k-th subdiagonal are zero. The - !> reduction is performed by an unitary similarity transformation - !> Q**H * A * Q. The routine returns the matrices V and T which determine - !> Q as a block reflector I - V*T*v**H, and also the matrix Y = A * V * T. - !> This is an auxiliary routine called by CGEHRD. + !! CLAHR2 reduces the first NB columns of A complex general n-BY-(n-k+1) + !! matrix A so that elements below the k-th subdiagonal are zero. The + !! reduction is performed by an unitary similarity transformation + !! Q**H * A * Q. The routine returns the matrices V and T which determine + !! Q as a block reflector I - V*T*v**H, and also the matrix Y = A * V * T. + !! This is an auxiliary routine called by CGEHRD. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -40313,26 +40309,26 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, & - !> CLALS0 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). + !! CLALS0 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). givcol, ldgcol, givnum, ldgnum,poles, difl, difr, z, k, c, s, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40558,15 +40554,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, difl,& - !> CLALSA 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, CLALSA applies the inverse of the left singular vector - !> matrix of an upper bidiagonal matrix to the right hand side; and if - !> ICOMPQ = 1, CLALSA applies the right singular vector matrix to the - !> right hand side. The singular vector matrices were generated in - !> compact form by CLALSA. + !! CLALSA 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, CLALSA applies the inverse of the left singular vector + !! matrix of an upper bidiagonal matrix to the right hand side; and if + !! ICOMPQ = 1, CLALSA applies the right singular vector matrix to the + !! right hand side. The singular vector matrices were generated in + !! compact form by CLALSA. difr, z, poles, givptr,givcol, ldgcol, perm, givnum, c, s, rwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40861,20 +40857,20 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, rwork, & - !> CLALSD 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. + !! CLALSD 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. iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41272,9 +41268,9 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_clangb( norm, n, kl, ku, ab, ldab,work ) - !> CLANGB 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. + !! CLANGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41347,9 +41343,9 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_clange( norm, m, n, a, lda, work ) - !> CLANGE 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. + !! CLANGE 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41419,9 +41415,9 @@ module stdlib_linalg_lapack_c pure real(sp) function stdlib_clangt( norm, n, dl, d, du ) - !> CLANGT 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. + !! CLANGT 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41495,9 +41491,9 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_clanhb( norm, uplo, n, k, ab, ldab,work ) - !> CLANHB 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. + !! CLANHB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41614,9 +41610,9 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_clanhe( norm, uplo, n, a, lda, work ) - !> CLANHE 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. + !! CLANHE 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41724,9 +41720,9 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_clanhf( norm, transr, uplo, n, a, work ) - !> CLANHF 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. + !! CLANHF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42944,9 +42940,9 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_clanhp( norm, uplo, n, ap, work ) - !> CLANHP 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. + !! CLANHP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43072,9 +43068,9 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_clanhs( norm, n, a, lda, work ) - !> CLANHS 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. + !! CLANHS 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43144,9 +43140,9 @@ module stdlib_linalg_lapack_c pure real(sp) function stdlib_clanht( norm, n, d, e ) - !> CLANHT 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. + !! CLANHT 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43207,9 +43203,9 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_clansb( norm, uplo, n, k, ab, ldab,work ) - !> CLANSB 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. + !! CLANSB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43312,9 +43308,9 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_clansp( norm, uplo, n, ap, work ) - !> CLANSP 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. + !! CLANSP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43445,9 +43441,9 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_clansy( norm, uplo, n, a, lda, work ) - !> CLANSY 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. + !! CLANSY 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43541,9 +43537,9 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_clantb( norm, uplo, diag, n, k, ab,ldab, work ) - !> CLANTB 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. + !! CLANTB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43734,9 +43730,9 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_clantp( norm, uplo, diag, n, ap, work ) - !> CLANTP 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. + !! CLANTP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43940,9 +43936,9 @@ module stdlib_linalg_lapack_c real(sp) function stdlib_clantr( norm, uplo, diag, m, n, a, lda,work ) - !> CLANTR 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. + !! CLANTR 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44126,12 +44122,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clapll( n, x, incx, y, incy, ssmin ) - !> 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. + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44170,9 +44166,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqp2( m, n, offset, a, lda, jpvt, tau, vn1, vn2,work ) - !> CLAQP2 computes a QR factorization with column pivoting of - !> the block A(OFFSET+1:M,1:N). - !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. + !! CLAQP2 computes a QR factorization with column pivoting of + !! the block A(OFFSET+1:M,1:N). + !! The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44250,14 +44246,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & - !> CLAQPS 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. + !! CLAQPS 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. ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -44393,8 +44389,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts, s,h, ldh, iloz, & - !> CLAQR5 called by CLAQR0 performs a - !> single small-bulge multi-shift QR sweep. + !! CLAQR5 called by CLAQR0 performs a + !! single small-bulge multi-shift QR sweep. ihiz, z, ldz, v, ldv, u, ldu, nv,wv, ldwv, nh, wh, ldwh ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -44791,7 +44787,7 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqz1( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, qstart, & - !> CLAQZ1 chases a 1x1 shift bulge in a matrix pencil down a single position + !! CLAQZ1 chases a 1x1 shift bulge in a matrix pencil down a single position q, ldq, nz, zstart, z, ldz ) ! arguments logical(lk), intent( in ) :: ilq, ilz @@ -44845,7 +44841,7 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqz3( ilschur, ilq, ilz, n, ilo, ihi, nshifts,nblock_desired, alpha,& - !> CLAQZ3 Executes a single multishift QZ sweep + !! CLAQZ3 Executes a single multishift QZ sweep beta, a, lda, b, ldb,q, ldq, z, ldz, qc, ldqc, zc, ldzc, work,lwork, info ) ! function arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -45085,16 +45081,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clargv( n, x, incx, y, incy, c, incc ) - !> CLARGV 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. + !! CLARGV 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45239,9 +45235,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, & - !> CLARRV 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. + !! CLARRV 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. rtol2, w, werr, wgap,iblock, indexw, gers, z, ldz, isuppz,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45889,14 +45885,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) - !> CLATDF 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. + !! CLATDF 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46003,39 +45999,39 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claunhr_col_getrfnp( m, n, a, lda, d, info ) - !> CLAUNHR_COL_GETRFNP computes the modified LU factorization without - !> pivoting of a complex 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 CUNHR_COL. In CUNHR_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 CLAUNHR_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. + !! CLAUNHR_COL_GETRFNP computes the modified LU factorization without + !! pivoting of a complex 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 CUNHR_COL. In CUNHR_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 CLAUNHR_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46097,12 +46093,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,rwork, info ) - !> CPBCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite band matrix using - !> the Cholesky factorization A = U**H*U or A = L*L**H computed by - !> CPBTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! CPBCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite band matrix using + !! the Cholesky factorization A = U**H*U or A = L*L**H computed by + !! CPBTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46201,10 +46197,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & - !> CPBRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite - !> and banded, and provides error bounds and backward error estimates - !> for the solution. + !! CPBRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite + !! and banded, and provides error bounds and backward error estimates + !! for the solution. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46399,12 +46395,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpbtrf( uplo, n, kd, ab, ldab, info ) - !> CPBTRF computes the Cholesky factorization of a complex Hermitian - !> positive definite band matrix A. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. + !! CPBTRF computes the Cholesky factorization of a complex Hermitian + !! positive definite band matrix A. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46599,9 +46595,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpftrs( transr, uplo, n, nrhs, a, b, ldb, info ) - !> CPFTRS solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A using the Cholesky factorization - !> A = U**H*U or A = L*L**H computed by CPFTRF. + !! CPFTRS solves a system of linear equations A*X = B with a Hermitian + !! positive definite matrix A using the Cholesky factorization + !! A = U**H*U or A = L*L**H computed by CPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46653,11 +46649,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpocon( uplo, n, a, lda, anorm, rcond, work, rwork,info ) - !> CPOCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite matrix using the - !> Cholesky factorization A = U**H*U or A = L*L**H computed by CPOTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! CPOCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite matrix using the + !! Cholesky factorization A = U**H*U or A = L*L**H computed by CPOTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46753,10 +46749,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & - !> CPORFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite, - !> and provides error bounds and backward error estimates for the - !> solution. + !! CPORFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite, + !! and provides error bounds and backward error estimates for the + !! solution. work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46946,13 +46942,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpotrf( uplo, n, a, lda, info ) - !> CPOTRF computes the Cholesky factorization of a complex Hermitian - !> positive definite matrix A. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the block version of the algorithm, calling Level 3 BLAS. + !! CPOTRF computes the Cholesky factorization of a complex Hermitian + !! positive definite matrix A. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the block version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47041,9 +47037,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpotri( uplo, n, a, lda, info ) - !> CPOTRI computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by CPOTRF. + !! CPOTRI computes the inverse of a complex Hermitian positive definite + !! matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !! computed by CPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47082,12 +47078,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cppcon( uplo, n, ap, anorm, rcond, work, rwork, info ) - !> CPPCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite packed matrix using - !> the Cholesky factorization A = U**H*U or A = L*L**H computed by - !> CPPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! CPPCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite packed matrix using + !! the Cholesky factorization A = U**H*U or A = L*L**H computed by + !! CPPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47181,10 +47177,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & - !> CPPRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite - !> and packed, and provides error bounds and backward error estimates - !> for the solution. + !! CPPRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite + !! and packed, and provides error bounds and backward error estimates + !! for the solution. rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47377,16 +47373,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cppsv( uplo, n, nrhs, ap, b, ldb, info ) - !> CPPSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix stored in - !> packed format and X and B are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is a lower triangular - !> matrix. The factored form of A is then used to solve the system of - !> equations A * X = B. + !! CPPSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix stored in + !! packed format and X and B are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is a lower triangular + !! matrix. The factored form of A is then used to solve the system of + !! equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47426,13 +47422,13 @@ module stdlib_linalg_lapack_c subroutine stdlib_cppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& - !> CPPSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to - !> compute the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix stored in - !> packed format and X and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! CPPSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to + !! compute the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix stored in + !! packed format and X and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47566,9 +47562,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpptri( uplo, n, ap, info ) - !> CPPTRI computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by CPPTRF. + !! CPPTRI computes the inverse of a complex Hermitian positive definite + !! matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !! computed by CPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47630,21 +47626,21 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpteqr( compz, n, d, e, z, ldz, work, info ) - !> CPTEQR computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric positive definite tridiagonal matrix by first factoring the - !> matrix using SPTTRF and then calling CBDSQR to compute the singular - !> values of the bidiagonal factor. - !> This routine computes the eigenvalues of the positive definite - !> tridiagonal matrix to high relative accuracy. This means that if the - !> eigenvalues range over many orders of magnitude in size, then the - !> small eigenvalues and corresponding eigenvectors will be computed - !> more accurately than, for example, with the standard QR method. - !> The eigenvectors of a full or band positive definite Hermitian matrix - !> can also be found if CHETRD, CHPTRD, or CHBTRD has been used to - !> reduce this matrix to tridiagonal form. (The reduction to - !> tridiagonal form, however, may preclude the possibility of obtaining - !> high relative accuracy in the small eigenvalues of the original - !> matrix, if these eigenvalues range over many orders of magnitude.) + !! CPTEQR computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric positive definite tridiagonal matrix by first factoring the + !! matrix using SPTTRF and then calling CBDSQR to compute the singular + !! values of the bidiagonal factor. + !! This routine computes the eigenvalues of the positive definite + !! tridiagonal matrix to high relative accuracy. This means that if the + !! eigenvalues range over many orders of magnitude in size, then the + !! small eigenvalues and corresponding eigenvectors will be computed + !! more accurately than, for example, with the standard QR method. + !! The eigenvectors of a full or band positive definite Hermitian matrix + !! can also be found if CHETRD, CHPTRD, or CHBTRD has been used to + !! reduce this matrix to tridiagonal form. (The reduction to + !! tridiagonal form, however, may preclude the possibility of obtaining + !! high relative accuracy in the small eigenvalues of the original + !! matrix, if these eigenvalues range over many orders of magnitude.) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47725,12 +47721,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpttrs( uplo, n, nrhs, d, e, b, ldb, info ) - !> CPTTRS solves a tridiagonal system of the form - !> A * X = B - !> using the factorization A = U**H*D*U or A = L*D*L**H computed by CPTTRF. - !> D is a diagonal matrix specified in the vector D, U (or L) is a unit - !> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in - !> the vector E, and X and B are N by NRHS matrices. + !! CPTTRS solves a tridiagonal system of the form + !! A * X = B + !! using the factorization A = U**H*D*U or A = L*D*L**H computed by CPTTRF. + !! D is a diagonal matrix specified in the vector D, U (or L) is a unit + !! bidiagonal matrix whose superdiagonal (subdiagonal) is specified in + !! the vector E, and X and B are N by NRHS matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47792,11 +47788,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cspcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) - !> CSPCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex symmetric packed matrix A using the - !> factorization A = U*D*U**T or A = L*D*L**T computed by CSPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! CSPCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex symmetric packed matrix A using the + !! factorization A = U*D*U**T or A = L*D*L**T computed by CSPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47873,10 +47869,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& - !> CSPRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite - !> and packed, and provides error bounds and backward error estimates - !> for the solution. + !! CSPRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric indefinite + !! and packed, and provides error bounds and backward error estimates + !! for the solution. rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48070,17 +48066,17 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> CSPSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric 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**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, D is symmetric 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. + !! CSPSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric 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**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, D is symmetric 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48121,12 +48117,12 @@ module stdlib_linalg_lapack_c subroutine stdlib_cspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & - !> CSPSVX uses the diagonal pivoting factorization A = U*D*U**T or - !> A = L*D*L**T to compute the solution to a complex system of linear - !> equations A * X = B, where A is an N-by-N symmetric matrix stored - !> in packed format and X and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! CSPSVX uses the diagonal pivoting factorization A = U*D*U**T or + !! A = L*D*L**T to compute the solution to a complex system of linear + !! equations A * X = B, where A is an N-by-N symmetric matrix stored + !! in packed format and X and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48199,65 +48195,65 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & - !> CSTEMR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has - !> a well defined set of pairwise different real eigenvalues, the corresponding - !> real eigenvectors are pairwise orthogonal. - !> The spectrum may be computed either completely or partially by specifying - !> either an interval (VL,VU] or a range of indices IL:IU for the desired - !> eigenvalues. - !> Depending on the number of desired eigenvalues, these are computed either - !> by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are - !> computed by the use of various suitable L D L^T factorizations near clusters - !> of close eigenvalues (referred to as RRRs, Relatively Robust - !> Representations). An informal sketch of the algorithm 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. - !> For more details, see: - !> - 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. - !> Further Details - !> 1.CSTEMR works only on machines which follow IEEE-754 - !> floating-point standard in their handling of infinities and NaNs. - !> This permits the use of efficient inner loops avoiding a check for - !> zero divisors. - !> 2. LAPACK routines can be used to reduce a complex Hermitean matrix to - !> real symmetric tridiagonal form. - !> (Any complex Hermitean tridiagonal matrix has real values on its diagonal - !> and potentially complex numbers on its off-diagonals. By applying a - !> similarity transform with an appropriate diagonal matrix - !> diag(1,e^{i \phy_1}, ... , e^{i \phy_{n-1}}), the complex Hermitean - !> matrix can be transformed into a real symmetric matrix and complex - !> arithmetic can be entirely avoided.) - !> While the eigenvectors of the real symmetric tridiagonal matrix are real, - !> the eigenvectors of original complex Hermitean matrix have complex entries - !> in general. - !> Since LAPACK drivers overwrite the matrix data with the eigenvectors, - !> CSTEMR accepts complex workspace to facilitate interoperability - !> with CUNMTR or CUPMTR. + !! CSTEMR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Any such unreduced matrix has + !! a well defined set of pairwise different real eigenvalues, the corresponding + !! real eigenvectors are pairwise orthogonal. + !! The spectrum may be computed either completely or partially by specifying + !! either an interval (VL,VU] or a range of indices IL:IU for the desired + !! eigenvalues. + !! Depending on the number of desired eigenvalues, these are computed either + !! by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are + !! computed by the use of various suitable L D L^T factorizations near clusters + !! of close eigenvalues (referred to as RRRs, Relatively Robust + !! Representations). An informal sketch of the algorithm 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. + !! For more details, see: + !! - 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. + !! Further Details + !! 1.CSTEMR works only on machines which follow IEEE-754 + !! floating-point standard in their handling of infinities and NaNs. + !! This permits the use of efficient inner loops avoiding a check for + !! zero divisors. + !! 2. LAPACK routines can be used to reduce a complex Hermitean matrix to + !! real symmetric tridiagonal form. + !! (Any complex Hermitean tridiagonal matrix has real values on its diagonal + !! and potentially complex numbers on its off-diagonals. By applying a + !! similarity transform with an appropriate diagonal matrix + !! diag(1,e^{i \phy_1}, ... , e^{i \phy_{n-1}}), the complex Hermitean + !! matrix can be transformed into a real symmetric matrix and complex + !! arithmetic can be entirely avoided.) + !! While the eigenvectors of the real symmetric tridiagonal matrix are real, + !! the eigenvectors of original complex Hermitean matrix have complex entries + !! in general. + !! Since LAPACK drivers overwrite the matrix data with the eigenvectors, + !! CSTEMR accepts complex workspace to facilitate interoperability + !! with CUNMTR or CUPMTR. isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48633,11 +48629,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csycon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) - !> CSYCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex symmetric matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by CSYTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! CSYCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex symmetric matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by CSYTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48714,11 +48710,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) - !> CSYCON_ROOK estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex symmetric matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by CSYTRF_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))). + !! CSYCON_ROOK estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex symmetric matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by CSYTRF_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))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48796,9 +48792,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & - !> CSYRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite, and - !> provides error bounds and backward error estimates for the solution. + !! CSYRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric indefinite, and + !! provides error bounds and backward error estimates for the solution. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48989,17 +48985,17 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> CSYSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> The 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 symmetric 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. + !! CSYSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! The 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 symmetric 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49067,20 +49063,20 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) - !> CSYSV_RK computes the solution to a complex system of linear - !> equations A * X = B, where A is an N-by-N symmetric 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**T)*(P**T), if UPLO = 'U', or - !> A = P*L*D*(L**T)*(P**T), if UPLO = 'L', - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric and block - !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. - !> CSYTRF_RK is called to compute the factorization of a complex - !> symmetric matrix. The factored form of A is then used to solve - !> the system of equations A * X = B by calling BLAS3 routine CSYTRS_3. + !! CSYSV_RK computes the solution to a complex system of linear + !! equations A * X = B, where A is an N-by-N symmetric 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**T)*(P**T), if UPLO = 'U', or + !! A = P*L*D*(L**T)*(P**T), if UPLO = 'L', + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric and block + !! diagonal with 1-by-1 and 2-by-2 diagonal blocks. + !! CSYTRF_RK is called to compute the factorization of a complex + !! symmetric matrix. The factored form of A is then used to solve + !! the system of equations A * X = B by calling BLAS3 routine CSYTRS_3. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49143,22 +49139,22 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> CSYSV_ROOK computes the solution to a complex system of linear - !> equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> The 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 symmetric and block diagonal with - !> 1-by-1 and 2-by-2 diagonal blocks. - !> CSYTRF_ROOK is called to compute the factorization of a complex - !> symmetric 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 CSYTRS_ROOK. + !! CSYSV_ROOK computes the solution to a complex system of linear + !! equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! The 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 symmetric and block diagonal with + !! 1-by-1 and 2-by-2 diagonal blocks. + !! CSYTRF_ROOK is called to compute the factorization of a complex + !! symmetric 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 CSYTRS_ROOK. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49222,12 +49218,12 @@ module stdlib_linalg_lapack_c subroutine stdlib_csysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & - !> CSYSVX uses the diagonal pivoting factorization to compute the - !> solution to a complex system of linear equations A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! CSYSVX uses the diagonal pivoting factorization to compute the + !! solution to a complex system of linear equations A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ferr, berr, work, lwork,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49319,12 +49315,12 @@ module stdlib_linalg_lapack_c subroutine stdlib_ctbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,rwork, info ) - !> CTBCON estimates the reciprocal of the condition number of a - !> triangular band matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! CTBCON estimates the reciprocal of the condition number of a + !! triangular band matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49428,9 +49424,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctftri( transr, uplo, diag, n, a, info ) - !> CTFTRI computes the inverse of a triangular matrix A stored in RFP - !> format. - !> This is a Level 3 BLAS version of the algorithm. + !! CTFTRI computes the inverse of a triangular matrix A stored in RFP + !! format. + !! This is a Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49611,68 +49607,68 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & - !> CTGSJA computes the generalized singular value decomposition (GSVD) - !> of two complex upper triangular (or trapezoidal) matrices A and B. - !> On entry, it is assumed that matrices A and B have the following - !> forms, which may be obtained by the preprocessing subroutine CGGSVP - !> from a general M-by-N matrix A and P-by-N matrix B: - !> N-K-L K L - !> A = K ( 0 A12 A13 ) if M-K-L >= 0; - !> L ( 0 0 A23 ) - !> M-K-L ( 0 0 0 ) - !> N-K-L K L - !> A = K ( 0 A12 A13 ) if M-K-L < 0; - !> M-K ( 0 0 A23 ) - !> N-K-L K L - !> B = L ( 0 0 B13 ) - !> P-L ( 0 0 0 ) - !> where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular - !> upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, - !> otherwise A23 is (M-K)-by-L upper trapezoidal. - !> On exit, - !> U**H *A*Q = D1*( 0 R ), V**H *B*Q = D2*( 0 R ), - !> where U, V and Q are unitary matrices. - !> R is a nonsingular upper triangular matrix, and D1 - !> and D2 are ``diagonal'' matrices, which are of the following - !> structures: - !> If M-K-L >= 0, - !> K L - !> D1 = K ( I 0 ) - !> L ( 0 C ) - !> M-K-L ( 0 0 ) - !> K L - !> D2 = L ( 0 S ) - !> P-L ( 0 0 ) - !> N-K-L K L - !> ( 0 R ) = K ( 0 R11 R12 ) K - !> L ( 0 0 R22 ) L - !> where - !> C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), - !> S = diag( BETA(K+1), ... , BETA(K+L) ), - !> C**2 + S**2 = I. - !> R is stored in A(1:K+L,N-K-L+1:N) on exit. - !> If M-K-L < 0, - !> K M-K K+L-M - !> D1 = K ( I 0 0 ) - !> M-K ( 0 C 0 ) - !> K M-K K+L-M - !> D2 = M-K ( 0 S 0 ) - !> K+L-M ( 0 0 I ) - !> P-L ( 0 0 0 ) - !> N-K-L K M-K K+L-M - !> ( 0 R ) = K ( 0 R11 R12 R13 ) - !> M-K ( 0 0 R22 R23 ) - !> K+L-M ( 0 0 0 R33 ) - !> where - !> C = diag( ALPHA(K+1), ... , ALPHA(M) ), - !> S = diag( BETA(K+1), ... , BETA(M) ), - !> C**2 + S**2 = I. - !> R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored - !> ( 0 R22 R23 ) - !> in B(M-K+1:L,N+M-K-L+1:N) on exit. - !> The computation of the unitary transformation matrices U, V or Q - !> is optional. These matrices may either be formed explicitly, or they - !> may be postmultiplied into input matrices U1, V1, or Q1. + !! CTGSJA computes the generalized singular value decomposition (GSVD) + !! of two complex upper triangular (or trapezoidal) matrices A and B. + !! On entry, it is assumed that matrices A and B have the following + !! forms, which may be obtained by the preprocessing subroutine CGGSVP + !! from a general M-by-N matrix A and P-by-N matrix B: + !! N-K-L K L + !! A = K ( 0 A12 A13 ) if M-K-L >= 0; + !! L ( 0 0 A23 ) + !! M-K-L ( 0 0 0 ) + !! N-K-L K L + !! A = K ( 0 A12 A13 ) if M-K-L < 0; + !! M-K ( 0 0 A23 ) + !! N-K-L K L + !! B = L ( 0 0 B13 ) + !! P-L ( 0 0 0 ) + !! where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular + !! upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, + !! otherwise A23 is (M-K)-by-L upper trapezoidal. + !! On exit, + !! U**H *A*Q = D1*( 0 R ), V**H *B*Q = D2*( 0 R ), + !! where U, V and Q are unitary matrices. + !! R is a nonsingular upper triangular matrix, and D1 + !! and D2 are ``diagonal'' matrices, which are of the following + !! structures: + !! If M-K-L >= 0, + !! K L + !! D1 = K ( I 0 ) + !! L ( 0 C ) + !! M-K-L ( 0 0 ) + !! K L + !! D2 = L ( 0 S ) + !! P-L ( 0 0 ) + !! N-K-L K L + !! ( 0 R ) = K ( 0 R11 R12 ) K + !! L ( 0 0 R22 ) L + !! where + !! C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), + !! S = diag( BETA(K+1), ... , BETA(K+L) ), + !! C**2 + S**2 = I. + !! R is stored in A(1:K+L,N-K-L+1:N) on exit. + !! If M-K-L < 0, + !! K M-K K+L-M + !! D1 = K ( I 0 0 ) + !! M-K ( 0 C 0 ) + !! K M-K K+L-M + !! D2 = M-K ( 0 S 0 ) + !! K+L-M ( 0 0 I ) + !! P-L ( 0 0 0 ) + !! N-K-L K M-K K+L-M + !! ( 0 R ) = K ( 0 R11 R12 R13 ) + !! M-K ( 0 0 R22 R23 ) + !! K+L-M ( 0 0 0 R33 ) + !! where + !! C = diag( ALPHA(K+1), ... , ALPHA(M) ), + !! S = diag( BETA(K+1), ... , BETA(M) ), + !! C**2 + S**2 = I. + !! R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored + !! ( 0 R22 R23 ) + !! in B(M-K+1:L,N+M-K-L+1:N) on exit. + !! The computation of the unitary transformation matrices U, V or Q + !! is optional. These matrices may either be formed explicitly, or they + !! may be postmultiplied into input matrices U1, V1, or Q1. alpha, beta, u, ldu, v, ldv,q, ldq, work, ncycle, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49860,31 +49856,31 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & - !> CTGSY2 solves the generalized Sylvester equation - !> A * R - L * B = scale * C (1) - !> D * R - L * E = scale * F - !> using Level 1 and 2 BLAS, where R and L are unknown M-by-N matrices, - !> (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M, - !> N-by-N and M-by-N, respectively. A, B, D and E are upper triangular - !> (i.e., (A,D) and (B,E) in generalized Schur form). - !> The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output - !> scaling factor chosen to avoid overflow. - !> In matrix notation solving equation (1) corresponds to solve - !> Zx = scale * b, where Z is defined as - !> Z = [ kron(In, A) -kron(B**H, Im) ] (2) - !> [ kron(In, D) -kron(E**H, Im) ], - !> Ik is the identity matrix of size k and X**H is the transpose of X. - !> kron(X, Y) is the Kronecker product between the matrices X and Y. - !> If TRANS = 'C', y in the conjugate transposed system Z**H*y = scale*b - !> is solved for, which is equivalent to solve for R and L in - !> A**H * R + D**H * L = scale * C (3) - !> R * B**H + L * E**H = scale * -F - !> This case is used to compute an estimate of Dif[(A, D), (B, E)] = - !> = sigma_min(Z) using reverse communication with CLACON. - !> CTGSY2 also (IJOB >= 1) contributes to the computation in CTGSYL - !> of an upper bound on the separation between to matrix pairs. Then - !> the input (A, D), (B, E) are sub-pencils of two matrix pairs in - !> CTGSYL. + !! CTGSY2 solves the generalized Sylvester equation + !! A * R - L * B = scale * C (1) + !! D * R - L * E = scale * F + !! using Level 1 and 2 BLAS, where R and L are unknown M-by-N matrices, + !! (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M, + !! N-by-N and M-by-N, respectively. A, B, D and E are upper triangular + !! (i.e., (A,D) and (B,E) in generalized Schur form). + !! The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output + !! scaling factor chosen to avoid overflow. + !! In matrix notation solving equation (1) corresponds to solve + !! Zx = scale * b, where Z is defined as + !! Z = [ kron(In, A) -kron(B**H, Im) ] (2) + !! [ kron(In, D) -kron(E**H, Im) ], + !! Ik is the identity matrix of size k and X**H is the transpose of X. + !! kron(X, Y) is the Kronecker product between the matrices X and Y. + !! If TRANS = 'C', y in the conjugate transposed system Z**H*y = scale*b + !! is solved for, which is equivalent to solve for R and L in + !! A**H * R + D**H * L = scale * C (3) + !! R * B**H + L * E**H = scale * -F + !! This case is used to compute an estimate of Dif[(A, D), (B, E)] = + !! = sigma_min(Z) using reverse communication with CLACON. + !! CTGSY2 also (IJOB >= 1) contributes to the computation in CTGSYL + !! of an upper bound on the separation between to matrix pairs. Then + !! the input (A, D), (B, E) are sub-pencils of two matrix pairs in + !! CTGSYL. ldf, scale, rdsum, rdscal,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50050,33 +50046,33 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & - !> CTGSYL solves the generalized Sylvester equation: - !> A * R - L * B = scale * C (1) - !> D * R - L * E = scale * F - !> where R and L are unknown m-by-n matrices, (A, D), (B, E) and - !> (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n, - !> respectively, with complex entries. A, B, D and E are upper - !> triangular (i.e., (A,D) and (B,E) in generalized Schur form). - !> The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 - !> is an output scaling factor chosen to avoid overflow. - !> In matrix notation (1) is equivalent to solve Zx = scale*b, where Z - !> is defined as - !> Z = [ kron(In, A) -kron(B**H, Im) ] (2) - !> [ kron(In, D) -kron(E**H, Im) ], - !> Here Ix is the identity matrix of size x and X**H is the conjugate - !> transpose of X. Kron(X, Y) is the Kronecker product between the - !> matrices X and Y. - !> If TRANS = 'C', y in the conjugate transposed system Z**H *y = scale*b - !> is solved for, which is equivalent to solve for R and L in - !> A**H * R + D**H * L = scale * C (3) - !> R * B**H + L * E**H = scale * -F - !> This case (TRANS = 'C') is used to compute an one-norm-based estimate - !> of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D) - !> and (B,E), using CLACON. - !> If IJOB >= 1, CTGSYL computes a Frobenius norm-based estimate of - !> Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the - !> reciprocal of the smallest singular value of Z. - !> This is a level-3 BLAS algorithm. + !! CTGSYL solves the generalized Sylvester equation: + !! A * R - L * B = scale * C (1) + !! D * R - L * E = scale * F + !! where R and L are unknown m-by-n matrices, (A, D), (B, E) and + !! (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n, + !! respectively, with complex entries. A, B, D and E are upper + !! triangular (i.e., (A,D) and (B,E) in generalized Schur form). + !! The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 + !! is an output scaling factor chosen to avoid overflow. + !! In matrix notation (1) is equivalent to solve Zx = scale*b, where Z + !! is defined as + !! Z = [ kron(In, A) -kron(B**H, Im) ] (2) + !! [ kron(In, D) -kron(E**H, Im) ], + !! Here Ix is the identity matrix of size x and X**H is the conjugate + !! transpose of X. Kron(X, Y) is the Kronecker product between the + !! matrices X and Y. + !! If TRANS = 'C', y in the conjugate transposed system Z**H *y = scale*b + !! is solved for, which is equivalent to solve for R and L in + !! A**H * R + D**H * L = scale * C (3) + !! R * B**H + L * E**H = scale * -F + !! This case (TRANS = 'C') is used to compute an one-norm-based estimate + !! of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D) + !! and (B,E), using CLACON. + !! If IJOB >= 1, CTGSYL computes a Frobenius norm-based estimate of + !! Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the + !! reciprocal of the smallest singular value of Z. + !! This is a level-3 BLAS algorithm. ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50400,12 +50396,12 @@ module stdlib_linalg_lapack_c subroutine stdlib_ctpcon( norm, uplo, diag, n, ap, rcond, work, rwork,info ) - !> CTPCON estimates the reciprocal of the condition number of a packed - !> triangular matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! CTPCON estimates the reciprocal of the condition number of a packed + !! triangular matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50504,10 +50500,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) - !> CTPLQT computes a blocked LQ factorization of a complex - !> "triangular-pentagonal" matrix C, which is composed of a - !> triangular block A and pentagonal block B, using the compact - !> WY representation for Q. + !! CTPLQT computes a blocked LQ factorization of a complex + !! "triangular-pentagonal" matrix C, which is composed of a + !! triangular block A and pentagonal block B, using the compact + !! WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50566,9 +50562,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, ldb, & - !> CTPMLQT applies a complex unitary matrix Q obtained from a - !> "triangular-pentagonal" complex block reflector H to a general - !> complex matrix C, which consists of two blocks A and B. + !! CTPMLQT applies a complex unitary matrix Q obtained from a + !! "triangular-pentagonal" complex block reflector H to a general + !! complex matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50684,9 +50680,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, ldb, & - !> CTPMQRT applies a complex orthogonal matrix Q obtained from a - !> "triangular-pentagonal" complex block reflector H to a general - !> complex matrix C, which consists of two blocks A and B. + !! CTPMQRT applies a complex orthogonal matrix Q obtained from a + !! "triangular-pentagonal" complex block reflector H to a general + !! complex matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50804,10 +50800,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) - !> CTPQRT computes a blocked QR factorization of a complex - !> "triangular-pentagonal" matrix C, which is composed of a - !> triangular block A and pentagonal block B, using the compact - !> WY representation for Q. + !! CTPQRT computes a blocked QR factorization of a complex + !! "triangular-pentagonal" matrix C, which is composed of a + !! triangular block A and pentagonal block B, using the compact + !! WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50866,12 +50862,12 @@ module stdlib_linalg_lapack_c subroutine stdlib_ctrcon( norm, uplo, diag, n, a, lda, rcond, work,rwork, info ) - !> CTRCON estimates the reciprocal of the condition number of a - !> triangular matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! CTRCON estimates the reciprocal of the condition number of a + !! triangular matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50972,13 +50968,13 @@ module stdlib_linalg_lapack_c subroutine stdlib_ctrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) - !> CTRSYL solves the complex Sylvester matrix equation: - !> op(A)*X + X*op(B) = scale*C or - !> op(A)*X - X*op(B) = scale*C, - !> where op(A) = A or A**H, and A and B are both upper triangular. A is - !> M-by-M and B is N-by-N; the right hand side C and the solution X are - !> M-by-N; and scale is an output scale factor, set <= 1 to avoid - !> overflow in X. + !! CTRSYL solves the complex Sylvester matrix equation: + !! op(A)*X + X*op(B) = scale*C or + !! op(A)*X - X*op(B) = scale*C, + !! where op(A) = A or A**H, and A and B are both upper triangular. A is + !! M-by-M and B is N-by-N; the right hand side C and the solution X are + !! M-by-N; and scale is an output scale factor, set <= 1 to avoid + !! overflow in X. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51198,17 +51194,17 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & - !> CUNBDB5 orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then some other vector from the orthogonal complement - !> is returned. This vector is chosen in an arbitrary but deterministic - !> way. + !! CUNBDB5 orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then some other vector from the orthogonal complement + !! is returned. This vector is chosen in an arbitrary but deterministic + !! way. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51297,19 +51293,19 @@ module stdlib_linalg_lapack_c recursive subroutine stdlib_cuncsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & - !> CUNCSD computes the CS decomposition of an M-by-M partitioned - !> unitary matrix X: - !> [ I 0 0 | 0 0 0 ] - !> [ 0 C 0 | 0 -S 0 ] - !> [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**H - !> X = [-----------] = [---------] [---------------------] [---------] . - !> [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] - !> [ 0 S 0 | 0 C 0 ] - !> [ 0 0 I | 0 0 0 ] - !> X11 is P-by-Q. The unitary matrices U1, U2, V1, and V2 are P-by-P, - !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are - !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in - !> which R = MIN(P,M-P,Q,M-Q). + !! CUNCSD computes the CS decomposition of an M-by-M partitioned + !! unitary matrix X: + !! [ I 0 0 | 0 0 0 ] + !! [ 0 C 0 | 0 -S 0 ] + !! [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**H + !! X = [-----------] = [---------] [---------------------] [---------] . + !! [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] + !! [ 0 S 0 | 0 C 0 ] + !! [ 0 0 I | 0 0 0 ] + !! X11 is P-by-Q. The unitary matrices U1, U2, V1, and V2 are P-by-P, + !! (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are + !! R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in + !! which R = MIN(P,M-P,Q,M-Q). ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, ldv1t, v2t,ldv2t, & work, lwork, rwork, lrwork,iwork, info ) ! -- lapack computational routine -- @@ -51587,10 +51583,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) - !> CUNGHR generates a complex unitary matrix Q which is defined as the - !> product of IHI-ILO elementary reflectors of order N, as returned by - !> CGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! CUNGHR generates a complex unitary matrix Q which is defined as the + !! product of IHI-ILO elementary reflectors of order N, as returned by + !! CGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51677,11 +51673,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cungtr( uplo, n, a, lda, tau, work, lwork, info ) - !> CUNGTR generates a complex unitary matrix Q which is defined as the - !> product of n-1 elementary reflectors of order N, as returned by - !> CHETRD: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! CUNGTR generates a complex unitary matrix Q which is defined as the + !! product of n-1 elementary reflectors of order N, as returned by + !! CHETRD: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51778,15 +51774,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunhr_col( m, n, nb, a, lda, t, ldt, d, info ) - !> CUNHR_COL takes an M-by-N complex matrix Q_in with orthonormal columns - !> as input, stored in A, and performs Householder Reconstruction (HR), - !> i.e. reconstructs Householder vectors V(i) implicitly representing - !> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, - !> where S is an N-by-N diagonal matrix with diagonal entries - !> equal to +1 or -1. The Householder vectors (columns V(i) of V) are - !> stored in A on output, and the diagonal entries of S are stored in D. - !> Block reflectors are also returned in T - !> (same output format as CGEQRT). + !! CUNHR_COL takes an M-by-N complex matrix Q_in with orthonormal columns + !! as input, stored in A, and performs Householder Reconstruction (HR), + !! i.e. reconstructs Householder vectors V(i) implicitly representing + !! another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, + !! where S is an N-by-N diagonal matrix with diagonal entries + !! equal to +1 or -1. The Householder vectors (columns V(i) of V) are + !! stored in A on output, and the diagonal entries of S are stored in D. + !! Block reflectors are also returned in T + !! (same output format as CGEQRT). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51915,14 +51911,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunmhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & - !> CUNMHR 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 of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> IHI-ILO elementary reflectors, as returned by CGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! CUNMHR 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 of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! IHI-ILO elementary reflectors, as returned by CGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52014,15 +52010,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunmtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & - !> CUNMTR 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 of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by CHETRD: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! CUNMTR 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 of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by CHETRD: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52130,11 +52126,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cupgtr( uplo, n, ap, tau, q, ldq, work, info ) - !> CUPGTR generates a complex unitary matrix Q which is defined as the - !> product of n-1 elementary reflectors H(i) of order n, as returned by - !> CHPTRD using packed storage: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! CUPGTR generates a complex unitary matrix Q which is defined as the + !! product of n-1 elementary reflectors H(i) of order n, as returned by + !! CHPTRD using packed storage: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52217,16 +52213,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cupmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) - !> CUPMTR 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 of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by CHPTRD using packed - !> storage: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! CUPMTR 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 of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by CHPTRD using packed + !! storage: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52374,10 +52370,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & - !> CGBBRD 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. + !! CGBBRD 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. ldc, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52651,9 +52647,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, x, & - !> CGBRFS 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. + !! CGBRFS 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. ldx, ferr, berr, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52857,14 +52853,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) - !> CGBSV 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. + !! CGBSV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52909,12 +52905,12 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & - !> CGBSVX uses the LU factorization to compute the solution to a complex - !> system of linear equations A * X = B, A**T * X = B, or A**H * 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. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! CGBSVX uses the LU factorization to compute the solution to a complex + !! system of linear equations A * X = B, A**T * X = B, or A**H * 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. + !! Error bounds on the solution and a condition estimate are also + !! provided. c, b, ldb, x, ldx,rcond, ferr, berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53136,9 +53132,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) - !> CGEBRD 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. + !! CGEBRD 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53243,8 +53239,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info ) - !> CGEHRD reduces a complex general matrix A to upper Hessenberg form H by - !> an unitary similarity transformation: Q**H * A * Q = H . + !! CGEHRD reduces a complex general matrix A to upper Hessenberg form H by + !! an unitary similarity transformation: Q**H * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53373,8 +53369,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgelqt( m, n, mb, a, lda, t, ldt, work, info ) - !> CGELQT computes a blocked LQ factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. + !! CGELQT computes a blocked LQ factorization of a complex M-by-N matrix A + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53424,24 +53420,24 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) - !> CGELS 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. + !! CGELS 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53642,8 +53638,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgeqp3( m, n, a, lda, jpvt, tau, work, lwork, rwork,info ) - !> CGEQP3 computes a QR factorization with column pivoting of a - !> matrix A: A*P = Q*R using Level 3 BLAS. + !! CGEQP3 computes a QR factorization with column pivoting of a + !! matrix A: A*P = Q*R using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53794,8 +53790,8 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgeqrt( m, n, nb, a, lda, t, ldt, work, info ) - !> CGEQRT computes a blocked QR factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. + !! CGEQRT computes a blocked QR factorization of a complex M-by-N matrix A + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53851,9 +53847,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & - !> CGERFS improves the computed solution to a system of linear - !> equations and provides error bounds and backward error estimates for - !> the solution. + !! CGERFS improves the computed solution to a system of linear + !! equations and provides error bounds and backward error estimates for + !! the solution. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54048,14 +54044,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgetrf( m, n, a, lda, ipiv, info ) - !> CGETRF 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. + !! CGETRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54126,24 +54122,24 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) - !> CGGGLM 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. + !! CGGGLM 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54262,31 +54258,31 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & - !> CGGHD3 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 CGGHD3 reduces the original - !> problem to generalized Hessenberg form. - !> This is a blocked variant of CGGHRD, using matrix-matrix - !> multiplications for parts of the computation to enhance performance. + !! CGGHD3 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 CGGHD3 reduces the original + !! problem to generalized Hessenberg form. + !! This is a blocked variant of CGGHRD, using matrix-matrix + !! multiplications for parts of the computation to enhance performance. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54792,18 +54788,18 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) - !> CGGLSE 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. + !! CGGLSE 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54924,11 +54920,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, info ) - !> CGTCON 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))). + !! CGTCON 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))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55008,9 +55004,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, x, & - !> CGTRFS 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. + !! CGTRFS 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. ldx, ferr, berr, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55215,12 +55211,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & - !> CGTSVX uses the LU factorization to compute the solution to a complex - !> system of linear equations A * X = B, A**T * X = B, or A**H * X = B, - !> where A is a tridiagonal matrix of order N and X and B are N-by-NRHS - !> matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! CGTSVX uses the LU factorization to compute the solution to a complex + !! system of linear equations A * X = B, A**T * X = B, or A**H * X = B, + !! where A is a tridiagonal matrix of order N and X and B are N-by-NRHS + !! matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ldb, x, ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55303,13 +55299,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, rwork,& - !> CHBGST 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. + !! CHBGST 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56235,9 +56231,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) - !> CHBTRD reduces a complex Hermitian band matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. + !! CHBTRD reduces a complex Hermitian band matrix A to real symmetric + !! tridiagonal form T by a unitary similarity transformation: + !! Q**H * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56599,11 +56595,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_checon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) - !> CHECON 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))). + !! CHECON 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))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56680,11 +56676,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_checon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) - !> CHECON_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))). + !! CHECON_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))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56761,8 +56757,8 @@ module stdlib_linalg_lapack_c subroutine stdlib_cheev( jobz, uplo, n, a, lda, w, work, lwork, rwork,info ) - !> CHEEV computes all eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix A. + !! CHEEV computes all eigenvalues and, optionally, eigenvectors of a + !! complex Hermitian matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56872,56 +56868,56 @@ module stdlib_linalg_lapack_c subroutine stdlib_cheevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> CHEEVR 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. - !> CHEEVR first reduces the matrix A to tridiagonal form T with a call - !> to CHETRD. Then, whenever possible, CHEEVR 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 : CHEEVR calls CSTEMR when the full spectrum is requested - !> on machines which conform to the ieee-754 floating point standard. - !> CHEEVR 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. + !! CHEEVR 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. + !! CHEEVR first reduces the matrix A to tridiagonal form T with a call + !! to CHETRD. Then, whenever possible, CHEEVR 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 : CHEEVR calls CSTEMR when the full spectrum is requested + !! on machines which conform to the ieee-754 floating point standard. + !! CHEEVR 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. isuppz, work, lwork,rwork, lrwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57211,10 +57207,10 @@ module stdlib_linalg_lapack_c subroutine stdlib_cheevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> CHEEVX 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. + !! CHEEVX 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. work, lwork, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57458,11 +57454,11 @@ module stdlib_linalg_lapack_c subroutine stdlib_chegv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, info ) - !> CHEGV 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. + !! CHEGV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57559,12 +57555,12 @@ module stdlib_linalg_lapack_c subroutine stdlib_chegvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& - !> CHEGVX computes selected eigenvalues, and optionally, 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. - !> Eigenvalues and eigenvectors can be selected by specifying either a - !> range of values or a range of indices for the desired eigenvalues. + !! CHEGVX computes selected eigenvalues, and optionally, 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. + !! Eigenvalues and eigenvectors can be selected by specifying either a + !! range of values or a range of indices for the desired eigenvalues. m, w, z, ldz, work,lwork, rwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57687,9 +57683,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cherfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & - !> CHERFS 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. + !! CHERFS 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. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57880,17 +57876,17 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chesv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> CHESV 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. + !! CHESV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57958,20 +57954,20 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chesv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) - !> CHESV_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. + !! CHESV_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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58034,22 +58030,22 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chesv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> CHESV_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). + !! CHESV_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). ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58113,12 +58109,12 @@ module stdlib_linalg_lapack_c subroutine stdlib_chesvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & - !> CHESVX uses the diagonal pivoting factorization to compute 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. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! CHESVX uses the diagonal pivoting factorization to compute 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. + !! Error bounds on the solution and a condition estimate are also + !! provided. ferr, berr, work, lwork,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58210,39 +58206,39 @@ module stdlib_linalg_lapack_c subroutine stdlib_chgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alpha, beta, q, ldq,& - !> CHGEQZ 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. + !! CHGEQZ 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. z, ldz, work, lwork,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58710,11 +58706,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chpcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) - !> CHPCON 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))). + !! CHPCON 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))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58791,8 +58787,8 @@ module stdlib_linalg_lapack_c subroutine stdlib_chpev( jobz, uplo, n, ap, w, z, ldz, work, rwork,info ) - !> CHPEV computes all the eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix in packed storage. + !! CHPEV computes all the eigenvalues and, optionally, eigenvectors of a + !! complex Hermitian matrix in packed storage. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58888,10 +58884,10 @@ module stdlib_linalg_lapack_c subroutine stdlib_chpevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> CHPEVX computes selected eigenvalues and, optionally, eigenvectors - !> of a complex Hermitian matrix A in packed storage. - !> Eigenvalues/vectors can be selected by specifying either a range of - !> values or a range of indices for the desired eigenvalues. + !! CHPEVX computes selected eigenvalues and, optionally, eigenvectors + !! of a complex Hermitian matrix A in packed storage. + !! Eigenvalues/vectors can be selected by specifying either a range of + !! values or a range of indices for the desired eigenvalues. work, rwork, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59105,11 +59101,11 @@ module stdlib_linalg_lapack_c subroutine stdlib_chpgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,rwork, info ) - !> CHPGV 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. + !! CHPGV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59190,13 +59186,13 @@ module stdlib_linalg_lapack_c subroutine stdlib_chpgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & - !> CHPGVX computes selected eigenvalues and, optionally, 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. Eigenvalues and eigenvectors can be selected by - !> specifying either a range of values or a range of indices for the - !> desired eigenvalues. + !! CHPGVX computes selected eigenvalues and, optionally, 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. Eigenvalues and eigenvectors can be selected by + !! specifying either a range of values or a range of indices for the + !! desired eigenvalues. z, ldz, work, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59302,10 +59298,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& - !> CHPRFS 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. + !! CHPRFS 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. rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59499,17 +59495,17 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chpsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> CHPSV 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. + !! CHPSV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59550,12 +59546,12 @@ module stdlib_linalg_lapack_c subroutine stdlib_chpsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & - !> CHPSVX uses the diagonal pivoting factorization A = U*D*U**H or - !> A = L*D*L**H to compute 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. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! CHPSVX uses the diagonal pivoting factorization A = U*D*U**H or + !! A = L*D*L**H to compute 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. + !! Error bounds on the solution and a condition estimate are also + !! provided. berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59628,12 +59624,12 @@ module stdlib_linalg_lapack_c subroutine stdlib_chsein( side, eigsrc, initv, select, n, h, ldh, w, vl,ldvl, vr, ldvr, mm, & - !> CHSEIN 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. + !! CHSEIN 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. m, work, rwork, ifaill,ifailr, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59802,10 +59798,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claed0( qsiz, n, d, e, q, ldq, qstore, ldqs, rwork,iwork, info ) - !> Using the divide and conquer method, CLAED0: 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. + !! Using the divide and conquer method, CLAED0: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59980,13 +59976,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & - !> CLAMSWLQ 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) + !! CLAMSWLQ 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) lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60138,13 +60134,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & - !> CLAMTSQR 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) + !! CLAMTSQR 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) lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60300,17 +60296,17 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & - !> CLAQR2 is identical to CLAQR3 except that it avoids - !> recursion by calling CLAHQR instead of CLAQR4. - !> Aggressive early deflation: - !> This subroutine accepts as input an upper Hessenberg matrix - !> H and performs an unitary similarity transformation - !> designed to detect and deflate fully converged eigenvalues from - !> a trailing principal submatrix. On output H has been over- - !> written by a new Hessenberg matrix that is a perturbation of - !> an unitary similarity transformation of H. It is to be - !> hoped that the final version of H has many zero subdiagonal - !> entries. + !! CLAQR2 is identical to CLAQR3 except that it avoids + !! recursion by calling CLAHQR instead of CLAQR4. + !! Aggressive early deflation: + !! This subroutine accepts as input an upper Hessenberg matrix + !! H and performs an unitary similarity transformation + !! designed to detect and deflate fully converged eigenvalues from + !! a trailing principal submatrix. On output H has been over- + !! written by a new Hessenberg matrix that is a perturbation of + !! an unitary similarity transformation of H. It is to be + !! hoped that the final version of H has many zero subdiagonal + !! entries. ns, nd, sh, v, ldv, nh, t, ldt,nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60514,16 +60510,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) - !> CLASWLQ 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. + !! CLASWLQ 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -60598,17 +60594,17 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) - !> CLATSQR computes a blocked Tall-Skinny QR factorization of - !> a complex M-by-N matrix A for M >= N: - !> A = Q * ( R ), - !> ( 0 ) - !> where: - !> Q is a M-by-M orthogonal matrix, stored on exit in an implicit - !> form in the elements below the diagonal of the array A and in - !> the elements of the array T; - !> R is an upper-triangular N-by-N matrix, stored on exit in - !> the elements on and above the diagonal of the array A. - !> 0 is a (M-N)-by-N zero matrix, and is not stored. + !! CLATSQR computes a blocked Tall-Skinny QR factorization of + !! a complex M-by-N matrix A for M >= N: + !! A = Q * ( R ), + !! ( 0 ) + !! where: + !! Q is a M-by-M orthogonal matrix, stored on exit in an implicit + !! form in the elements below the diagonal of the array A and in + !! the elements of the array T; + !! R is an upper-triangular N-by-N matrix, stored on exit in + !! the elements on and above the diagonal of the array A. + !! 0 is a (M-N)-by-N zero matrix, and is not stored. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -60683,17 +60679,17 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) - !> CPBSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite band matrix and X - !> and B are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular band matrix, and L is a lower - !> triangular band matrix, with the same number of superdiagonals or - !> subdiagonals as A. The factored form of A is then used to solve the - !> system of equations A * X = B. + !! CPBSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite band matrix and X + !! and B are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular band matrix, and L is a lower + !! triangular band matrix, with the same number of superdiagonals or + !! subdiagonals as A. The factored form of A is then used to solve the + !! system of equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60737,13 +60733,13 @@ module stdlib_linalg_lapack_c subroutine stdlib_cpbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & - !> CPBSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to - !> compute the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite band matrix and X - !> and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! CPBSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to + !! compute the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite band matrix and X + !! and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60894,13 +60890,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpftrf( transr, uplo, n, a, info ) - !> CPFTRF computes the Cholesky factorization of a complex Hermitian - !> positive definite matrix A. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the block version of the algorithm, calling Level 3 BLAS. + !! CPFTRF computes the Cholesky factorization of a complex Hermitian + !! positive definite matrix A. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the block version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61070,9 +61066,9 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cpftri( transr, uplo, n, a, info ) - !> CPFTRI computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by CPFTRF. + !! CPFTRI computes the inverse of a complex Hermitian positive definite + !! matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !! computed by CPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61229,16 +61225,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cposv( uplo, n, nrhs, a, lda, b, ldb, info ) - !> CPOSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**H* U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is a lower triangular - !> matrix. The factored form of A is then used to solve the system of - !> equations A * X = B. + !! CPOSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**H* U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is a lower triangular + !! matrix. The factored form of A is then used to solve the system of + !! equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61280,13 +61276,13 @@ module stdlib_linalg_lapack_c subroutine stdlib_cposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & - !> CPOSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to - !> compute the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! CPOSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to + !! compute the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. rcond, ferr, berr, work,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61424,10 +61420,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cptrfs( uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx,ferr, berr, work, & - !> CPTRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite - !> and tridiagonal, and provides error bounds and backward error - !> estimates for the solution. + !! CPTRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite + !! and tridiagonal, and provides error bounds and backward error + !! estimates for the solution. rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61642,11 +61638,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cptsv( n, nrhs, d, e, b, ldb, info ) - !> CPTSV computes the solution to a complex system of linear equations - !> A*X = B, where A is an N-by-N Hermitian positive definite tridiagonal - !> matrix, and X and B are N-by-NRHS matrices. - !> A is factored as A = L*D*L**H, and the factored form of A is then - !> used to solve the system of equations. + !! CPTSV computes the solution to a complex system of linear equations + !! A*X = B, where A is an N-by-N Hermitian positive definite tridiagonal + !! matrix, and X and B are N-by-NRHS matrices. + !! A is factored as A = L*D*L**H, and the factored form of A is then + !! used to solve the system of equations. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61684,12 +61680,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& - !> CPTSVX uses the factorization A = L*D*L**H to compute the solution - !> to a complex system of linear equations A*X = B, where A is an - !> N-by-N Hermitian positive definite tridiagonal matrix and X and B - !> are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! CPTSVX uses the factorization A = L*D*L**H to compute the solution + !! to a complex system of linear equations A*X = B, where A is an + !! N-by-N Hermitian positive definite tridiagonal matrix and X and B + !! are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61761,17 +61757,17 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cstedc( compz, n, d, e, z, ldz, work, lwork, rwork,lrwork, iwork, & - !> CSTEDC computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric tridiagonal matrix using the divide and conquer method. - !> The eigenvectors of a full or band complex Hermitian matrix can also - !> be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this - !> matrix to tridiagonal 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 SLAED3 for details. + !! CSTEDC computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric tridiagonal matrix using the divide and conquer method. + !! The eigenvectors of a full or band complex Hermitian matrix can also + !! be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this + !! matrix to tridiagonal 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 SLAED3 for details. liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61975,22 +61971,22 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> CSTEGR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has - !> a well defined set of pairwise different real eigenvalues, the corresponding - !> real eigenvectors are pairwise orthogonal. - !> The spectrum may be computed either completely or partially by specifying - !> either an interval (VL,VU] or a range of indices IL:IU for the desired - !> eigenvalues. - !> CSTEGR is a compatibility wrapper around the improved CSTEMR routine. - !> See SSTEMR for further details. - !> One important change is that the ABSTOL parameter no longer provides any - !> benefit and hence is no longer used. - !> Note : CSTEGR and CSTEMR work only on machines which follow - !> IEEE-754 floating-point standard in their handling of infinities and - !> NaNs. Normal execution may create these exceptiona values and hence - !> may abort due to a floating point exception in environments which - !> do not conform to the IEEE-754 standard. + !! CSTEGR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Any such unreduced matrix has + !! a well defined set of pairwise different real eigenvalues, the corresponding + !! real eigenvectors are pairwise orthogonal. + !! The spectrum may be computed either completely or partially by specifying + !! either an interval (VL,VU] or a range of indices IL:IU for the desired + !! eigenvalues. + !! CSTEGR is a compatibility wrapper around the improved CSTEMR routine. + !! See SSTEMR for further details. + !! One important change is that the ABSTOL parameter no longer provides any + !! benefit and hence is no longer used. + !! Note : CSTEGR and CSTEMR work only on machines which follow + !! IEEE-754 floating-point standard in their handling of infinities and + !! NaNs. Normal execution may create these exceptiona values and hence + !! may abort due to a floating point exception in environments which + !! do not conform to the IEEE-754 standard. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62017,24 +62013,24 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alpha, beta, q, & - !> CTGSEN reorders the generalized Schur decomposition of a complex - !> matrix pair (A, B) (in terms of an unitary equivalence trans- - !> formation Q**H * (A, B) * Z), so that a selected cluster of eigenvalues - !> appears in the leading diagonal blocks of the pair (A,B). The leading - !> columns of Q and Z form unitary bases of the corresponding left and - !> right eigenspaces (deflating subspaces). (A, B) must be in - !> generalized Schur canonical form, that is, A and B are both upper - !> triangular. - !> CTGSEN also computes the generalized eigenvalues - !> w(j)= ALPHA(j) / BETA(j) - !> of the reordered matrix pair (A, B). - !> Optionally, the routine computes estimates of reciprocal condition - !> numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11), - !> (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s) - !> between the matrix pairs (A11, B11) and (A22,B22) that correspond to - !> the selected cluster and the eigenvalues outside the cluster, resp., - !> and norms of "projections" onto left and right eigenspaces w.r.t. - !> the selected cluster in the (1,1)-block. + !! CTGSEN reorders the generalized Schur decomposition of a complex + !! matrix pair (A, B) (in terms of an unitary equivalence trans- + !! formation Q**H * (A, B) * Z), so that a selected cluster of eigenvalues + !! appears in the leading diagonal blocks of the pair (A,B). The leading + !! columns of Q and Z form unitary bases of the corresponding left and + !! right eigenspaces (deflating subspaces). (A, B) must be in + !! generalized Schur canonical form, that is, A and B are both upper + !! triangular. + !! CTGSEN also computes the generalized eigenvalues + !! w(j)= ALPHA(j) / BETA(j) + !! of the reordered matrix pair (A, B). + !! Optionally, the routine computes estimates of reciprocal condition + !! numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11), + !! (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s) + !! between the matrix pairs (A11, B11) and (A22,B22) that correspond to + !! the selected cluster and the eigenvalues outside the cluster, resp., + !! and norms of "projections" onto left and right eigenspaces w.r.t. + !! the selected cluster in the (1,1)-block. ldq, z, ldz, m, pl, pr, dif,work, lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62296,10 +62292,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_ctgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & - !> CTGSNA estimates reciprocal condition numbers for specified - !> eigenvalues and/or eigenvectors of a matrix pair (A, B). - !> (A, B) must be in generalized Schur canonical form, that is, A and - !> B are both upper triangular. + !! CTGSNA estimates reciprocal condition numbers for specified + !! eigenvalues and/or eigenvectors of a matrix pair (A, B). + !! (A, B) must be in generalized Schur canonical form, that is, A and + !! B are both upper triangular. dif, mm, m, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62453,13 +62449,13 @@ module stdlib_linalg_lapack_c subroutine stdlib_ctrsen( job, compq, select, n, t, ldt, q, ldq, w, m, s,sep, work, lwork, & - !> CTRSEN reorders the Schur factorization of a complex matrix - !> A = Q*T*Q**H, so that a selected cluster of eigenvalues appears in - !> the leading positions on the diagonal of the upper triangular matrix - !> T, and the leading columns of Q form an orthonormal basis of the - !> corresponding right invariant subspace. - !> Optionally the routine computes the reciprocal condition numbers of - !> the cluster of eigenvalues and/or the invariant subspace. + !! CTRSEN reorders the Schur factorization of a complex matrix + !! A = Q*T*Q**H, so that a selected cluster of eigenvalues appears in + !! the leading positions on the diagonal of the upper triangular matrix + !! T, and the leading columns of Q form an orthonormal basis of the + !! corresponding right invariant subspace. + !! Optionally the routine computes the reciprocal condition numbers of + !! the cluster of eigenvalues and/or the invariant subspace. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62590,21 +62586,21 @@ module stdlib_linalg_lapack_c subroutine stdlib_cunbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> CUNBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, - !> M-P, or M-Q. Routines CUNBDB2, CUNBDB3, and CUNBDB4 handle cases in - !> which Q is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! CUNBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, + !! M-P, or M-Q. Routines CUNBDB2, CUNBDB3, and CUNBDB4 handle cases in + !! which Q is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by + !! angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62695,21 +62691,21 @@ module stdlib_linalg_lapack_c subroutine stdlib_cunbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> CUNBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, - !> Q, or M-Q. Routines CUNBDB1, CUNBDB3, and CUNBDB4 handle cases in - !> which P is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! CUNBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, + !! Q, or M-Q. Routines CUNBDB1, CUNBDB3, and CUNBDB4 handle cases in + !! which P is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are P-by-P bidiagonal matrices represented implicitly by + !! angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62810,21 +62806,21 @@ module stdlib_linalg_lapack_c subroutine stdlib_cunbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> CUNBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, - !> Q, or M-Q. Routines CUNBDB1, CUNBDB2, and CUNBDB4 handle cases in - !> which M-P is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! CUNBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, + !! Q, or M-Q. Routines CUNBDB1, CUNBDB2, and CUNBDB4 handle cases in + !! which M-P is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62924,21 +62920,21 @@ module stdlib_linalg_lapack_c subroutine stdlib_cunbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> CUNBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, - !> M-P, or Q. Routines CUNBDB1, CUNBDB2, and CUNBDB3 handle cases in - !> which M-Q is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! CUNBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, + !! M-P, or Q. Routines CUNBDB1, CUNBDB2, and CUNBDB3 handle cases in + !! which M-Q is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63073,21 +63069,21 @@ module stdlib_linalg_lapack_c subroutine stdlib_cuncsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & - !> CUNCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with - !> orthonormal columns that has been partitioned into a 2-by-1 block - !> structure: - !> [ I1 0 0 ] - !> [ 0 C 0 ] - !> [ X11 ] [ U1 | ] [ 0 0 0 ] - !> X = [-----] = [---------] [----------] V1**T . - !> [ X21 ] [ | U2 ] [ 0 0 0 ] - !> [ 0 S 0 ] - !> [ 0 0 I2] - !> X11 is P-by-Q. The unitary matrices U1, U2, and V1 are P-by-P, - !> (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R - !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which - !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a - !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). + !! CUNCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with + !! orthonormal columns that has been partitioned into a 2-by-1 block + !! structure: + !! [ I1 0 0 ] + !! [ 0 C 0 ] + !! [ X11 ] [ U1 | ] [ 0 0 0 ] + !! X = [-----] = [---------] [----------] V1**T . + !! [ X21 ] [ | U2 ] [ 0 0 0 ] + !! [ 0 S 0 ] + !! [ 0 0 I2] + !! X11 is P-by-Q. The unitary matrices U1, U2, and V1 are P-by-P, + !! (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R + !! nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which + !! R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a + !! K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, rwork, lrwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63510,22 +63506,22 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cungbr( vect, m, n, k, a, lda, tau, work, lwork, info ) - !> CUNGBR generates one of the complex unitary matrices Q or P**H - !> determined by CGEBRD when reducing a complex matrix A to bidiagonal - !> form: A = Q * B * P**H. Q and P**H are defined as products of - !> elementary reflectors H(i) or G(i) respectively. - !> If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q - !> is of order M: - !> if m >= k, Q = H(1) H(2) . . . H(k) and CUNGBR returns the first n - !> columns of Q, where m >= n >= k; - !> if m < k, Q = H(1) H(2) . . . H(m-1) and CUNGBR returns Q as an - !> M-by-M matrix. - !> If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**H - !> is of order N: - !> if k < n, P**H = G(k) . . . G(2) G(1) and CUNGBR returns the first m - !> rows of P**H, where n >= m >= k; - !> if k >= n, P**H = G(n-1) . . . G(2) G(1) and CUNGBR returns P**H as - !> an N-by-N matrix. + !! CUNGBR generates one of the complex unitary matrices Q or P**H + !! determined by CGEBRD when reducing a complex matrix A to bidiagonal + !! form: A = Q * B * P**H. Q and P**H are defined as products of + !! elementary reflectors H(i) or G(i) respectively. + !! If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q + !! is of order M: + !! if m >= k, Q = H(1) H(2) . . . H(k) and CUNGBR returns the first n + !! columns of Q, where m >= n >= k; + !! if m < k, Q = H(1) H(2) . . . H(m-1) and CUNGBR returns Q as an + !! M-by-M matrix. + !! If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**H + !! is of order N: + !! if k < n, P**H = G(k) . . . G(2) G(1) and CUNGBR returns the first m + !! rows of P**H, where n >= m >= k; + !! if k >= n, P**H = G(n-1) . . . G(2) G(1) and CUNGBR returns P**H as + !! an N-by-N matrix. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63659,11 +63655,11 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cungtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) - !> CUNGTSQR generates an M-by-N complex matrix Q_out with orthonormal - !> columns, which are the first N columns of a product of comlpex unitary - !> matrices of order M which are returned by CLATSQR - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> See the documentation for CLATSQR. + !! CUNGTSQR generates an M-by-N complex matrix Q_out with orthonormal + !! columns, which are the first N columns of a product of comlpex unitary + !! matrices of order M which are returned by CLATSQR + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! See the documentation for CLATSQR. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63757,28 +63753,28 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cunmbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & - !> If VECT = 'Q', CUNMBR: 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 - !> If VECT = 'P', CUNMBR overwrites the general complex M-by-N matrix C - !> with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': P * C C * P - !> TRANS = 'C': P**H * C C * P**H - !> Here Q and P**H are the unitary matrices determined by CGEBRD when - !> reducing a complex matrix A to bidiagonal form: A = Q * B * P**H. Q - !> and P**H are defined as products of elementary reflectors H(i) and - !> G(i) respectively. - !> Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the - !> order of the unitary matrix Q or P**H that is applied. - !> If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: - !> if nq >= k, Q = H(1) H(2) . . . H(k); - !> if nq < k, Q = H(1) H(2) . . . H(nq-1). - !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: - !> if k < nq, P = G(1) G(2) . . . G(k); - !> if k >= nq, P = G(1) G(2) . . . G(nq-1). + !! If VECT = 'Q', CUNMBR: 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 + !! If VECT = 'P', CUNMBR overwrites the general complex M-by-N matrix C + !! with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': P * C C * P + !! TRANS = 'C': P**H * C C * P**H + !! Here Q and P**H are the unitary matrices determined by CGEBRD when + !! reducing a complex matrix A to bidiagonal form: A = Q * B * P**H. Q + !! and P**H are defined as products of elementary reflectors H(i) and + !! G(i) respectively. + !! Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the + !! order of the unitary matrix Q or P**H that is applied. + !! If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: + !! if nq >= k, Q = H(1) H(2) . . . H(k); + !! if nq < k, Q = H(1) H(2) . . . H(nq-1). + !! If VECT = 'P', A is assumed to have been a K-by-NQ matrix: + !! if k < nq, P = G(1) G(2) . . . G(k); + !! if k >= nq, P = G(1) G(2) . . . G(nq-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63918,12 +63914,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgelq( m, n, a, lda, t, tsize, work, lwork,info ) - !> CGELQ 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. + !! CGELQ 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -64043,31 +64039,31 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & - !> CGELSD 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. + !! CGELSD 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. iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64381,18 +64377,18 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & - !> CGELSS 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. + !! CGELSS 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64839,38 +64835,38 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, rwork, & - !> CGELSY 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. + !! CGELSY 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65064,13 +65060,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & - !> CGEMLQ 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) + !! CGEMLQ 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) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65161,13 +65157,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & - !> CGEMQR 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) + !! CGEMQR 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) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65258,13 +65254,13 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgeqr( m, n, a, lda, t, tsize, work, lwork,info ) - !> CGEQR 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. + !! CGEQR 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -65373,23 +65369,23 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, iwork, & - !> CGESDD 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. + !! CGESDD 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66868,15 +66864,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) - !> CGESV 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. + !! CGESV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -66916,17 +66912,17 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, & - !> CGESVD 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. + !! CGESVD 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69363,15 +69359,15 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & - !> CGESVDQ 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. + !! CGESVDQ 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. numrank, iwork, liwork,cwork, lcwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -70242,12 +70238,12 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & - !> CGESVX uses the LU factorization to compute 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. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! CGESVX uses the LU factorization to compute 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. + !! Error bounds on the solution and a condition estimate are also + !! provided. x, ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70447,24 +70443,24 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) - !> CGETSLS 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. + !! CGETSLS 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -70684,18 +70680,18 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) - !> CGETSQRHRT 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. + !! CGETSQRHRT 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70817,26 +70813,26 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alpha, beta, & - !> CGGES 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. + !! CGGES 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. vsl, ldvsl, vsr, ldvsr, work,lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71069,28 +71065,28 @@ module stdlib_linalg_lapack_c subroutine stdlib_cggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, alpha,& - !> CGGESX computes for a pair of N-by-N complex nonsymmetric matrices - !> (A,B), the generalized eigenvalues, the complex Schur form (S,T), - !> and, optionally, the left and/or right matrices of 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; computes - !> a reciprocal condition number for the average of the selected - !> eigenvalues (RCONDE); and computes a reciprocal condition number for - !> the right and left deflating subspaces corresponding to the selected - !> eigenvalues (RCONDV). The leading columns of VSL and VSR then form - !> an orthonormal basis for the corresponding left and right eigenspaces - !> (deflating subspaces). - !> 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 or for both being zero. - !> A pair of matrices (S,T) is in generalized complex Schur form if T is - !> upper triangular with non-negative diagonal and S is upper - !> triangular. + !! CGGESX computes for a pair of N-by-N complex nonsymmetric matrices + !! (A,B), the generalized eigenvalues, the complex Schur form (S,T), + !! and, optionally, the left and/or right matrices of 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; computes + !! a reciprocal condition number for the average of the selected + !! eigenvalues (RCONDE); and computes a reciprocal condition number for + !! the right and left deflating subspaces corresponding to the selected + !! eigenvalues (RCONDV). The leading columns of VSL and VSR then form + !! an orthonormal basis for the corresponding left and right eigenspaces + !! (deflating subspaces). + !! 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 or for both being zero. + !! A pair of matrices (S,T) is in generalized complex Schur form if T is + !! upper triangular with non-negative diagonal and S is upper + !! triangular. beta, vsl, ldvsl, vsr,ldvsr, rconde, rcondv, work, lwork, rwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- @@ -71379,21 +71375,21 @@ module stdlib_linalg_lapack_c subroutine stdlib_cggev( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & - !> CGGEV 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). + !! CGGEV 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). work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71649,26 +71645,26 @@ module stdlib_linalg_lapack_c subroutine stdlib_cggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alpha, beta, vl, & - !> CGGEVX 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. - !> Optionally, it also computes a balancing transformation to improve - !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, - !> LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for - !> the eigenvalues (RCONDE), and reciprocal condition numbers for the - !> right eigenvectors (RCONDV). - !> 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) - !> of (A,B) satisfies - !> A * v(j) = lambda(j) * B * v(j) . - !> The left eigenvector u(j) corresponding to the eigenvalue 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). + !! CGGEVX 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. + !! Optionally, it also computes a balancing transformation to improve + !! the conditioning of the eigenvalues and eigenvectors (ILO, IHI, + !! LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for + !! the eigenvalues (RCONDE), and reciprocal condition numbers for the + !! right eigenvectors (RCONDV). + !! 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) + !! of (A,B) satisfies + !! A * v(j) = lambda(j) * B * v(j) . + !! The left eigenvector u(j) corresponding to the eigenvalue 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). ldvl, vr, ldvr, ilo, ihi,lscale, rscale, abnrm, bbnrm, rconde, rcondv,work, lwork, rwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -71997,8 +71993,8 @@ module stdlib_linalg_lapack_c subroutine stdlib_chbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,rwork, info ) - !> CHBEV computes all the eigenvalues and, optionally, eigenvectors of - !> a complex Hermitian band matrix A. + !! CHBEV computes all the eigenvalues and, optionally, eigenvectors of + !! a complex Hermitian band matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72101,15 +72097,15 @@ module stdlib_linalg_lapack_c subroutine stdlib_chbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, rwork, lrwork, & - !> CHBEVD 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. + !! CHBEVD 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72251,10 +72247,10 @@ module stdlib_linalg_lapack_c subroutine stdlib_chbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & - !> CHBEVX computes selected eigenvalues and, optionally, eigenvectors - !> of a complex Hermitian band matrix A. Eigenvalues and eigenvectors - !> can be selected by specifying either a range of values or a range of - !> indices for the desired eigenvalues. + !! CHBEVX computes selected eigenvalues and, optionally, eigenvectors + !! of a complex Hermitian band matrix A. Eigenvalues and eigenvectors + !! can be selected by specifying either a range of values or a range of + !! indices for the desired eigenvalues. m, w, z, ldz, work, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72482,10 +72478,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & - !> CHBGV 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. + !! CHBGV 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. rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72562,17 +72558,17 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & - !> CHBGVD 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. + !! CHBGVD 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. lwork, rwork, lrwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72689,12 +72685,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & - !> CHBGVX 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. Eigenvalues and - !> eigenvectors can be selected by specifying either all eigenvalues, - !> a range of values or a range of indices for the desired eigenvalues. + !! CHBGVX 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. Eigenvalues and + !! eigenvectors can be selected by specifying either all eigenvalues, + !! a range of values or a range of indices for the desired eigenvalues. vu, il, iu, abstol, m, w, z,ldz, work, rwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72878,15 +72874,15 @@ module stdlib_linalg_lapack_c subroutine stdlib_cheevd( jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, liwork,& - !> CHEEVD 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. + !! CHEEVD 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73031,17 +73027,17 @@ module stdlib_linalg_lapack_c subroutine stdlib_chegvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, lrwork,& - !> CHEGVD 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. + !! CHEGVD 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73163,15 +73159,15 @@ module stdlib_linalg_lapack_c subroutine stdlib_chpevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,rwork, lrwork, iwork, & - !> CHPEVD 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. + !! CHPEVD 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. liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73305,18 +73301,18 @@ module stdlib_linalg_lapack_c subroutine stdlib_chpgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, rwork, lrwork,& - !> CHPGVD 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. + !! CHPGVD 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73438,14 +73434,14 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgees( jobvs, sort, select, n, a, lda, sdim, w, vs,ldvs, work, lwork, & - !> CGEES 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. + !! CGEES 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. rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73609,20 +73605,20 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgeesx( jobvs, sort, select, sense, n, a, lda, sdim, w,vs, ldvs, rconde, & - !> CGEESX 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; - !> computes a reciprocal condition number for the average of the - !> selected eigenvalues (RCONDE); and computes a reciprocal condition - !> number for the right invariant subspace corresponding to the - !> selected eigenvalues (RCONDV). The leading columns of Z form an - !> orthonormal basis for this invariant subspace. - !> For further explanation of the reciprocal condition numbers RCONDE - !> and RCONDV, see Section 4.10_sp of the LAPACK Users' Guide (where - !> these quantities are called s and sep respectively). - !> A complex matrix is in Schur form if it is upper triangular. + !! CGEESX 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; + !! computes a reciprocal condition number for the average of the + !! selected eigenvalues (RCONDE); and computes a reciprocal condition + !! number for the right invariant subspace corresponding to the + !! selected eigenvalues (RCONDV). The leading columns of Z form an + !! orthonormal basis for this invariant subspace. + !! For further explanation of the reciprocal condition numbers RCONDE + !! and RCONDV, see Section 4.10_sp of the LAPACK Users' Guide (where + !! these quantities are called s and sep respectively). + !! A complex matrix is in Schur form if it is upper triangular. rcondv, work, lwork, rwork,bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73811,16 +73807,16 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgeev( jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr,work, lwork, rwork, & - !> CGEEV 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. + !! CGEEV 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74060,31 +74056,31 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgeevx( balanc, jobvl, jobvr, sense, n, a, lda, w, vl,ldvl, vr, ldvr, ilo, & - !> CGEEVX computes for an N-by-N complex nonsymmetric matrix A, the - !> eigenvalues and, optionally, the left and/or right eigenvectors. - !> Optionally also, it computes a balancing transformation to improve - !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, - !> SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues - !> (RCONDE), and reciprocal condition numbers for the right - !> eigenvectors (RCONDV). - !> 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. - !> Balancing a matrix means permuting the rows and columns to make it - !> more nearly upper triangular, and applying a diagonal similarity - !> transformation D * A * D**(-1), where D is a diagonal matrix, to - !> make its rows and columns closer in norm and the condition numbers - !> of its eigenvalues and eigenvectors smaller. The computed - !> reciprocal condition numbers correspond to the balanced matrix. - !> Permuting rows and columns will not change the condition numbers - !> (in exact arithmetic) but diagonal scaling will. For further - !> explanation of balancing, see section 4.10.2_sp of the LAPACK - !> Users' Guide. + !! CGEEVX computes for an N-by-N complex nonsymmetric matrix A, the + !! eigenvalues and, optionally, the left and/or right eigenvectors. + !! Optionally also, it computes a balancing transformation to improve + !! the conditioning of the eigenvalues and eigenvectors (ILO, IHI, + !! SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues + !! (RCONDE), and reciprocal condition numbers for the right + !! eigenvectors (RCONDV). + !! 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. + !! Balancing a matrix means permuting the rows and columns to make it + !! more nearly upper triangular, and applying a diagonal similarity + !! transformation D * A * D**(-1), where D is a diagonal matrix, to + !! make its rows and columns closer in norm and the condition numbers + !! of its eigenvalues and eigenvectors smaller. The computed + !! reciprocal condition numbers correspond to the balanced matrix. + !! Permuting rows and columns will not change the condition numbers + !! (in exact arithmetic) but diagonal scaling will. For further + !! explanation of balancing, see section 4.10.2_sp of the LAPACK + !! Users' Guide. ihi, scale, abnrm, rconde,rcondv, work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74362,16 +74358,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & - !> CGEJSV 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. + !! CGEJSV 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. v, ldv,cwork, lwork, rwork, lrwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75769,15 +75765,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, cwork, lwork, & - !> CGESVJ 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. + !! CGESVJ 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. rwork, lrwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76621,26 +76617,26 @@ module stdlib_linalg_lapack_c subroutine stdlib_cgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alpha, beta, & - !> CGGES3 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. + !! CGGES3 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. vsl, ldvsl, vsr, ldvsr,work, lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76872,21 +76868,21 @@ module stdlib_linalg_lapack_c subroutine stdlib_cggev3( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & - !> CGGEV3 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). + !! CGGEV3 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). work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77144,10 +77140,10 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & - !> CGSVJ0 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. + !! CGSVJ0 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. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77685,30 +77681,30 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_cgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & - !> CGSVJ1 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 - !> ~~~~~~~~~~~~~~~ - !> CGSVJ1 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. + !! CGSVJ1 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 + !! ~~~~~~~~~~~~~~~ + !! CGSVJ1 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. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78058,16 +78054,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chesv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> CHESV_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. + !! CHESV_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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78130,12 +78126,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chetrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) - !> CHETRF_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. + !! CHETRF_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78359,14 +78355,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_chseqr( job, compz, n, ilo, ihi, h, ldh, w, z, ldz,work, lwork, info ) - !> CHSEQR 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. + !! CHSEQR 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78504,16 +78500,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clahef_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) - !> CLAHEF_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. + !! CLAHEF_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78748,14 +78744,14 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& - !> CLAQR0 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. + !! CLAQR0 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. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79095,15 +79091,15 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & - !> Aggressive early deflation: - !> CLAQR3 accepts as input an upper Hessenberg matrix - !> H and performs an unitary similarity transformation - !> designed to detect and deflate fully converged eigenvalues from - !> a trailing principal submatrix. On output H has been over- - !> written by a new Hessenberg matrix that is a perturbation of - !> an unitary similarity transformation of H. It is to be - !> hoped that the final version of H has many zero subdiagonal - !> entries. + !! Aggressive early deflation: + !! CLAQR3 accepts as input an upper Hessenberg matrix + !! H and performs an unitary similarity transformation + !! designed to detect and deflate fully converged eigenvalues from + !! a trailing principal submatrix. On output H has been over- + !! written by a new Hessenberg matrix that is a perturbation of + !! an unitary similarity transformation of H. It is to be + !! hoped that the final version of H has many zero subdiagonal + !! entries. ns, nd, sh, v, ldv, nh, t, ldt,nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79317,20 +79313,20 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_claqr4( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& - !> CLAQR4 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. - !> CLAQR4 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. + !! CLAQR4 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. + !! CLAQR4 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. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79665,46 +79661,46 @@ module stdlib_linalg_lapack_c recursive subroutine stdlib_claqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alpha, & - !> CLAQZ0 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" + !! CLAQZ0 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" beta, q, ldq, z,ldz, work, lwork, rwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -80018,7 +80014,7 @@ module stdlib_linalg_lapack_c recursive subroutine stdlib_claqz2( ilschur, ilq, ilz, n, ilo, ihi, nw,a, lda, b, ldb, q, & - !> CLAQZ2 performs AED + !! CLAQZ2 performs AED ldq, z, ldz, ns,nd, alpha, beta, qc, ldqc, zc, ldzc,work, lwork, rwork, rec, info ) ! arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -80207,16 +80203,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_clasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -80443,16 +80439,16 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> CSYSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> Aasen's algorithm is used to factor A as - !> A = U**T * T * U, if UPLO = 'U', or - !> A = L * T * L**T, if UPLO = 'L', - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and T is symmetric tridiagonal. The factored - !> form of A is then used to solve the system of equations A * X = B. + !! CSYSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! Aasen's algorithm is used to factor A as + !! A = U**T * T * U, if UPLO = 'U', or + !! A = L * T * L**T, if UPLO = 'L', + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and T is symmetric tridiagonal. The factored + !! form of A is then used to solve the system of equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80515,12 +80511,12 @@ module stdlib_linalg_lapack_c pure subroutine stdlib_csytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) - !> CSYTRF_AA computes the factorization of a complex symmetric matrix A - !> using the Aasen's algorithm. The form of the factorization is - !> A = U**T*T*U or A = L*T*L**T - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and T is a complex symmetric tridiagonal matrix. - !> This is the blocked version of the algorithm, calling Level 3 BLAS. + !! CSYTRF_AA computes the factorization of a complex symmetric matrix A + !! using the Aasen's algorithm. The form of the factorization is + !! A = U**T*T*U or A = L*T*L**T + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and T is a complex symmetric tridiagonal matrix. + !! This is the blocked version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_lapack_d.fypp b/src/stdlib_linalg_lapack_d.fypp index 6eccbe858..897f6750c 100644 --- a/src/stdlib_linalg_lapack_d.fypp +++ b/src/stdlib_linalg_lapack_d.fypp @@ -524,9 +524,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgbtf2( m, n, kl, ku, ab, ldab, ipiv, info ) - !> DGBTF2 computes an LU factorization of a real m-by-n band matrix A - !> using partial pivoting with row interchanges. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! DGBTF2 computes an LU factorization of a real m-by-n band matrix A + !! using partial pivoting with row interchanges. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -610,10 +610,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) - !> DGBTRS solves a system of linear equations - !> A * X = B or A**T * X = B - !> with a general band matrix A using the LU factorization computed - !> by DGBTRF. + !! DGBTRS solves a system of linear equations + !! A * X = B or A**T * X = B + !! with a general band matrix A using the LU factorization computed + !! by DGBTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -704,9 +704,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) - !> DGEBAK forms the right or left eigenvectors of a real general matrix - !> by backward transformation on the computed eigenvectors of the - !> balanced matrix output by DGEBAL. + !! DGEBAK forms the right or left eigenvectors of a real general matrix + !! by backward transformation on the computed eigenvectors of the + !! balanced matrix output by DGEBAL. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -801,10 +801,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) - !> DGGBAK forms the right or left eigenvectors of a real generalized - !> eigenvalue problem A*x = lambda*B*x, by backward transformation on - !> the computed eigenvectors of the balanced pair of matrices output by - !> DGGBAL. + !! DGGBAK forms the right or left eigenvectors of a real generalized + !! eigenvalue problem A*x = lambda*B*x, by backward transformation on + !! the computed eigenvectors of the balanced pair of matrices output by + !! DGGBAL. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -914,12 +914,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgtsv( n, nrhs, dl, d, du, b, ldb, info ) - !> DGTSV 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. + !! DGTSV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1093,13 +1093,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgttrf( n, dl, d, du, du2, ipiv, info ) - !> DGTTRF computes an LU factorization of a real 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. + !! DGTTRF computes an LU factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1185,10 +1185,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) - !> DGTTS2 solves one of the systems of equations - !> A*X = B or A**T*X = B, - !> with a tridiagonal matrix A using the LU factorization computed - !> by DGTTRF. + !! DGTTS2 solves one of the systems of equations + !! A*X = B or A**T*X = B, + !! with a tridiagonal matrix A using the LU factorization computed + !! by DGTTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1298,12 +1298,12 @@ module stdlib_linalg_lapack_d pure real(dp) function stdlib_dla_gbrpvgrw( n, kl, ku, ncols, ab,ldab, afb, ldafb ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1338,12 +1338,12 @@ module stdlib_linalg_lapack_d pure real(dp) function stdlib_dla_gerpvgrw( n, ncols, a, lda, af,ldaf ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1377,9 +1377,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dla_wwaddw( n, x, y, w ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1404,14 +1404,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlabad( small, large ) - !> DLABAD 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. + !! DLABAD 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1432,8 +1432,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlacn2( n, v, x, isgn, est, kase, isave ) - !> DLACN2 estimates the 1-norm of a square, real matrix A. - !> Reverse communication is used for evaluating matrix-vector products. + !! DLACN2 estimates the 1-norm of a square, real matrix A. + !! Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1565,8 +1565,8 @@ module stdlib_linalg_lapack_d subroutine stdlib_dlacon( n, v, x, isgn, est, kase ) - !> DLACON estimates the 1-norm of a square, real matrix A. - !> Reverse communication is used for evaluating matrix-vector products. + !! DLACON estimates the 1-norm of a square, real matrix A. + !! Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1686,8 +1686,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlacpy( uplo, m, n, a, lda, b, ldb ) - !> DLACPY copies all or part of a two-dimensional matrix A to another - !> matrix B. + !! DLACPY copies all or part of a two-dimensional matrix A to another + !! matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1752,11 +1752,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlae2( a, b, c, rt1, rt2 ) - !> DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix - !> [ A B ] - !> [ B C ]. - !> On return, RT1 is the eigenvalue of larger absolute value, and RT2 - !> is the eigenvalue of smaller absolute value. + !! DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix + !! [ A B ] + !! [ B C ]. + !! On return, RT1 is the eigenvalue of larger absolute value, and RT2 + !! is the eigenvalue of smaller absolute value. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1816,37 +1816,37 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaebz( ijob, nitmax, n, mmax, minp, nbmin, abstol,reltol, pivmin, d, & - !> DLAEBZ 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. + !! DLAEBZ 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. e, e2, nval, ab, c, mout,nab, work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2087,13 +2087,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaed5( i, d, z, delta, rho, dlam ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2158,9 +2158,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaeda( n, tlvls, curlvl, curpbm, prmptr, perm, givptr,givcol, givnum,& - !> DLAEDA computes the Z vector corresponding to the merge step in the - !> CURLVLth step of the merge process with TLVLS steps for the CURPBMth - !> problem. + !! DLAEDA computes the Z vector corresponding to the merge step in the + !! CURLVLth step of the merge process with TLVLS steps for the CURPBMth + !! problem. q, qptr, z, ztemp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2263,14 +2263,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaev2( a, b, c, rt1, rt2, cs1, sn1 ) - !> DLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix - !> [ A B ] - !> [ B C ]. - !> On return, RT1 is the eigenvalue of larger absolute value, RT2 is the - !> eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right - !> eigenvector for RT1, giving the decomposition - !> [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ] - !> [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ]. + !! DLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix + !! [ A B ] + !! [ B C ]. + !! On return, RT1 is the eigenvalue of larger absolute value, RT2 is the + !! eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right + !! eigenvector for RT1, giving the decomposition + !! [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ] + !! [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ]. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2362,12 +2362,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlag2( a, lda, b, ldb, safmin, scale1, scale2, wr1,wr2, wi ) - !> DLAG2 computes the eigenvalues of a 2 x 2 generalized eigenvalue - !> problem A - w B, with scaling as necessary to avoid over-/underflow. - !> The scaling factor "s" results in a modified eigenvalue equation - !> s A - w B - !> where s is a non-negative scaling factor chosen so that w, w B, - !> and s A do not overflow and, if possible, do not underflow, either. + !! DLAG2 computes the eigenvalues of a 2 x 2 generalized eigenvalue + !! problem A - w B, with scaling as necessary to avoid over-/underflow. + !! The scaling factor "s" results in a modified eigenvalue equation + !! s A - w B + !! where s is a non-negative scaling factor chosen so that w, w B, + !! and s A do not overflow and, if possible, do not underflow, either. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2546,12 +2546,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlag2s( m, n, a, lda, sa, ldsa, info ) - !> DLAG2S converts a DOUBLE PRECISION matrix, SA, to a SINGLE - !> PRECISION matrix, A. - !> RMAX is the overflow for the SINGLE PRECISION arithmetic - !> DLAG2S checks that all the entries of A are between -RMAX and - !> RMAX. If not the conversion is aborted and a flag is raised. - !> This is an auxiliary routine so there is no argument checking. + !! DLAG2S converts a DOUBLE PRECISION matrix, SA, to a SINGLE + !! PRECISION matrix, A. + !! RMAX is the overflow for the SINGLE PRECISION arithmetic + !! DLAG2S checks that all the entries of A are between -RMAX and + !! RMAX. If not the conversion is aborted and a flag is raised. + !! This is an auxiliary routine so there is no argument checking. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2583,11 +2583,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) - !> DLAGTM 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. + !! DLAGTM 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2685,17 +2685,17 @@ module stdlib_linalg_lapack_d pure logical(lk) function stdlib_dlaisnan( din1, din2 ) - !> This routine is not for general use. It exists solely to avoid - !> over-optimization in DISNAN. - !> DLAISNAN 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. + !! This routine is not for general use. It exists solely to avoid + !! over-optimization in DISNAN. + !! DLAISNAN 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2709,7 +2709,7 @@ module stdlib_linalg_lapack_d pure real(dp) function stdlib_dlamch( cmach ) - !> DLAMCH determines double precision machine parameters. + !! DLAMCH determines double precision machine parameters. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2777,9 +2777,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlamrg( n1, n2, a, dtrd1, dtrd2, index ) - !> DLAMRG 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. + !! DLAMRG 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2841,54 +2841,54 @@ module stdlib_linalg_lapack_d pure recursive subroutine stdlib_dlaorhr_col_getrfnp2( m, n, a, lda, d, info ) - !> DLAORHR_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]. - !> DLAORHR_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, DLAORHR_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. + !! DLAORHR_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]. + !! DLAORHR_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, DLAORHR_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2971,12 +2971,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlapmr( forwrd, m, n, x, ldx, k ) - !> DLAPMR 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. + !! DLAPMR 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3039,12 +3039,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlapmt( forwrd, m, n, x, ldx, k ) - !> DLAPMT 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. + !! DLAPMT 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3107,8 +3107,8 @@ module stdlib_linalg_lapack_d pure real(dp) function stdlib_dlapy3( x, y, z ) - !> DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause - !> unnecessary overflow and unnecessary underflow. + !! DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause + !! unnecessary overflow and unnecessary underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3139,9 +3139,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) - !> DLAQGB 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. + !! DLAQGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -3209,8 +3209,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed ) - !> DLAQGE equilibrates a general M by N matrix A using the row and - !> column scaling factors in the vectors R and C. + !! DLAQGE equilibrates a general M by N matrix A using the row and + !! column scaling factors in the vectors R and C. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3275,16 +3275,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaqr1( n, h, ldh, sr1, si1, sr2, si2, v ) - !> Given a 2-by-2 or 3-by-3 matrix H, DLAQR1: sets v to a - !> scalar multiple of the first column of the product - !> (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I) - !> scaling to avoid overflows and most underflows. It - !> is assumed that either - !> 1) sr1 = sr2 and si1 = -si2 - !> or - !> 2) si1 = si2 = 0. - !> This is useful for starting double implicit shift bulges - !> in the QR algorithm. + !! Given a 2-by-2 or 3-by-3 matrix H, DLAQR1: sets v to a + !! scalar multiple of the first column of the product + !! (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I) + !! scaling to avoid overflows and most underflows. It + !! is assumed that either + !! 1) sr1 = sr2 and si1 = -si2 + !! or + !! 2) si1 = si2 = 0. + !! This is useful for starting double implicit shift bulges + !! in the QR algorithm. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3335,8 +3335,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) - !> DLAQSB equilibrates a symmetric band matrix A using the scaling - !> factors in the vector S. + !! DLAQSB equilibrates a symmetric band matrix A using the scaling + !! factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3395,8 +3395,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaqsp( uplo, n, ap, s, scond, amax, equed ) - !> DLAQSP equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. + !! DLAQSP equilibrates a symmetric matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3457,8 +3457,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaqsy( uplo, n, a, lda, s, scond, amax, equed ) - !> DLAQSY equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. + !! DLAQSY equilibrates a symmetric matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3515,11 +3515,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlar2v( n, x, y, z, incx, c, s, incc ) - !> DLAR2V applies a vector of real plane rotations from both sides to - !> a sequence of 2-by-2 real symmetric matrices, defined by the elements - !> of the vectors x, y and z. For i = 1,2,...,n - !> ( x(i) z(i) ) := ( c(i) s(i) ) ( x(i) z(i) ) ( c(i) -s(i) ) - !> ( z(i) y(i) ) ( -s(i) c(i) ) ( z(i) y(i) ) ( s(i) c(i) ) + !! DLAR2V applies a vector of real plane rotations from both sides to + !! a sequence of 2-by-2 real symmetric matrices, defined by the elements + !! of the vectors x, y and z. For i = 1,2,...,n + !! ( x(i) z(i) ) := ( c(i) s(i) ) ( x(i) z(i) ) ( c(i) -s(i) ) + !! ( z(i) y(i) ) ( -s(i) c(i) ) ( z(i) y(i) ) ( s(i) c(i) ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3558,11 +3558,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarf( side, m, n, v, incv, tau, c, ldc, work ) - !> DLARF applies a real elementary reflector H to a real m by n matrix - !> C, from either the left or the right. H is represented in the form - !> H = I - tau * v * v**T - !> where tau is a real scalar and v is a real vector. - !> If tau = 0, then H is taken to be the unit matrix. + !! DLARF applies a real elementary reflector H to a real m by n matrix + !! C, from either the left or the right. H is represented in the form + !! H = I - tau * v * v**T + !! where tau is a real scalar and v is a real vector. + !! If tau = 0, then H is taken to be the unit matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3635,8 +3635,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, ldc, & - !> DLARFB applies a real block reflector H or its transpose H**T to a - !> real m by n matrix C, from either the left or the right. + !! DLARFB applies a real block reflector H or its transpose H**T to a + !! real m by n matrix C, from either the left or the right. work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -3957,13 +3957,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) - !> DLARFB_GETT applies a real Householder block reflector H from the - !> left to a real (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. + !! DLARFB_GETT applies a real Householder block reflector H from the + !! left to a real (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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4094,16 +4094,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarft( direct, storev, n, k, v, ldv, tau, t, ldt ) - !> DLARFT forms the triangular factor T of a real 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**T - !> 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**T * T * V + !! DLARFT forms the triangular factor T of a real 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**T + !! 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**T * T * V ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4221,13 +4221,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarfx( side, m, n, v, tau, c, ldc, work ) - !> DLARFX applies a real elementary reflector H to a real m by n - !> matrix C, from either the left or the right. H is represented in the - !> form - !> H = I - tau * v * v**T - !> where tau is a real scalar and v is a real vector. - !> If tau = 0, then H is taken to be the unit matrix - !> This version uses inline code if H has order < 11. + !! DLARFX applies a real elementary reflector H to a real m by n + !! matrix C, from either the left or the right. H is represented in the + !! form + !! H = I - tau * v * v**T + !! where tau is a real scalar and v is a real vector. + !! If tau = 0, then H is taken to be the unit matrix + !! This version uses inline code if H has order < 11. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4724,12 +4724,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarfy( uplo, n, v, incv, tau, c, ldc, work ) - !> DLARFY applies an elementary reflector, or Householder matrix, H, - !> to an n x n symmetric 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. + !! DLARFY applies an elementary reflector, or Householder matrix, H, + !! to an n x n symmetric 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. ! -- lapack test routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4758,10 +4758,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlargv( n, x, incx, y, incy, c, incc ) - !> DLARGV generates a vector of real plane rotations, determined by - !> elements of the real vectors x and y. For i = 1,2,...,n - !> ( c(i) s(i) ) ( x(i) ) = ( a(i) ) - !> ( -s(i) c(i) ) ( y(i) ) = ( 0 ) + !! DLARGV generates a vector of real plane rotations, determined by + !! elements of the real vectors x and y. For i = 1,2,...,n + !! ( c(i) s(i) ) ( x(i) ) = ( a(i) ) + !! ( -s(i) c(i) ) ( y(i) ) = ( 0 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4812,8 +4812,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarra( n, d, e, e2, spltol, tnrm,nsplit, isplit, info ) - !> Compute the splitting points with threshold SPLTOL. - !> DLARRA sets any "small" off-diagonal elements to zero. + !! Compute the splitting points with threshold SPLTOL. + !! DLARRA sets any "small" off-diagonal elements to zero. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4870,9 +4870,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarrc( jobt, n, vl, vu, d, e, pivmin,eigcnt, lcnt, rcnt, info ) - !> 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'. + !! 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'. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4963,18 +4963,18 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarrd( range, order, n, vl, vu, il, iu, gers,reltol, d, e, e2, & - !> DLARRD 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. + !! DLARRD 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. pivmin, nsplit, isplit,m, w, werr, wl, wu, iblock, indexw,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5434,13 +5434,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarrj( n, d, e2, ifirst, ilast,rtol, offset, w, werr, work, iwork,& - !> Given the initial eigenvalue approximations of T, DLARRJ: - !> 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. + !! Given the initial eigenvalue approximations of T, DLARRJ: + !! 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. pivmin, spdiam, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5612,15 +5612,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarrk( n, iw, gl, gu,d, e2, pivmin, reltol, w, werr, info) - !> DLARRK 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. + !! DLARRK 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5692,9 +5692,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarrr( n, d, e, info ) - !> Perform tests to decide whether the symmetric tridiagonal matrix T - !> warrants expensive computations which guarantee high relative accuracy - !> in the eigenvalues. + !! Perform tests to decide whether the symmetric tridiagonal matrix T + !! warrants expensive computations which guarantee high relative accuracy + !! in the eigenvalues. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5774,30 +5774,28 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlartg( f, g, c, s, r ) - !> ! - !> - !> DLARTG generates a plane rotation so that - !> [ C S ] . [ F ] = [ R ] - !> [ -S C ] [ G ] [ 0 ] - !> where C**2 + S**2 = 1. - !> The mathematical formulas used for C and S are - !> R = sign(F) * sqrt(F**2 + G**2) - !> C = F / R - !> S = G / R - !> Hence C >= 0. 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 version is discontinuous in R at F = 0 but it returns the same - !> C and S as ZLARTG for complex inputs (F,0) and (G,0). - !> This is a more accurate version of the BLAS1 routine DROTG, - !> with the following other differences: - !> F and G are unchanged on return. - !> If G=0, then C=1 and S=0. - !> If F=0 and (G .ne. 0), then C=0 and S=sign(1,G) without doing any - !> floating point operations (saves work in DBDSQR when - !> there are zeros on the diagonal). - !> If F exceeds G in magnitude, C will be positive. - !> Below, wp=>dp stands for double precision from LA_CONSTANTS module. + !! DLARTG generates a plane rotation so that + !! [ C S ] . [ F ] = [ R ] + !! [ -S C ] [ G ] [ 0 ] + !! where C**2 + S**2 = 1. + !! The mathematical formulas used for C and S are + !! R = sign(F) * sqrt(F**2 + G**2) + !! C = F / R + !! S = G / R + !! Hence C >= 0. 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 version is discontinuous in R at F = 0 but it returns the same + !! C and S as ZLARTG for complex inputs (F,0) and (G,0). + !! This is a more accurate version of the BLAS1 routine DROTG, + !! with the following other differences: + !! F and G are unchanged on return. + !! If G=0, then C=1 and S=0. + !! If F=0 and (G .ne. 0), then C=0 and S=sign(1,G) without doing any + !! floating point operations (saves work in DBDSQR when + !! there are zeros on the diagonal). + !! If F exceeds G in magnitude, C will be positive. + !! Below, wp=>dp stands for double precision from LA_CONSTANTS module. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5843,15 +5841,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlartgp( f, g, cs, sn, r ) - !> DLARTGP 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. + !! DLARTGP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5937,14 +5935,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlartgs( x, y, sigma, cs, sn ) - !> DLARTGS 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. + !! DLARTGS 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5993,10 +5991,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlartv( n, x, incx, y, incy, c, s, incc ) - !> DLARTV applies a vector of real plane rotations to elements of the - !> real vectors x and y. For i = 1,2,...,n - !> ( x(i) ) := ( c(i) s(i) ) ( x(i) ) - !> ( y(i) ) ( -s(i) c(i) ) ( y(i) ) + !! DLARTV applies a vector of real plane rotations to elements of the + !! real vectors x and y. For i = 1,2,...,n + !! ( x(i) ) := ( c(i) s(i) ) ( x(i) ) + !! ( y(i) ) ( -s(i) c(i) ) ( y(i) ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6027,9 +6025,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaruv( iseed, n, x ) - !> DLARUV 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. + !! DLARUV 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6229,13 +6227,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarz( side, m, n, l, v, incv, tau, c, ldc, work ) - !> DLARZ applies a real elementary reflector H to a real M-by-N - !> matrix C, from either the left or the right. H is represented in the - !> form - !> H = I - tau * v * v**T - !> where tau is a real scalar and v is a real vector. - !> If tau = 0, then H is taken to be the unit matrix. - !> H is a product of k elementary reflectors as returned by DTZRZF. + !! DLARZ applies a real elementary reflector H to a real M-by-N + !! matrix C, from either the left or the right. H is represented in the + !! form + !! H = I - tau * v * v**T + !! where tau is a real scalar and v is a real vector. + !! If tau = 0, then H is taken to be the unit matrix. + !! H is a product of k elementary reflectors as returned by DTZRZF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6284,9 +6282,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & - !> DLARZB applies a real block reflector H or its transpose H**T to - !> a real distributed M-by-N C from the left or the right. - !> Currently, only STOREV = 'R' and DIRECT = 'B' are supported. + !! DLARZB applies a real block reflector H or its transpose H**T to + !! a real distributed M-by-N C from the left or the right. + !! Currently, only STOREV = 'R' and DIRECT = 'B' are supported. ldc, work, ldwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -6373,18 +6371,18 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) - !> DLARZT forms the triangular factor T of a real 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**T - !> 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**T * T * V - !> Currently, only STOREV = 'R' and DIRECT = 'B' are supported. + !! DLARZT forms the triangular factor T of a real 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**T + !! 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**T * T * V + !! Currently, only STOREV = 'R' and DIRECT = 'B' are supported. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6435,11 +6433,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlas2( f, g, h, ssmin, ssmax ) - !> DLAS2 computes the singular values of the 2-by-2 matrix - !> [ F G ] - !> [ 0 H ]. - !> On return, SSMIN is the smaller singular value and SSMAX is the - !> larger singular value. + !! DLAS2 computes the singular values of the 2-by-2 matrix + !! [ F G ] + !! [ 0 H ]. + !! On return, SSMIN is the smaller singular value and SSMAX is the + !! larger singular value. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6499,14 +6497,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasd5( i, d, z, delta, rho, dsigma, work ) - !> 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. + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6594,8 +6592,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasdt( n, lvl, nd, inode, ndiml, ndimr, msub ) - !> DLASDT creates a tree of subproblems for bidiagonal divide and - !> conquer. + !! DLASDT creates a tree of subproblems for bidiagonal divide and + !! conquer. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6645,8 +6643,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaset( uplo, m, n, alpha, beta, a, lda ) - !> DLASET initializes an m-by-n matrix A to BETA on the diagonal and - !> ALPHA on the offdiagonals. + !! DLASET initializes an m-by-n matrix A to BETA on the diagonal and + !! ALPHA on the offdiagonals. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6695,8 +6693,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasq4( i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn,dn1, dn2, tau, & - !> DLASQ4 computes an approximation TAU to the smallest eigenvalue - !> using values of d from the previous transform. + !! DLASQ4 computes an approximation TAU to the smallest eigenvalue + !! using values of d from the previous transform. ttype, g ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -6903,8 +6901,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasq5( i0, n0, z, pp, tau, sigma, dmin, dmin1, dmin2,dn, dnm1, dnm2, & - !> DLASQ5 computes one dqds transform in ping-pong form, one - !> version for IEEE machines another for non IEEE machines. + !! DLASQ5 computes one dqds transform in ping-pong form, one + !! version for IEEE machines another for non IEEE machines. ieee, eps ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7131,8 +7129,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasq6( i0, n0, z, pp, dmin, dmin1, dmin2, dn,dnm1, dnm2 ) - !> DLASQ6 computes one dqd (shift equal to zero) transform in - !> ping-pong form, with protection against underflow and overflow. + !! DLASQ6 computes one dqd (shift equal to zero) transform in + !! ping-pong form, with protection against underflow and overflow. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7241,57 +7239,57 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasr( side, pivot, direct, m, n, c, s, a, lda ) - !> DLASR applies a sequence of plane rotations to a real 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. + !! DLASR applies a sequence of plane rotations to a real 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7500,10 +7498,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasrt( id, n, d, info ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7674,26 +7672,24 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlassq( n, x, incx, scl, sumsq ) - !> ! - !> - !> DLASSQ 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. + !! DLASSQ 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7791,15 +7787,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasv2( f, g, h, ssmin, ssmax, snr, csr, snl, csl ) - !> DLASV2 computes the singular value decomposition of a 2-by-2 - !> triangular matrix - !> [ F G ] - !> [ 0 H ]. - !> On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the - !> smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and - !> right singular vectors for abs(SSMAX), giving the decomposition - !> [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ] - !> [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ]. + !! DLASV2 computes the singular value decomposition of a 2-by-2 + !! triangular matrix + !! [ F G ] + !! [ 0 H ]. + !! On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the + !! smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and + !! right singular vectors for abs(SSMAX), giving the decomposition + !! [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ] + !! [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ]. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7936,8 +7932,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaswp( n, a, lda, k1, k2, ipiv, incx ) - !> DLASWP performs a series of row interchanges on the matrix A. - !> One row interchange is initiated for each of rows K1 through K2 of A. + !! DLASWP performs a series of row interchanges on the matrix A. + !! One row interchange is initiated for each of rows K1 through K2 of A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8003,10 +7999,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasy2( ltranl, ltranr, isgn, n1, n2, tl, ldtl, tr,ldtr, b, ldb, & - !> DLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in - !> op(TL)*X + ISGN*X*op(TR) = SCALE*B, - !> where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or - !> -1. op(T) = T or T**T, where T**T denotes the transpose of T. + !! DLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in + !! op(TL)*X + ISGN*X*op(TR) = SCALE*B, + !! where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or + !! -1. op(T) = T or T**T, where T**T denotes the transpose of T. scale, x, ldx, xnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8263,18 +8259,18 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) - !> DLASYF computes a partial factorization of a real 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. - !> DLASYF is an auxiliary routine called by DSYTRF. It uses blocked code - !> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or - !> A22 (if UPLO = 'L'). + !! DLASYF computes a partial factorization of a real 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. + !! DLASYF is an auxiliary routine called by DSYTRF. It uses blocked code + !! (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or + !! A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8700,18 +8696,18 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) - !> DLASYF_RK computes a partial factorization of a real 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. - !> DLASYF_RK is an auxiliary routine called by DSYTRF_RK. It uses - !> blocked code (calling Level 3 BLAS) to update the submatrix - !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). + !! DLASYF_RK computes a partial factorization of a real 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. + !! DLASYF_RK is an auxiliary routine called by DSYTRF_RK. It uses + !! blocked code (calling Level 3 BLAS) to update the submatrix + !! A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9141,18 +9137,18 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) - !> DLASYF_ROOK computes a partial factorization of a real 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. - !> DLASYF_ROOK is an auxiliary routine called by DSYTRF_ROOK. It uses - !> blocked code (calling Level 3 BLAS) to update the submatrix - !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). + !! DLASYF_ROOK computes a partial factorization of a real 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. + !! DLASYF_ROOK is an auxiliary routine called by DSYTRF_ROOK. It uses + !! blocked code (calling Level 3 BLAS) to update the submatrix + !! A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9602,12 +9598,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlat2s( uplo, n, a, lda, sa, ldsa, info ) - !> DLAT2S converts a DOUBLE PRECISION triangular matrix, SA, to a SINGLE - !> PRECISION triangular matrix, A. - !> RMAX is the overflow for the SINGLE PRECISION arithmetic - !> DLAS2S checks that all the entries of A are between -RMAX and - !> RMAX. If not the conversion is aborted and a flag is raised. - !> This is an auxiliary routine so there is no argument checking. + !! DLAT2S converts a DOUBLE PRECISION triangular matrix, SA, to a SINGLE + !! PRECISION triangular matrix, A. + !! RMAX is the overflow for the SINGLE PRECISION arithmetic + !! DLAS2S checks that all the entries of A are between -RMAX and + !! RMAX. If not the conversion is aborted and a flag is raised. + !! This is an auxiliary routine so there is no argument checking. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9653,16 +9649,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & - !> DLATBS solves one of the triangular systems - !> A *x = s*b or A**T*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 DTBSV 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. + !! DLATBS solves one of the triangular systems + !! A *x = s*b or A**T*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 DTBSV 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. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10073,16 +10069,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) - !> DLATPS solves one of the triangular systems - !> A *x = s*b or A**T*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, 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 - !> DTPSV 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. + !! DLATPS solves one of the triangular systems + !! A *x = s*b or A**T*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, 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 + !! DTPSV 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10491,16 +10487,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) - !> DLATRS solves one of the triangular systems - !> A *x = s*b or A**T *x = s*b - !> with scaling to prevent overflow. Here A is an upper or lower - !> triangular matrix, 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 DTRSV 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. + !! DLATRS solves one of the triangular systems + !! A *x = s*b or A**T *x = s*b + !! with scaling to prevent overflow. Here A is an upper or lower + !! triangular matrix, 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 DTRSV 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10892,14 +10888,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlauu2( uplo, n, a, lda, info ) - !> DLAUU2 computes the product U * U**T or L**T * L, where the triangular - !> factor U or L is stored in the upper or lower triangular part of - !> the array A. - !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, - !> overwriting the factor U in A. - !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, - !> overwriting the factor L in A. - !> This is the unblocked form of the algorithm, calling Level 2 BLAS. + !! DLAUU2 computes the product U * U**T or L**T * L, where the triangular + !! factor U or L is stored in the upper or lower triangular part of + !! the array A. + !! If UPLO = 'U' or 'u' then the upper triangle of the result is stored, + !! overwriting the factor U in A. + !! If UPLO = 'L' or 'l' then the lower triangle of the result is stored, + !! overwriting the factor L in A. + !! This is the unblocked form of the algorithm, calling Level 2 BLAS. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10964,14 +10960,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlauum( uplo, n, a, lda, info ) - !> DLAUUM computes the product U * U**T or L**T * L, where the triangular - !> factor U or L is stored in the upper or lower triangular part of - !> the array A. - !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, - !> overwriting the factor U in A. - !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, - !> overwriting the factor L in A. - !> This is the blocked form of the algorithm, calling Level 3 BLAS. + !! DLAUUM computes the product U * U**T or L**T * L, where the triangular + !! factor U or L is stored in the upper or lower triangular part of + !! the array A. + !! If UPLO = 'U' or 'u' then the upper triangle of the result is stored, + !! overwriting the factor U in A. + !! If UPLO = 'L' or 'l' then the lower triangle of the result is stored, + !! overwriting the factor L in A. + !! This is the blocked form of the algorithm, calling Level 3 BLAS. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11047,15 +11043,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & - !> DORBDB6 orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then the zero vector is returned. + !! DORBDB6 orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then the zero vector is returned. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -11175,11 +11171,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorg2l( m, n, k, a, lda, tau, work, info ) - !> DORG2L generates an m by n real matrix Q with orthonormal columns, - !> which is defined as the last n columns of a product of k elementary - !> reflectors of order m - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGEQLF. + !! DORG2L generates an m by n real matrix Q with orthonormal columns, + !! which is defined as the last n columns of a product of k elementary + !! reflectors of order m + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGEQLF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11239,11 +11235,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorg2r( m, n, k, a, lda, tau, work, info ) - !> DORG2R generates an m by n real matrix Q with orthonormal columns, - !> which is defined as the first n columns of a product of k elementary - !> reflectors of order m - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGEQRF. + !! DORG2R generates an m by n real matrix Q with orthonormal columns, + !! which is defined as the first n columns of a product of k elementary + !! reflectors of order m + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGEQRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11304,11 +11300,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorgl2( m, n, k, a, lda, tau, work, info ) - !> DORGL2 generates an m by n real matrix Q with orthonormal rows, - !> which is defined as the first m rows of a product of k elementary - !> reflectors of order n - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGELQF. + !! DORGL2 generates an m by n real matrix Q with orthonormal rows, + !! which is defined as the first m rows of a product of k elementary + !! reflectors of order n + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGELQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11373,11 +11369,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorglq( m, n, k, a, lda, tau, work, lwork, info ) - !> DORGLQ generates an M-by-N real matrix Q with orthonormal rows, - !> which is defined as the first M rows of a product of K elementary - !> reflectors of order N - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGELQF. + !! DORGLQ generates an M-by-N real matrix Q with orthonormal rows, + !! which is defined as the first M rows of a product of K elementary + !! reflectors of order N + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGELQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11489,11 +11485,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorgql( m, n, k, a, lda, tau, work, lwork, info ) - !> DORGQL generates an M-by-N real matrix Q with orthonormal columns, - !> which is defined as the last N columns of a product of K elementary - !> reflectors of order M - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGEQLF. + !! DORGQL generates an M-by-N real matrix Q with orthonormal columns, + !! which is defined as the last N columns of a product of K elementary + !! reflectors of order M + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGEQLF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11610,11 +11606,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorgqr( m, n, k, a, lda, tau, work, lwork, info ) - !> DORGQR generates an M-by-N real matrix Q with orthonormal columns, - !> which is defined as the first N columns of a product of K elementary - !> reflectors of order M - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGEQRF. + !! DORGQR generates an M-by-N real matrix Q with orthonormal columns, + !! which is defined as the first N columns of a product of K elementary + !! reflectors of order M + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGEQRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11726,11 +11722,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorgr2( m, n, k, a, lda, tau, work, info ) - !> DORGR2 generates an m by n real matrix Q with orthonormal rows, - !> which is defined as the last m rows of a product of k elementary - !> reflectors of order n - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGERQF. + !! DORGR2 generates an m by n real matrix Q with orthonormal rows, + !! which is defined as the last m rows of a product of k elementary + !! reflectors of order n + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGERQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11792,11 +11788,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorgrq( m, n, k, a, lda, tau, work, lwork, info ) - !> DORGRQ generates an M-by-N real matrix Q with orthonormal rows, - !> which is defined as the last M rows of a product of K elementary - !> reflectors of order N - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGERQF. + !! DORGRQ generates an M-by-N real matrix Q with orthonormal rows, + !! which is defined as the last M rows of a product of K elementary + !! reflectors of order N + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGERQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11913,21 +11909,21 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorgtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) - !> DORGTSQR_ROW generates an M-by-N real matrix Q_out with - !> orthonormal columns from the output of DLATSQR. These N orthonormal - !> columns are the first N columns of a product of complex unitary - !> matrices Q(k)_in of order M, which are returned by DLATSQR in - !> a special format. - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> The input matrices Q(k)_in are stored in row and column blocks in A. - !> See the documentation of DLATSQR for more details on the format of - !> Q(k)_in, where each Q(k)_in is represented by block Householder - !> transformations. This routine calls an auxiliary routine DLARFB_GETT, - !> where the computation is performed on each individual block. The - !> algorithm first sweeps NB-sized column blocks from the right to left - !> starting in the bottom row block and continues to the top row block - !> (hence _ROW in the routine name). This sweep is in reverse order of - !> the order in which DLATSQR generates the output blocks. + !! DORGTSQR_ROW generates an M-by-N real matrix Q_out with + !! orthonormal columns from the output of DLATSQR. These N orthonormal + !! columns are the first N columns of a product of complex unitary + !! matrices Q(k)_in of order M, which are returned by DLATSQR in + !! a special format. + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! The input matrices Q(k)_in are stored in row and column blocks in A. + !! See the documentation of DLATSQR for more details on the format of + !! Q(k)_in, where each Q(k)_in is represented by block Householder + !! transformations. This routine calls an auxiliary routine DLARFB_GETT, + !! where the computation is performed on each individual block. The + !! algorithm first sweeps NB-sized column blocks from the right to left + !! starting in the bottom row block and continues to the top row block + !! (hence _ROW in the routine name). This sweep is in reverse order of + !! the order in which DLATSQR generates the output blocks. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12238,16 +12234,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> DORM2L overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T * C if SIDE = 'L' and TRANS = 'T', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'T', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGEQLF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! DORM2L overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T * C if SIDE = 'L' and TRANS = 'T', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'T', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGEQLF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12332,16 +12328,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> DORM2R overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T* C if SIDE = 'L' and TRANS = 'T', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'T', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! DORM2R overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T* C if SIDE = 'L' and TRANS = 'T', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'T', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12431,16 +12427,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> DORML2 overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T* C if SIDE = 'L' and TRANS = 'T', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'T', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! DORML2 overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T* C if SIDE = 'L' and TRANS = 'T', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'T', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12530,15 +12526,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dormlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> DORMLQ overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! DORMLQ overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12673,15 +12669,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dormql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> DORMQL overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! DORMQL overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12810,15 +12806,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dormqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> DORMQR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! DORMQR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12947,16 +12943,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dormr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> DORMR2 overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T* C if SIDE = 'L' and TRANS = 'T', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'T', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGERQF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! DORMR2 overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T* C if SIDE = 'L' and TRANS = 'T', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'T', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGERQF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13041,16 +13037,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dormr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) - !> DORMR3 overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'C', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DTZRZF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! DORMR3 overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'C', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DTZRZF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13140,15 +13136,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dormrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> DORMRQ overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGERQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! DORMRQ overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGERQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13283,15 +13279,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dormrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & - !> DORMRZ overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DTZRZF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! DORMRZ overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DTZRZF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13436,14 +13432,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) - !> DPBEQU computes row and column scalings intended to equilibrate a - !> symmetric positive definite band matrix A and reduce its condition - !> number (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. + !! DPBEQU computes row and column scalings intended to equilibrate a + !! symmetric positive definite band matrix A and reduce its condition + !! number (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13523,15 +13519,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpbstf( uplo, n, kd, ab, ldab, info ) - !> DPBSTF computes a split Cholesky factorization of a real - !> symmetric positive definite band matrix A. - !> This routine is designed to be used in conjunction with DSBGST. - !> The factorization has the form A = S**T*S where S is a band matrix - !> of the same bandwidth as A and the following structure: - !> S = ( U ) - !> ( M L ) - !> where U is upper triangular of order m = (n+kd)/2, and L is lower - !> triangular of order n-m. + !! DPBSTF computes a split Cholesky factorization of a real + !! symmetric positive definite band matrix A. + !! This routine is designed to be used in conjunction with DSBGST. + !! The factorization has the form A = S**T*S where S is a band matrix + !! of the same bandwidth as A and the following structure: + !! S = ( U ) + !! ( M L ) + !! where U is upper triangular of order m = (n+kd)/2, and L is lower + !! triangular of order n-m. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13641,14 +13637,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpbtf2( uplo, n, kd, ab, ldab, info ) - !> DPBTF2 computes the Cholesky factorization of a real symmetric - !> positive definite band matrix A. - !> The factorization has the form - !> A = U**T * U , if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix, U**T is the transpose of U, and - !> L is lower triangular. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! DPBTF2 computes the Cholesky factorization of a real symmetric + !! positive definite band matrix A. + !! The factorization has the form + !! A = U**T * U , if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix, U**T is the transpose of U, and + !! L is lower triangular. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13728,9 +13724,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) - !> DPBTRS solves a system of linear equations A*X = B with a symmetric - !> positive definite band matrix A using the Cholesky factorization - !> A = U**T*U or A = L*L**T computed by DPBTRF. + !! DPBTRS solves a system of linear equations A*X = B with a symmetric + !! positive definite band matrix A using the Cholesky factorization + !! A = U**T*U or A = L*L**T computed by DPBTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13796,14 +13792,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpoequ( n, a, lda, s, scond, amax, info ) - !> DPOEQU computes row and column scalings intended to equilibrate a - !> symmetric positive definite matrix A and reduce its condition number - !> (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. + !! DPOEQU computes row and column scalings intended to equilibrate a + !! symmetric positive definite matrix A and reduce its condition number + !! (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13870,19 +13866,19 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpoequb( n, a, lda, s, scond, amax, info ) - !> DPOEQUB computes row and column scalings intended to equilibrate a - !> symmetric positive definite matrix A and reduce its condition number - !> (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. - !> This routine differs from DPOEQU 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 diagonal entries are no longer approximately 1 but lie - !> between sqrt(radix) and 1/sqrt(radix). + !! DPOEQUB computes row and column scalings intended to equilibrate a + !! symmetric positive definite matrix A and reduce its condition number + !! (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. + !! This routine differs from DPOEQU 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 diagonal entries are no longer approximately 1 but lie + !! between sqrt(radix) and 1/sqrt(radix). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13952,9 +13948,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpotrs( uplo, n, nrhs, a, lda, b, ldb, info ) - !> DPOTRS solves a system of linear equations A*X = B with a symmetric - !> positive definite matrix A using the Cholesky factorization - !> A = U**T*U or A = L*L**T computed by DPOTRF. + !! DPOTRS solves a system of linear equations A*X = B with a symmetric + !! positive definite matrix A using the Cholesky factorization + !! A = U**T*U or A = L*L**T computed by DPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14014,14 +14010,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dppequ( uplo, n, ap, s, scond, amax, info ) - !> DPPEQU computes row and column scalings intended to equilibrate a - !> symmetric positive definite matrix A in packed storage and reduce - !> its condition number (with respect to the two-norm). S contains the - !> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix - !> B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal. - !> This choice of S puts the condition number of B within a factor N of - !> the smallest possible condition number over all possible diagonal - !> scalings. + !! DPPEQU computes row and column scalings intended to equilibrate a + !! symmetric positive definite matrix A in packed storage and reduce + !! its condition number (with respect to the two-norm). S contains the + !! scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix + !! B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal. + !! This choice of S puts the condition number of B within a factor N of + !! the smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14107,12 +14103,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpptrf( uplo, n, ap, info ) - !> DPPTRF computes the Cholesky factorization of a real symmetric - !> positive definite matrix A stored in packed format. - !> The factorization has the form - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. + !! DPPTRF computes the Cholesky factorization of a real symmetric + !! positive definite matrix A stored in packed format. + !! The factorization has the form + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14192,9 +14188,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpptrs( uplo, n, nrhs, ap, b, ldb, info ) - !> DPPTRS solves a system of linear equations A*X = B with a symmetric - !> positive definite matrix A in packed storage using the Cholesky - !> factorization A = U**T*U or A = L*L**T computed by DPPTRF. + !! DPPTRS solves a system of linear equations A*X = B with a symmetric + !! positive definite matrix A in packed storage using the Cholesky + !! factorization A = U**T*U or A = L*L**T computed by DPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14254,13 +14250,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dptcon( n, d, e, anorm, rcond, work, info ) - !> DPTCON computes the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric positive definite tridiagonal matrix - !> using the factorization A = L*D*L**T or A = U**T*D*U computed by - !> DPTTRF. - !> Norm(inv(A)) is computed by a direct method, and the reciprocal of - !> the condition number is computed as - !> RCOND = 1 / (ANORM * norm(inv(A))). + !! DPTCON computes the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric positive definite tridiagonal matrix + !! using the factorization A = L*D*L**T or A = U**T*D*U computed by + !! DPTTRF. + !! Norm(inv(A)) is computed by a direct method, and the reciprocal of + !! the condition number is computed as + !! RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14327,9 +14323,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpttrf( n, d, e, info ) - !> DPTTRF computes the L*D*L**T factorization of a real symmetric - !> positive definite tridiagonal matrix A. The factorization may also - !> be regarded as having the form A = U**T*D*U. + !! DPTTRF computes the L*D*L**T factorization of a real symmetric + !! positive definite tridiagonal matrix A. The factorization may also + !! be regarded as having the form A = U**T*D*U. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14410,12 +14406,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dptts2( n, nrhs, d, e, b, ldb ) - !> DPTTS2 solves a tridiagonal system of the form - !> A * X = B - !> using the L*D*L**T factorization of A computed by DPTTRF. D is a - !> diagonal matrix specified in the vector D, L is a unit bidiagonal - !> matrix whose subdiagonal is specified in the vector E, and X and B - !> are N by NRHS matrices. + !! DPTTS2 solves a tridiagonal system of the form + !! A * X = B + !! using the L*D*L**T factorization of A computed by DPTTRF. D is a + !! diagonal matrix specified in the vector D, L is a unit bidiagonal + !! matrix whose subdiagonal is specified in the vector E, and X and B + !! are N by NRHS matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14451,9 +14447,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_drscl( n, sa, sx, incx ) - !> DRSCL multiplies an n-element real vector x by the real scalar 1/a. - !> This is done without overflow or underflow as long as - !> the final result x/a does not overflow or underflow. + !! DRSCL multiplies an n-element real vector x by the real scalar 1/a. + !! This is done without overflow or underflow as long as + !! the final result x/a does not overflow or underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14505,13 +14501,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, info ) - !> DSBGST reduces a real symmetric-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**T*S by DPBSTF, using a - !> split Cholesky factorization. A is overwritten by C = X**T*A*X, where - !> X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the - !> bandwidth of A. + !! DSBGST reduces a real symmetric-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**T*S by DPBSTF, using a + !! split Cholesky factorization. A is overwritten by C = X**T*A*X, where + !! X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the + !! bandwidth of A. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15418,9 +15414,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) - !> DSBTRD reduces a real symmetric band matrix A to symmetric - !> tridiagonal form T by an orthogonal similarity transformation: - !> Q**T * A * Q = T. + !! DSBTRD reduces a real symmetric band matrix A to symmetric + !! tridiagonal form T by an orthogonal similarity transformation: + !! Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15749,14 +15745,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) - !> Level 3 BLAS like routine for C in RFP Format. - !> DSFRK performs one of the symmetric rank--k operations - !> C := alpha*A*A**T + beta*C, - !> or - !> C := alpha*A**T*A + beta*C, - !> where alpha and beta are real scalars, C is an n--by--n symmetric - !> matrix and A is an n--by--k matrix in the first case and a k--by--n - !> matrix in the second case. + !! Level 3 BLAS like routine for C in RFP Format. + !! DSFRK performs one of the symmetric rank--k operations + !! C := alpha*A*A**T + beta*C, + !! or + !! C := alpha*A**T*A + beta*C, + !! where alpha and beta are real scalars, C is an n--by--n symmetric + !! matrix and A is an n--by--k matrix in the first case and a k--by--n + !! matrix in the second case. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16005,13 +16001,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dspgst( itype, uplo, n, ap, bp, info ) - !> DSPGST reduces a real symmetric-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**T)*A*inv(U) or inv(L)*A*inv(L**T) - !> 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**T or L**T*A*L. - !> B must have been previously factorized as U**T*U or L*L**T by DPPTRF. + !! DSPGST reduces a real symmetric-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**T)*A*inv(U) or inv(L)*A*inv(L**T) + !! 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**T or L**T*A*L. + !! B must have been previously factorized as U**T*U or L*L**T by DPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16127,12 +16123,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsptrf( uplo, n, ap, ipiv, info ) - !> DSPTRF computes the factorization of a real symmetric matrix A stored - !> in packed format using the Bunch-Kaufman diagonal pivoting method: - !> 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 symmetric and block diagonal with - !> 1-by-1 and 2-by-2 diagonal blocks. + !! DSPTRF computes the factorization of a real symmetric matrix A stored + !! in packed format using the Bunch-Kaufman diagonal pivoting method: + !! 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 symmetric and block diagonal with + !! 1-by-1 and 2-by-2 diagonal blocks. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16450,9 +16446,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsptri( uplo, n, ap, ipiv, work, info ) - !> DSPTRI computes the inverse of a real symmetric indefinite matrix - !> A in packed storage using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by DSPTRF. + !! DSPTRI computes the inverse of a real symmetric indefinite matrix + !! A in packed storage using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by DSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16661,9 +16657,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> DSPTRS solves a system of linear equations A*X = B with a real - !> symmetric matrix A stored in packed format using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by DSPTRF. + !! DSPTRS solves a system of linear equations A*X = B with a real + !! symmetric matrix A stored in packed format using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by DSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16881,16 +16877,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dstebz( range, order, n, vl, vu, il, iu, abstol, d, e,m, nsplit, w, & - !> DSTEBZ computes the eigenvalues of a symmetric tridiagonal - !> matrix T. 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. + !! DSTEBZ computes the eigenvalues of a symmetric tridiagonal + !! matrix T. 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. iblock, isplit, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17274,9 +17270,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsyconv( uplo, way, n, a, lda, ipiv, e, info ) - !> DSYCONV convert A given by TRF into L and D and vice-versa. - !> Get Non-diag elements of D (returned in workspace) and - !> apply or reverse permutation done in TRF. + !! DSYCONV convert A given by TRF into L and D and vice-versa. + !! Get Non-diag elements of D (returned in workspace) and + !! apply or reverse permutation done in TRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17479,21 +17475,21 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsyconvf( uplo, way, n, a, lda, e, ipiv, info ) - !> If parameter WAY = 'C': - !> DSYCONVF converts the factorization output format used in - !> DSYTRF provided on entry in parameter A into the factorization - !> output format used in DSYTRF_RK (or DSYTRF_BK) that is stored - !> on exit in parameters A and E. It also converts in place details of - !> the intechanges stored in IPIV from the format used in DSYTRF into - !> the format used in DSYTRF_RK (or DSYTRF_BK). - !> If parameter WAY = 'R': - !> DSYCONVF performs the conversion in reverse direction, i.e. - !> converts the factorization output format used in DSYTRF_RK - !> (or DSYTRF_BK) provided on entry in parameters A and E into - !> the factorization output format used in DSYTRF that is stored - !> on exit in parameter A. It also converts in place details of - !> the intechanges stored in IPIV from the format used in DSYTRF_RK - !> (or DSYTRF_BK) into the format used in DSYTRF. + !! If parameter WAY = 'C': + !! DSYCONVF converts the factorization output format used in + !! DSYTRF provided on entry in parameter A into the factorization + !! output format used in DSYTRF_RK (or DSYTRF_BK) that is stored + !! on exit in parameters A and E. It also converts in place details of + !! the intechanges stored in IPIV from the format used in DSYTRF into + !! the format used in DSYTRF_RK (or DSYTRF_BK). + !! If parameter WAY = 'R': + !! DSYCONVF performs the conversion in reverse direction, i.e. + !! converts the factorization output format used in DSYTRF_RK + !! (or DSYTRF_BK) provided on entry in parameters A and E into + !! the factorization output format used in DSYTRF that is stored + !! on exit in parameter A. It also converts in place details of + !! the intechanges stored in IPIV from the format used in DSYTRF_RK + !! (or DSYTRF_BK) into the format used in DSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17734,19 +17730,19 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) - !> If parameter WAY = 'C': - !> DSYCONVF_ROOK converts the factorization output format used in - !> DSYTRF_ROOK provided on entry in parameter A into the factorization - !> output format used in DSYTRF_RK (or DSYTRF_BK) that is stored - !> on exit in parameters A and E. IPIV format for DSYTRF_ROOK and - !> DSYTRF_RK (or DSYTRF_BK) is the same and is not converted. - !> If parameter WAY = 'R': - !> DSYCONVF_ROOK performs the conversion in reverse direction, i.e. - !> converts the factorization output format used in DSYTRF_RK - !> (or DSYTRF_BK) provided on entry in parameters A and E into - !> the factorization output format used in DSYTRF_ROOK that is stored - !> on exit in parameter A. IPIV format for DSYTRF_ROOK and - !> DSYTRF_RK (or DSYTRF_BK) is the same and is not converted. + !! If parameter WAY = 'C': + !! DSYCONVF_ROOK converts the factorization output format used in + !! DSYTRF_ROOK provided on entry in parameter A into the factorization + !! output format used in DSYTRF_RK (or DSYTRF_BK) that is stored + !! on exit in parameters A and E. IPIV format for DSYTRF_ROOK and + !! DSYTRF_RK (or DSYTRF_BK) is the same and is not converted. + !! If parameter WAY = 'R': + !! DSYCONVF_ROOK performs the conversion in reverse direction, i.e. + !! converts the factorization output format used in DSYTRF_RK + !! (or DSYTRF_BK) provided on entry in parameters A and E into + !! the factorization output format used in DSYTRF_ROOK that is stored + !! on exit in parameter A. IPIV format for DSYTRF_ROOK and + !! DSYTRF_RK (or DSYTRF_BK) is the same and is not converted. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17987,13 +17983,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsyequb( uplo, n, a, lda, s, scond, amax, work, info ) - !> DSYEQUB computes row and column scalings intended to equilibrate a - !> symmetric 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. + !! DSYEQUB computes row and column scalings intended to equilibrate a + !! symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18163,13 +18159,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsygs2( itype, uplo, n, a, lda, b, ldb, info ) - !> DSYGS2 reduces a real symmetric-definite generalized eigenproblem - !> to standard form. - !> If ITYPE = 1, the problem is A*x = lambda*B*x, - !> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) - !> 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**T or L**T *A*L. - !> B must have been previously factorized as U**T *U or L*L**T by DPOTRF. + !! DSYGS2 reduces a real symmetric-definite generalized eigenproblem + !! to standard form. + !! If ITYPE = 1, the problem is A*x = lambda*B*x, + !! and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) + !! 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**T or L**T *A*L. + !! B must have been previously factorized as U**T *U or L*L**T by DPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18286,13 +18282,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsygst( itype, uplo, n, a, lda, b, ldb, info ) - !> DSYGST reduces a real symmetric-definite generalized eigenproblem - !> to standard form. - !> If ITYPE = 1, the problem is A*x = lambda*B*x, - !> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) - !> 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**T or L**T*A*L. - !> B must have been previously factorized as U**T*U or L*L**T by DPOTRF. + !! DSYGST reduces a real symmetric-definite generalized eigenproblem + !! to standard form. + !! If ITYPE = 1, the problem is A*x = lambda*B*x, + !! and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) + !! 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**T or L**T*A*L. + !! B must have been previously factorized as U**T*U or L*L**T by DPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18425,8 +18421,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsyswapr( uplo, n, a, lda, i1, i2) - !> DSYSWAPR applies an elementary permutation on the rows and the columns of - !> a symmetric matrix. + !! DSYSWAPR applies an elementary permutation on the rows and the columns of + !! a symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18493,15 +18489,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytf2_rk( uplo, n, a, lda, e, ipiv, info ) - !> DSYTF2_RK computes the factorization of a real symmetric matrix A - !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric 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. + !! DSYTF2_RK computes the factorization of a real symmetric matrix A + !! using the bounded Bunch-Kaufman (rook) diagonal pivoting method: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18945,13 +18941,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytf2_rook( uplo, n, a, lda, ipiv, info ) - !> DSYTF2_ROOK computes the factorization of a real symmetric matrix A - !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: - !> 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, U**T is the transpose of U, and D is symmetric 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. + !! DSYTF2_ROOK computes the factorization of a real symmetric matrix A + !! using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: + !! 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, U**T is the transpose of U, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19356,15 +19352,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) - !> DSYTRF_RK computes the factorization of a real symmetric matrix A - !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric 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. + !! DSYTRF_RK computes the factorization of a real symmetric matrix A + !! using the bounded Bunch-Kaufman (rook) diagonal pivoting method: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19522,14 +19518,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) - !> DSYTRF_ROOK computes the factorization of a real symmetric 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 symmetric 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. + !! DSYTRF_ROOK computes the factorization of a real symmetric 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 symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19650,9 +19646,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytri( uplo, n, a, lda, ipiv, work, info ) - !> DSYTRI computes the inverse of a real symmetric indefinite matrix - !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by - !> DSYTRF. + !! DSYTRI computes the inverse of a real symmetric indefinite matrix + !! A using the factorization A = U*D*U**T or A = L*D*L**T computed by + !! DSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19838,9 +19834,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytri_rook( uplo, n, a, lda, ipiv, work, info ) - !> DSYTRI_ROOK computes the inverse of a real symmetric - !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T - !> computed by DSYTRF_ROOK. + !! DSYTRI_ROOK computes the inverse of a real symmetric + !! matrix A using the factorization A = U*D*U**T or A = L*D*L**T + !! computed by DSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20066,9 +20062,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) - !> DSYTRS solves a system of linear equations A*X = B with a real - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by DSYTRF. + !! DSYTRS solves a system of linear equations A*X = B with a real + !! symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by DSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20276,9 +20272,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) - !> DSYTRS2 solves a system of linear equations A*X = B with a real - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by DSYTRF and converted by DSYCONV. + !! DSYTRS2 solves a system of linear equations A*X = B with a real + !! symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by DSYTRF and converted by DSYCONV. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20454,15 +20450,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) - !> DSYTRS_3 solves a system of linear equations A * X = B with a real - !> symmetric matrix A using the factorization computed - !> by DSYTRF_RK or DSYTRF_BK: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric and block - !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. - !> This algorithm is using Level 3 BLAS. + !! DSYTRS_3 solves a system of linear equations A * X = B with a real + !! symmetric matrix A using the factorization computed + !! by DSYTRF_RK or DSYTRF_BK: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric and block + !! diagonal with 1-by-1 and 2-by-2 diagonal blocks. + !! This algorithm is using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20611,9 +20607,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) - !> DSYTRS_AA solves a system of linear equations A*X = B with a real - !> symmetric matrix A using the factorization A = U**T*T*U or - !> A = L*T*L**T computed by DSYTRF_AA. + !! DSYTRS_AA solves a system of linear equations A*X = B with a real + !! symmetric matrix A using the factorization A = U**T*T*U or + !! A = L*T*L**T computed by DSYTRF_AA. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20730,9 +20726,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) - !> DSYTRS_ROOK solves a system of linear equations A*X = B with - !> a real symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by DSYTRF_ROOK. + !! DSYTRS_ROOK solves a system of linear equations A*X = B with + !! a real symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by DSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20952,12 +20948,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& - !> DTBRFS provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular band - !> coefficient matrix. - !> The solution matrix X must be computed by DTBTRS or some other - !> means before entering this routine. DTBRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! DTBRFS provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular band + !! coefficient matrix. + !! The solution matrix X must be computed by DTBTRS or some other + !! means before entering this routine. DTBRFS does not do iterative + !! refinement because doing so cannot improve the backward error. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21190,10 +21186,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) - !> DTBTRS solves a triangular system of the form - !> A * X = B or A**T * X = B, - !> where A is a triangular band matrix of order N, and B is an - !> N-by NRHS matrix. A check is made to verify that A is nonsingular. + !! DTBTRS solves a triangular system of the form + !! A * X = B or A**T * X = B, + !! where A is a triangular band matrix of order N, and B is an + !! N-by NRHS matrix. A check is made to verify that A is nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21263,14 +21259,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) - !> Level 3 BLAS like routine for A in RFP Format. - !> DTFSM solves the matrix equation - !> op( A )*X = alpha*B or X*op( A ) = alpha*B - !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T. - !> A is in Rectangular Full Packed (RFP) Format. - !> The matrix X is overwritten on B. + !! Level 3 BLAS like routine for A in RFP Format. + !! DTFSM solves the matrix equation + !! op( A )*X = alpha*B or X*op( A ) = alpha*B + !! where alpha is a scalar, X and B are m by n matrices, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T. + !! A is in Rectangular Full Packed (RFP) Format. + !! The matrix X is overwritten on B. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21765,8 +21761,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtfttp( transr, uplo, n, arf, ap, info ) - !> DTFTTP copies a triangular matrix A from rectangular full packed - !> format (TF) to standard packed format (TP). + !! DTFTTP copies a triangular matrix A from rectangular full packed + !! format (TF) to standard packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22021,8 +22017,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtfttr( transr, uplo, n, arf, a, lda, info ) - !> DTFTTR copies a triangular matrix A from rectangular full packed - !> format (TF) to standard full format (TR). + !! DTFTTR copies a triangular matrix A from rectangular full packed + !! format (TF) to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22250,9 +22246,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & - !> DTPRFB applies a real "triangular-pentagonal" block reflector H or its - !> transpose H**T to a real matrix C, which is composed of two - !> blocks A and B, either from the left or right. + !! DTPRFB applies a real "triangular-pentagonal" block reflector H or its + !! transpose H**T to a real matrix C, which is composed of two + !! blocks A and B, either from the left or right. lda, b, ldb, work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22668,12 +22664,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & - !> DTPRFS provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular packed - !> coefficient matrix. - !> The solution matrix X must be computed by DTPTRS or some other - !> means before entering this routine. DTPRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! DTPRFS provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular packed + !! coefficient matrix. + !! The solution matrix X must be computed by DTPTRS or some other + !! means before entering this routine. DTPRFS does not do iterative + !! refinement because doing so cannot improve the backward error. work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22913,8 +22909,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtptri( uplo, diag, n, ap, info ) - !> DTPTRI computes the inverse of a real upper or lower triangular - !> matrix A stored in packed format. + !! DTPTRI computes the inverse of a real upper or lower triangular + !! matrix A stored in packed format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23003,11 +22999,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) - !> DTPTRS solves a triangular system of the form - !> A * X = B or A**T * X = B, - !> where A is a triangular matrix of order N stored in packed format, - !> and B is an N-by-NRHS matrix. A check is made to verify that A is - !> nonsingular. + !! DTPTRS solves a triangular system of the form + !! A * X = B or A**T * X = B, + !! where A is a triangular matrix of order N stored in packed format, + !! and B is an N-by-NRHS matrix. A check is made to verify that A is + !! nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23076,8 +23072,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtpttf( transr, uplo, n, ap, arf, info ) - !> DTPTTF copies a triangular matrix A from standard packed format (TP) - !> to rectangular full packed format (TF). + !! DTPTTF copies a triangular matrix A from standard packed format (TP) + !! to rectangular full packed format (TF). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23318,8 +23314,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtpttr( uplo, n, ap, a, lda, info ) - !> DTPTTR copies a triangular matrix A from standard packed format (TP) - !> to standard full format (TR). + !! DTPTTR copies a triangular matrix A from standard packed format (TP) + !! to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23372,12 +23368,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& - !> DTRRFS provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular - !> coefficient matrix. - !> The solution matrix X must be computed by DTRTRS or some other - !> means before entering this routine. DTRRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! DTRRFS provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular + !! coefficient matrix. + !! The solution matrix X must be computed by DTRTRS or some other + !! means before entering this routine. DTRRFS does not do iterative + !! refinement because doing so cannot improve the backward error. work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23607,9 +23603,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtrti2( uplo, diag, n, a, lda, info ) - !> DTRTI2 computes the inverse of a real upper or lower triangular - !> matrix. - !> This is the Level 2 BLAS version of the algorithm. + !! DTRTI2 computes the inverse of a real upper or lower triangular + !! matrix. + !! This is the Level 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23681,9 +23677,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtrtri( uplo, diag, n, a, lda, info ) - !> DTRTRI computes the inverse of a real upper or lower triangular - !> matrix A. - !> This is the Level 3 BLAS version of the algorithm. + !! DTRTRI computes the inverse of a real upper or lower triangular + !! matrix A. + !! This is the Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23768,10 +23764,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) - !> DTRTRS solves a triangular system of the form - !> A * X = B or A**T * X = B, - !> where A is a triangular matrix of order N, and B is an N-by-NRHS - !> matrix. A check is made to verify that A is nonsingular. + !! DTRTRS solves a triangular system of the form + !! A * X = B or A**T * X = B, + !! where A is a triangular matrix of order N, and B is an N-by-NRHS + !! matrix. A check is made to verify that A is nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23828,8 +23824,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtrttf( transr, uplo, n, a, lda, arf, info ) - !> DTRTTF copies a triangular matrix A from standard full format (TR) - !> to rectangular full packed format (TF) . + !! DTRTTF copies a triangular matrix A from standard full format (TR) + !! to rectangular full packed format (TF) . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24056,8 +24052,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtrttp( uplo, n, a, lda, ap, info ) - !> DTRTTP copies a triangular matrix A from full format (TR) to standard - !> packed format (TP). + !! DTRTTP copies a triangular matrix A from full format (TR) to standard + !! packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24110,10 +24106,10 @@ module stdlib_linalg_lapack_d pure real(dp) function stdlib_dzsum1( n, cx, incx ) - !> DZSUM1 takes the sum of the absolute values of a complex - !> vector and returns a double precision result. - !> Based on DZASUM from the Level 1 BLAS. - !> The change is to use the 'genuine' absolute value. + !! DZSUM1 takes the sum of the absolute values of a complex + !! vector and returns a double precision result. + !! Based on DZASUM from the Level 1 BLAS. + !! The change is to use the 'genuine' absolute value. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24153,12 +24149,12 @@ module stdlib_linalg_lapack_d #:if WITH_QP pure subroutine stdlib_dlag2q( m, n, sa, ldsa, a, lda, info ) - !> DLAG2Q converts a SINGLE PRECISION matrix, SA, to a DOUBLE - !> PRECISION matrix, A. - !> Note that while it is possible to overflow while converting - !> from double to single, it is not possible to overflow when - !> converting from single to double. - !> This is an auxiliary routine so there is no argument checking. + !! DLAG2Q converts a SINGLE PRECISION matrix, SA, to a DOUBLE + !! PRECISION matrix, A. + !! Note that while it is possible to overflow while converting + !! from double to single, it is not possible to overflow when + !! converting from single to double. + !! This is an auxiliary routine so there is no argument checking. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24183,27 +24179,27 @@ module stdlib_linalg_lapack_d #:endif pure subroutine stdlib_dbbcsd( jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q,theta, phi, u1, & - !> DBBCSD computes the CS decomposition of an orthogonal 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 | ]**T - !> = [---------] [---------------] [---------] . - !> [ | 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 DORCSD for details.) - !> The bidiagonal matrices B11, B12, B21, and B22 are represented - !> implicitly by angles THETA(1:Q) and PHI(1:Q-1). - !> The orthogonal matrices U1, U2, V1T, and V2T are input/output. - !> The input matrices are pre- or post-multiplied by the appropriate - !> singular vector matrices. + !! DBBCSD computes the CS decomposition of an orthogonal 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 | ]**T + !! = [---------] [---------------] [---------] . + !! [ | 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 DORCSD for details.) + !! The bidiagonal matrices B11, B12, B21, and B22 are represented + !! implicitly by angles THETA(1:Q) and PHI(1:Q-1). + !! The orthogonal matrices U1, U2, V1T, and V2T are input/output. + !! The input matrices are pre- or post-multiplied by the appropriate + !! singular vector matrices. ldu1, u2, ldu2, v1t, ldv1t,v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e,b22d, b22e, work, & lwork, info ) ! -- lapack computational routine -- @@ -24791,19 +24787,19 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_ddisna( job, m, n, d, sep, info ) - !> DDISNA 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. - !> DDISNA may also be used to compute error bounds for eigenvectors of - !> the generalized symmetric definite eigenproblem. + !! DDISNA 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. + !! DDISNA may also be used to compute error bounds for eigenvectors of + !! the generalized symmetric definite eigenproblem. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24896,10 +24892,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & - !> DGBBRD reduces a real general m-by-n band matrix A to upper - !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. - !> The routine computes B, and optionally forms Q or P**T, or computes - !> Q**T*C for a given matrix C. + !! DGBBRD reduces a real general m-by-n band matrix A to upper + !! bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. + !! The routine computes B, and optionally forms Q or P**T, or computes + !! Q**T*C for a given matrix C. ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25153,12 +25149,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, iwork, & - !> DGBCON estimates the reciprocal of the condition number of a real - !> general band matrix A, in either the 1-norm or the infinity-norm, - !> using the LU factorization computed by DGBTRF. - !> 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)) ). + !! DGBCON estimates the reciprocal of the condition number of a real + !! general band matrix A, in either the 1-norm or the infinity-norm, + !! using the LU factorization computed by DGBTRF. + !! 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)) ). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25282,15 +25278,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) - !> DGBEQU 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. + !! DGBEQU 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25412,21 +25408,21 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) - !> DGBEQUB 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 DGEEQU 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). + !! DGBEQUB 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 DGEEQU 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). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25557,9 +25553,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, x, & - !> DGBRFS 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. + !! DGBRFS 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. ldx, ferr, berr, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25758,9 +25754,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) - !> DGBTRF computes an LU factorization of a real m-by-n band matrix A - !> using partial pivoting with row interchanges. - !> This is the blocked version of the algorithm, calling Level 3 BLAS. + !! DGBTRF computes an LU factorization of a real m-by-n band matrix A + !! using partial pivoting with row interchanges. + !! This is the blocked version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26008,12 +26004,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgecon( norm, n, a, lda, anorm, rcond, work, iwork,info ) - !> DGECON estimates the reciprocal of the condition number of a general - !> real matrix A, in either the 1-norm or the infinity-norm, using - !> the LU factorization computed by DGETRF. - !> 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)) ). + !! DGECON estimates the reciprocal of the condition number of a general + !! real matrix A, in either the 1-norm or the infinity-norm, using + !! the LU factorization computed by DGETRF. + !! 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)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26109,15 +26105,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) - !> DGEEQU 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. + !! DGEEQU 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26232,21 +26228,21 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) - !> DGEEQUB 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 DGEEQU 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). + !! DGEEQUB 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 DGEEQU 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). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26371,15 +26367,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) - !> DGEMLQT overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q C C Q - !> TRANS = 'T': Q**T C C Q**T - !> where Q is a real orthogonal matrix defined as the product of K - !> elementary reflectors: - !> Q = H(1) H(2) . . . H(K) = I - V T V**T - !> generated using the compact WY representation as returned by DGELQT. - !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. + !! DGEMLQT overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q C C Q + !! TRANS = 'T': Q**T C C Q**T + !! where Q is a real orthogonal matrix defined as the product of K + !! elementary reflectors: + !! Q = H(1) H(2) . . . H(K) = I - V T V**T + !! generated using the compact WY representation as returned by DGELQT. + !! Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26469,15 +26465,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) - !> DGEMQRT overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q C C Q - !> TRANS = 'T': Q**T C C Q**T - !> where Q is a real orthogonal matrix defined as the product of K - !> elementary reflectors: - !> Q = H(1) H(2) . . . H(K) = I - V T V**T - !> generated using the compact WY representation as returned by DGEQRT. - !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. + !! DGEMQRT overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q C C Q + !! TRANS = 'T': Q**T C C Q**T + !! where Q is a real orthogonal matrix defined as the product of K + !! elementary reflectors: + !! Q = H(1) H(2) . . . H(K) = I - V T V**T + !! generated using the compact WY representation as returned by DGEQRT. + !! Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26567,10 +26563,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) - !> DGESC2 solves a system of linear equations - !> A * X = scale* RHS - !> with a general N-by-N matrix A using the LU factorization with - !> complete pivoting computed by DGETC2. + !! DGESC2 solves a system of linear equations + !! A * X = scale* RHS + !! with a general N-by-N matrix A using the LU factorization with + !! complete pivoting computed by DGETC2. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26625,11 +26621,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgetc2( n, a, lda, ipiv, jpiv, info ) - !> DGETC2 computes an LU factorization with complete pivoting of the - !> n-by-n matrix A. The factorization has the form A = P * L * U * Q, - !> where P and Q are permutation matrices, L is lower triangular with - !> unit diagonal elements and U is upper triangular. - !> This is the Level 2 BLAS algorithm. + !! DGETC2 computes an LU factorization with complete pivoting of the + !! n-by-n matrix A. The factorization has the form A = P * L * U * Q, + !! where P and Q are permutation matrices, L is lower triangular with + !! unit diagonal elements and U is upper triangular. + !! This is the Level 2 BLAS algorithm. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26709,14 +26705,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgetf2( m, n, a, lda, ipiv, info ) - !> DGETF2 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 2 BLAS version of the algorithm. + !! DGETF2 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 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26782,25 +26778,25 @@ module stdlib_linalg_lapack_d pure recursive subroutine stdlib_dgetrf2( m, n, a, lda, ipiv, info ) - !> DGETRF2 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. + !! DGETRF2 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26897,10 +26893,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgetri( n, a, lda, ipiv, work, lwork, info ) - !> DGETRI computes the inverse of a matrix using the LU factorization - !> computed by DGETRF. - !> This method inverts U and then computes inv(A) by solving the system - !> inv(A)*L = inv(U) for inv(A). + !! DGETRI computes the inverse of a matrix using the LU factorization + !! computed by DGETRF. + !! This method inverts U and then computes inv(A) by solving the system + !! inv(A)*L = inv(U) for inv(A). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26999,10 +26995,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) - !> DGETRS solves a system of linear equations - !> A * X = B or A**T * X = B - !> with a general N-by-N matrix A using the LU factorization computed - !> by DGETRF. + !! DGETRS solves a system of linear equations + !! A * X = B or A**T * X = B + !! with a general N-by-N matrix A using the LU factorization computed + !! by DGETRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27068,15 +27064,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) - !> DGGBAL balances a pair of general real 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. + !! DGGBAL balances a pair of general real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27362,29 +27358,29 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & - !> DGGHRD reduces a pair of real matrices (A,B) to generalized upper - !> Hessenberg form using orthogonal 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 orthogonal matrix Q to the left side - !> of the equation. - !> This subroutine simultaneously reduces A to a Hessenberg matrix H: - !> Q**T*A*Z = H - !> and transforms B to another upper triangular matrix T: - !> Q**T*B*Z = T - !> in order to reduce the problem to its standard form - !> H*y = lambda*T*y - !> where y = Z**T*x. - !> The orthogonal 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**T = (Q1*Q) * H * (Z1*Z)**T - !> Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T - !> If Q1 is the orthogonal matrix from the QR factorization of B in the - !> original equation A*x = lambda*B*x, then DGGHRD reduces the original - !> problem to generalized Hessenberg form. + !! DGGHRD reduces a pair of real matrices (A,B) to generalized upper + !! Hessenberg form using orthogonal 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 orthogonal matrix Q to the left side + !! of the equation. + !! This subroutine simultaneously reduces A to a Hessenberg matrix H: + !! Q**T*A*Z = H + !! and transforms B to another upper triangular matrix T: + !! Q**T*B*Z = T + !! in order to reduce the problem to its standard form + !! H*y = lambda*T*y + !! where y = Z**T*x. + !! The orthogonal 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**T = (Q1*Q) * H * (Z1*Z)**T + !! Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T + !! If Q1 is the orthogonal matrix from the QR factorization of B in the + !! original equation A*x = lambda*B*x, then DGGHRD reduces the original + !! problem to generalized Hessenberg form. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27492,10 +27488,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) - !> DGTTRS solves one of the systems of equations - !> A*X = B or A**T*X = B, - !> with a tridiagonal matrix A using the LU factorization computed - !> by DGTTRF. + !! DGTTRS solves one of the systems of equations + !! A*X = B or A**T*X = B, + !! with a tridiagonal matrix A using the LU factorization computed + !! by DGTTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27556,9 +27552,9 @@ module stdlib_linalg_lapack_d pure logical(lk) function stdlib_disnan( din ) - !> DISNAN returns .TRUE. if its argument is NaN, and .FALSE. - !> otherwise. To be replaced by the Fortran 2003 intrinsic in the - !> future. + !! DISNAN returns .TRUE. if its argument is NaN, and .FALSE. + !! otherwise. To be replaced by the Fortran 2003 intrinsic in the + !! future. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27572,19 +27568,19 @@ module stdlib_linalg_lapack_d subroutine stdlib_dla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27758,15 +27754,15 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dla_gbrcond( trans, n, kl, ku, ab, ldab,afb, ldafb, ipiv, cmode, c,& - !> DLA_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. + !! DLA_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. info, work, iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27916,19 +27912,19 @@ module stdlib_linalg_lapack_d subroutine stdlib_dla_geamv ( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28095,15 +28091,15 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dla_gercond( trans, n, a, lda, af,ldaf, ipiv, cmode, c,info, work, & - !> DLA_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. + !! DLA_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. iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28245,11 +28241,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dla_lin_berr ( n, nz, nrhs, res, ayb, berr ) - !> DLA_LIN_BERR computes component-wise 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 component-wise absolute value of the matrix - !> or vector Z. + !! DLA_LIN_BERR computes component-wise 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 component-wise absolute value of the matrix + !! or vector Z. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28286,15 +28282,15 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dla_porcond( uplo, n, a, lda, af, ldaf,cmode, c, info, work,iwork ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28445,18 +28441,18 @@ module stdlib_linalg_lapack_d subroutine stdlib_dla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28634,15 +28630,15 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dla_syrcond( uplo, n, a, lda, af, ldaf,ipiv, cmode, c, info, work,& - !> DLA_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. + !! DLA_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. iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28801,12 +28797,12 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dla_syrpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29007,17 +29003,17 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaed6( kniter, orgati, rho, d, z, finit, tau, info ) - !> DLAED6 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. + !! DLAED6 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29233,23 +29229,23 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) - !> DLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such - !> that if ( UPPER ) then - !> U**T *A*Q = U**T *( A1 A2 )*Q = ( x 0 ) - !> ( 0 A3 ) ( x x ) - !> and - !> V**T*B*Q = V**T *( B1 B2 )*Q = ( x 0 ) - !> ( 0 B3 ) ( x x ) - !> or if ( .NOT.UPPER ) then - !> U**T *A*Q = U**T *( A1 0 )*Q = ( x x ) - !> ( A2 A3 ) ( 0 x ) - !> and - !> V**T*B*Q = V**T*( B1 0 )*Q = ( x x ) - !> ( B2 B3 ) ( 0 x ) - !> The rows of the transformed A and B are parallel, where - !> U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ ) - !> ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ ) - !> Z**T denotes the transpose of Z. + !! DLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such + !! that if ( UPPER ) then + !! U**T *A*Q = U**T *( A1 A2 )*Q = ( x 0 ) + !! ( 0 A3 ) ( x x ) + !! and + !! V**T*B*Q = V**T *( B1 B2 )*Q = ( x 0 ) + !! ( 0 B3 ) ( x x ) + !! or if ( .NOT.UPPER ) then + !! U**T *A*Q = U**T *( A1 0 )*Q = ( x x ) + !! ( A2 A3 ) ( 0 x ) + !! and + !! V**T*B*Q = V**T*( B1 0 )*Q = ( x x ) + !! ( B2 B3 ) ( 0 x ) + !! The rows of the transformed A and B are parallel, where + !! U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ ) + !! ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ ) + !! Z**T denotes the transpose of Z. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29393,18 +29389,18 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlagtf( n, a, lambda, b, c, tol, d, in, info ) - !> DLAGTF 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 DLAGTF may - !> be used, in conjunction with DLAGTS, to obtain eigenvectors of T by - !> inverse iteration. + !! DLAGTF 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 DLAGTF may + !! be used, in conjunction with DLAGTS, to obtain eigenvectors of T by + !! inverse iteration. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29484,15 +29480,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlagts( job, n, a, b, c, d, in, y, tol, info ) - !> DLAGTS 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. + !! DLAGTS 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29681,26 +29677,26 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaic1( job, j, x, sest, w, gamma, sestpr, s, c ) - !> DLAIC1 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 DLAIC1 computes sestpr, s, c such that - !> the vector - !> [ s*x ] - !> xhat = [ c ] - !> is an approximate singular vector of - !> [ L 0 ] - !> Lhat = [ w**T 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]**T and sestpr**2 is an eigenpair of the system - !> diag(sest*sest, 0) + [alpha gamma] * [ alpha ] - !> [ gamma ] - !> where alpha = x**T*w. + !! DLAIC1 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 DLAIC1 computes sestpr, s, c such that + !! the vector + !! [ s*x ] + !! xhat = [ c ] + !! is an approximate singular vector of + !! [ L 0 ] + !! Lhat = [ w**T 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]**T and sestpr**2 is an eigenpair of the system + !! diag(sest*sest, 0) + [alpha gamma] * [ alpha ] + !! [ gamma ] + !! where alpha = x**T*w. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29893,21 +29889,21 @@ module stdlib_linalg_lapack_d pure integer(ilp) function stdlib_dlaneg( n, d, lld, sigma, pivmin, r ) - !> DLANEG 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.) + !! DLANEG 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.) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29998,9 +29994,9 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dlangb( norm, n, kl, ku, ab, ldab,work ) - !> DLANGB 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. + !! DLANGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30073,9 +30069,9 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dlange( norm, m, n, a, lda, work ) - !> DLANGE 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 matrix A. + !! DLANGE 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 matrix A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30145,9 +30141,9 @@ module stdlib_linalg_lapack_d pure real(dp) function stdlib_dlangt( norm, n, dl, d, du ) - !> DLANGT 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 tridiagonal matrix A. + !! DLANGT 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 tridiagonal matrix A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30221,9 +30217,9 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dlanhs( norm, n, a, lda, work ) - !> DLANHS 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. + !! DLANHS 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30293,9 +30289,9 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dlansb( norm, uplo, n, k, ab, ldab,work ) - !> DLANSB 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. + !! DLANSB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30398,9 +30394,9 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dlansf( norm, transr, uplo, n, a, work ) - !> DLANSF 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. + !! DLANSF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31102,9 +31098,9 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dlansp( norm, uplo, n, ap, work ) - !> DLANSP 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, supplied in packed form. + !! DLANSP 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, supplied in packed form. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31226,9 +31222,9 @@ module stdlib_linalg_lapack_d pure real(dp) function stdlib_dlanst( norm, n, d, e ) - !> DLANST 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. + !! DLANST 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31288,9 +31284,9 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dlansy( norm, uplo, n, a, lda, work ) - !> DLANSY 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. + !! DLANSY 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31384,9 +31380,9 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dlantb( norm, uplo, diag, n, k, ab,ldab, work ) - !> DLANTB 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. + !! DLANTB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31577,9 +31573,9 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dlantp( norm, uplo, diag, n, ap, work ) - !> DLANTP 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. + !! DLANTP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31783,9 +31779,9 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dlantr( norm, uplo, diag, m, n, a, lda,work ) - !> DLANTR 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. + !! DLANTR 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31969,39 +31965,39 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaorhr_col_getrfnp( m, n, a, lda, d, info ) - !> DLAORHR_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 DLAORHR_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. + !! DLAORHR_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 DLAORHR_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32063,8 +32059,8 @@ module stdlib_linalg_lapack_d pure real(dp) function stdlib_dlapy2( x, y ) - !> DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary - !> overflow and unnecessary underflow. + !! DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary + !! overflow and unnecessary underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32100,15 +32096,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaqz1( a, lda, b, ldb, sr1, sr2, si, beta1, beta2,v ) - !> Given a 3-by-3 matrix pencil (A,B), DLAQZ1: sets v to a - !> scalar multiple of the first column of the product - !> (*) K = (A - (beta2*sr2 - i*si)*B)*B^(-1)*(beta1*A - (sr2 + i*si2)*B)*B^(-1). - !> It is assumed that either - !> 1) sr1 = sr2 - !> or - !> 2) si = 0. - !> This is useful for starting double implicit shift bulges - !> in the QZ algorithm. + !! Given a 3-by-3 matrix pencil (A,B), DLAQZ1: sets v to a + !! scalar multiple of the first column of the product + !! (*) K = (A - (beta2*sr2 - i*si)*B)*B^(-1)*(beta1*A - (sr2 + i*si2)*B)*B^(-1). + !! It is assumed that either + !! 1) sr1 = sr2 + !! or + !! 2) si = 0. + !! This is useful for starting double implicit shift bulges + !! in the QZ algorithm. ! arguments integer(ilp), intent( in ) :: lda, ldb real(dp), intent( in ) :: a( lda, * ), b( ldb, * ), sr1,sr2, si, beta1, beta2 @@ -32155,7 +32151,7 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaqz2( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, qstart, & - !> DLAQZ2 chases a 2x2 shift bulge in a matrix pencil down a single position + !! DLAQZ2 chases a 2x2 shift bulge in a matrix pencil down a single position q, ldq, nz, zstart, z, ldz ) ! arguments logical(lk), intent( in ) :: ilq, ilz @@ -32266,7 +32262,7 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaqz4( ilschur, ilq, ilz, n, ilo, ihi, nshifts,nblock_desired, sr, & - !> DLAQZ4 Executes a single multishift QZ sweep + !! DLAQZ4 Executes a single multishift QZ sweep si, ss, a, lda, b, ldb, q,ldq, z, ldz, qc, ldqc, zc, ldzc, work, lwork,info ) ! function arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -32523,21 +32519,21 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & - !> DLAR1V 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. + !! DLAR1V 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. negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32745,19 +32741,19 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarfg( n, alpha, x, incx, tau ) - !> DLARFG generates a real elementary reflector H of order n, such - !> that - !> H * ( alpha ) = ( beta ), H**T * H = I. - !> ( x ) ( 0 ) - !> where alpha and beta are scalars, and x is an (n-1)-element real - !> vector. H is represented in the form - !> H = I - tau * ( 1 ) * ( 1 v**T ) , - !> ( v ) - !> where tau is a real scalar and v is a real (n-1)-element - !> vector. - !> If the elements of x are all zero, then tau = 0 and H is taken to be - !> the unit matrix. - !> Otherwise 1 <= tau <= 2. + !! DLARFG generates a real elementary reflector H of order n, such + !! that + !! H * ( alpha ) = ( beta ), H**T * H = I. + !! ( x ) ( 0 ) + !! where alpha and beta are scalars, and x is an (n-1)-element real + !! vector. H is represented in the form + !! H = I - tau * ( 1 ) * ( 1 v**T ) , + !! ( v ) + !! where tau is a real scalar and v is a real (n-1)-element + !! vector. + !! If the elements of x are all zero, then tau = 0 and H is taken to be + !! the unit matrix. + !! Otherwise 1 <= tau <= 2. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32814,18 +32810,18 @@ module stdlib_linalg_lapack_d subroutine stdlib_dlarfgp( n, alpha, x, incx, tau ) - !> DLARFGP generates a real elementary reflector H of order n, such - !> that - !> H * ( alpha ) = ( beta ), H**T * H = I. - !> ( x ) ( 0 ) - !> where alpha and beta are scalars, beta is non-negative, and x is - !> an (n-1)-element real vector. H is represented in the form - !> H = I - tau * ( 1 ) * ( 1 v**T ) , - !> ( v ) - !> where tau is a real scalar and v is a real (n-1)-element - !> vector. - !> If the elements of x are all zero, then tau = 0 and H is taken to be - !> the unit matrix. + !! DLARFGP generates a real elementary reflector H of order n, such + !! that + !! H * ( alpha ) = ( beta ), H**T * H = I. + !! ( x ) ( 0 ) + !! where alpha and beta are scalars, beta is non-negative, and x is + !! an (n-1)-element real vector. H is represented in the form + !! H = I - tau * ( 1 ) * ( 1 v**T ) , + !! ( v ) + !! where tau is a real scalar and v is a real (n-1)-element + !! vector. + !! If the elements of x are all zero, then tau = 0 and H is taken to be + !! the unit matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32922,8 +32918,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarnv( idist, iseed, n, x ) - !> DLARNV returns a vector of n random real numbers from a uniform or - !> normal distribution. + !! DLARNV returns a vector of n random real numbers from a uniform or + !! normal distribution. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32978,14 +32974,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarrb( n, d, lld, ifirst, ilast, rtol1,rtol2, offset, w, wgap, werr, & - !> Given the relatively robust representation(RRR) L D L^T, DLARRB: - !> 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. + !! Given the relatively robust representation(RRR) L D L^T, DLARRB: + !! 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. work, iwork,pivmin, spdiam, twist, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33151,11 +33147,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarrf( n, d, l, ld, clstrt, clend,w, wgap, werr,spdiam, clgapl, & - !> 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 ), DLARRF: 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. + !! 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 ), DLARRF: 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. clgapr, pivmin, sigma,dplus, lplus, work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33410,9 +33406,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, & - !> DLARRV 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 DLARRE. + !! DLARRV 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 DLARRE. rtol2, w, werr, wgap,iblock, indexw, gers, z, ldz, isuppz,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34041,11 +34037,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) - !> DLASCL multiplies the M by N real 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. + !! DLASCL multiplies the M by N real 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34211,17 +34207,17 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasd4( n, i, d, z, delta, rho, sigma, work, info ) - !> 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. + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34939,13 +34935,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasd7( icompq, nl, nr, sqre, k, d, z, zw, vf, vfw, vl,vlw, alpha, & - !> DLASD7 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. - !> DLASD7 is called from DLASD6. + !! DLASD7 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. + !! DLASD7 is called from DLASD6. beta, dsigma, idx, idxp, idxq,perm, givptr, givcol, ldgcol, givnum, ldgnum,c, s, info ) ! -- lapack auxiliary routine -- @@ -35178,13 +35174,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasd8( icompq, k, d, z, vf, vl, difl, difr, lddifr,dsigma, work, & - !> DLASD8 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. - !> DLASD8 is called from DLASD6. + !! DLASD8 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. + !! DLASD8 is called from DLASD6. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35314,9 +35310,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasq3( i0, n0, z, pp, dmin, sigma, desig, qmax, nfail,iter, ndiv, & - !> DLASQ3 checks for deflation, computes a shift (TAU) and calls dqds. - !> In case of failure it changes shifts, and tries again until output - !> is positive. + !! DLASQ3 checks for deflation, computes a shift (TAU) and calls dqds. + !! In case of failure it changes shifts, and tries again until output + !! is positive. ieee, ttype, dmin1, dmin2, dn, dn1,dn2, g, tau ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35484,14 +35480,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) - !> DLATDF uses the LU factorization of the n-by-n matrix Z computed by - !> DGETC2 and computes a contribution to the reciprocal Dif-estimate - !> by solving Z * x = b for x, and choosing the r.h.s. b such that - !> the norm of x is as large as possible. On entry RHS = b holds the - !> contribution from earlier solved sub-systems, and on return RHS = x. - !> The factorization of Z returned by DGETC2 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. + !! DLATDF uses the LU factorization of the n-by-n matrix Z computed by + !! DGETC2 and computes a contribution to the reciprocal Dif-estimate + !! by solving Z * x = b for x, and choosing the r.h.s. b such that + !! the norm of x is as large as possible. On entry RHS = b holds the + !! contribution from earlier solved sub-systems, and on return RHS = x. + !! The factorization of Z returned by DGETC2 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35594,15 +35590,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) - !> DLATRD reduces NB rows and columns of a real symmetric matrix A to - !> symmetric tridiagonal form by an orthogonal similarity - !> transformation Q**T * A * Q, and returns the matrices V and W which are - !> needed to apply the transformation to the unreduced part of A. - !> If UPLO = 'U', DLATRD reduces the last NB rows and columns of a - !> matrix, of which the upper triangle is supplied; - !> if UPLO = 'L', DLATRD reduces the first NB rows and columns of a - !> matrix, of which the lower triangle is supplied. - !> This is an auxiliary routine called by DSYTRD. + !! DLATRD reduces NB rows and columns of a real symmetric matrix A to + !! symmetric tridiagonal form by an orthogonal similarity + !! transformation Q**T * A * Q, and returns the matrices V and W which are + !! needed to apply the transformation to the unreduced part of A. + !! If UPLO = 'U', DLATRD reduces the last NB rows and columns of a + !! matrix, of which the upper triangle is supplied; + !! if UPLO = 'L', DLATRD reduces the first NB rows and columns of a + !! matrix, of which the lower triangle is supplied. + !! This is an auxiliary routine called by DSYTRD. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35696,10 +35692,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlatrz( m, n, l, a, lda, tau, work ) - !> DLATRZ factors the M-by-(M+L) real upper trapezoidal matrix - !> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z, by means - !> of orthogonal transformations. Z is an (M+L)-by-(M+L) orthogonal - !> matrix and, R and A1 are M-by-M upper triangular matrices. + !! DLATRZ factors the M-by-(M+L) real upper trapezoidal matrix + !! [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z, by means + !! of orthogonal transformations. Z is an (M+L)-by-(M+L) orthogonal + !! matrix and, R and A1 are M-by-M upper triangular matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35736,22 +35732,22 @@ module stdlib_linalg_lapack_d subroutine stdlib_dorbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & - !> DORBDB simultaneously bidiagonalizes the blocks of an M-by-M - !> partitioned orthogonal matrix X: - !> [ B11 | B12 0 0 ] - !> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**T - !> X = [-----------] = [---------] [----------------] [---------] . - !> [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] - !> [ 0 | 0 0 I ] - !> X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is - !> not the case, then X must be transposed and/or permuted. This can be - !> done in constant time using the TRANS and SIGNS options. See DORCSD - !> for details.) - !> The orthogonal matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- - !> (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are - !> represented implicitly by Householder vectors. - !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! DORBDB simultaneously bidiagonalizes the blocks of an M-by-M + !! partitioned orthogonal matrix X: + !! [ B11 | B12 0 0 ] + !! [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**T + !! X = [-----------] = [---------] [----------------] [---------] . + !! [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] + !! [ 0 | 0 0 I ] + !! X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is + !! not the case, then X must be transposed and/or permuted. This can be + !! done in constant time using the TRANS and SIGNS options. See DORCSD + !! for details.) + !! The orthogonal matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- + !! (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are + !! represented implicitly by Householder vectors. + !! B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented + !! implicitly by angles THETA, PHI. ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36064,17 +36060,17 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & - !> DORBDB5 orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then some other vector from the orthogonal complement - !> is returned. This vector is chosen in an arbitrary but deterministic - !> way. + !! DORBDB5 orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then some other vector from the orthogonal complement + !! is returned. This vector is chosen in an arbitrary but deterministic + !! way. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36163,19 +36159,19 @@ module stdlib_linalg_lapack_d recursive subroutine stdlib_dorcsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & - !> DORCSD computes the CS decomposition of an M-by-M partitioned - !> orthogonal matrix X: - !> [ I 0 0 | 0 0 0 ] - !> [ 0 C 0 | 0 -S 0 ] - !> [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**T - !> X = [-----------] = [---------] [---------------------] [---------] . - !> [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] - !> [ 0 S 0 | 0 C 0 ] - !> [ 0 0 I | 0 0 0 ] - !> X11 is P-by-Q. The orthogonal matrices U1, U2, V1, and V2 are P-by-P, - !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are - !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in - !> which R = MIN(P,M-P,Q,M-Q). + !! DORCSD computes the CS decomposition of an M-by-M partitioned + !! orthogonal matrix X: + !! [ I 0 0 | 0 0 0 ] + !! [ 0 C 0 | 0 -S 0 ] + !! [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**T + !! X = [-----------] = [---------] [---------------------] [---------] . + !! [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] + !! [ 0 S 0 | 0 C 0 ] + !! [ 0 0 I | 0 0 0 ] + !! X11 is P-by-Q. The orthogonal matrices U1, U2, V1, and V2 are P-by-P, + !! (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are + !! R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in + !! which R = MIN(P,M-P,Q,M-Q). ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, ldv1t, v2t,ldv2t, & work, lwork, iwork, info ) ! -- lapack computational routine -- @@ -36438,10 +36434,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) - !> DORGHR generates a real orthogonal matrix Q which is defined as the - !> product of IHI-ILO elementary reflectors of order N, as returned by - !> DGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! DORGHR generates a real orthogonal matrix Q which is defined as the + !! product of IHI-ILO elementary reflectors of order N, as returned by + !! DGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36528,15 +36524,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorhr_col( m, n, nb, a, lda, t, ldt, d, info ) - !> DORHR_COL takes an M-by-N real matrix Q_in with orthonormal columns - !> as input, stored in A, and performs Householder Reconstruction (HR), - !> i.e. reconstructs Householder vectors V(i) implicitly representing - !> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, - !> where S is an N-by-N diagonal matrix with diagonal entries - !> equal to +1 or -1. The Householder vectors (columns V(i) of V) are - !> stored in A on output, and the diagonal entries of S are stored in D. - !> Block reflectors are also returned in T - !> (same output format as DGEQRT). + !! DORHR_COL takes an M-by-N real matrix Q_in with orthonormal columns + !! as input, stored in A, and performs Householder Reconstruction (HR), + !! i.e. reconstructs Householder vectors V(i) implicitly representing + !! another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, + !! where S is an N-by-N diagonal matrix with diagonal entries + !! equal to +1 or -1. The Householder vectors (columns V(i) of V) are + !! stored in A on output, and the diagonal entries of S are stored in D. + !! Block reflectors are also returned in T + !! (same output format as DGEQRT). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36665,14 +36661,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dormhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & - !> DORMHR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> IHI-ILO elementary reflectors, as returned by DGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! DORMHR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! IHI-ILO elementary reflectors, as returned by DGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36764,11 +36760,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,iwork, info ) - !> DPBCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric positive definite band matrix using the - !> Cholesky factorization A = U**T*U or A = L*L**T computed by DPBTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! DPBCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric positive definite band matrix using the + !! Cholesky factorization A = U**T*U or A = L*L**T computed by DPBTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36862,10 +36858,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & - !> DPBRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric positive definite - !> and banded, and provides error bounds and backward error estimates - !> for the solution. + !! DPBRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric positive definite + !! and banded, and provides error bounds and backward error estimates + !! for the solution. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37056,9 +37052,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpftrs( transr, uplo, n, nrhs, a, b, ldb, info ) - !> DPFTRS solves a system of linear equations A*X = B with a symmetric - !> positive definite matrix A using the Cholesky factorization - !> A = U**T*U or A = L*L**T computed by DPFTRF. + !! DPFTRS solves a system of linear equations A*X = B with a symmetric + !! positive definite matrix A using the Cholesky factorization + !! A = U**T*U or A = L*L**T computed by DPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37110,11 +37106,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpocon( uplo, n, a, lda, anorm, rcond, work, iwork,info ) - !> DPOCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric positive definite matrix using the - !> Cholesky factorization A = U**T*U or A = L*L**T computed by DPOTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! DPOCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric positive definite matrix using the + !! Cholesky factorization A = U**T*U or A = L*L**T computed by DPOTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37205,10 +37201,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & - !> DPORFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric positive definite, - !> and provides error bounds and backward error estimates for the - !> solution. + !! DPORFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric positive definite, + !! and provides error bounds and backward error estimates for the + !! solution. work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37394,13 +37390,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpotf2( uplo, n, a, lda, info ) - !> DPOTF2 computes the Cholesky factorization of a real symmetric - !> positive definite matrix A. - !> The factorization has the form - !> A = U**T * U , if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! DPOTF2 computes the Cholesky factorization of a real symmetric + !! positive definite matrix A. + !! The factorization has the form + !! A = U**T * U , if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37481,19 +37477,19 @@ module stdlib_linalg_lapack_d pure recursive subroutine stdlib_dpotrf2( uplo, n, a, lda, info ) - !> DPOTRF2 computes the Cholesky factorization of a real symmetric - !> positive definite matrix A using the recursive algorithm. - !> The factorization has the form - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> 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 = n/2 - !> [ A21 | A22 ] n2 = n-n1 - !> The subroutine calls itself to factor A11. Update and scale A21 - !> or A12, update A22 then calls itself to factor A22. + !! DPOTRF2 computes the Cholesky factorization of a real symmetric + !! positive definite matrix A using the recursive algorithm. + !! The factorization has the form + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! 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 = n/2 + !! [ A21 | A22 ] n2 = n-n1 + !! The subroutine calls itself to factor A11. Update and scale A21 + !! or A12, update A22 then calls itself to factor A22. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37579,9 +37575,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpotri( uplo, n, a, lda, info ) - !> DPOTRI computes the inverse of a real symmetric positive definite - !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T - !> computed by DPOTRF. + !! DPOTRI computes the inverse of a real symmetric positive definite + !! matrix A using the Cholesky factorization A = U**T*U or A = L*L**T + !! computed by DPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37620,12 +37616,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dppcon( uplo, n, ap, anorm, rcond, work, iwork, info ) - !> DPPCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric positive definite packed matrix using - !> the Cholesky factorization A = U**T*U or A = L*L**T computed by - !> DPPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! DPPCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric positive definite packed matrix using + !! the Cholesky factorization A = U**T*U or A = L*L**T computed by + !! DPPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37714,10 +37710,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & - !> DPPRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric positive definite - !> and packed, and provides error bounds and backward error estimates - !> for the solution. + !! DPPRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric positive definite + !! and packed, and provides error bounds and backward error estimates + !! for the solution. iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37906,16 +37902,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dppsv( uplo, n, nrhs, ap, b, ldb, info ) - !> DPPSV computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite matrix stored in - !> packed format and X and B are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**T* U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is a lower triangular - !> matrix. The factored form of A is then used to solve the system of - !> equations A * X = B. + !! DPPSV computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite matrix stored in + !! packed format and X and B are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**T* U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is a lower triangular + !! matrix. The factored form of A is then used to solve the system of + !! equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37955,13 +37951,13 @@ module stdlib_linalg_lapack_d subroutine stdlib_dppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& - !> DPPSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to - !> compute the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite matrix stored in - !> packed format and X and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DPPSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to + !! compute the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite matrix stored in + !! packed format and X and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38094,9 +38090,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpptri( uplo, n, ap, info ) - !> DPPTRI computes the inverse of a real symmetric positive definite - !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T - !> computed by DPPTRF. + !! DPPTRI computes the inverse of a real symmetric positive definite + !! matrix A using the Cholesky factorization A = U**T*U or A = L*L**T + !! computed by DPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38156,15 +38152,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpstf2( uplo, n, a, lda, piv, rank, tol, work, info ) - !> DPSTF2 computes the Cholesky factorization with complete - !> pivoting of a real symmetric positive semidefinite matrix A. - !> The factorization has the form - !> P**T * A * P = U**T * U , if UPLO = 'U', - !> P**T * A * P = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular, and - !> P is stored as vector PIV. - !> This algorithm does not attempt to check that A is positive - !> semidefinite. This version of the algorithm calls level 2 BLAS. + !! DPSTF2 computes the Cholesky factorization with complete + !! pivoting of a real symmetric positive semidefinite matrix A. + !! The factorization has the form + !! P**T * A * P = U**T * U , if UPLO = 'U', + !! P**T * A * P = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular, and + !! P is stored as vector PIV. + !! This algorithm does not attempt to check that A is positive + !! semidefinite. This version of the algorithm calls level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38335,15 +38331,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) - !> DPSTRF computes the Cholesky factorization with complete - !> pivoting of a real symmetric positive semidefinite matrix A. - !> The factorization has the form - !> P**T * A * P = U**T * U , if UPLO = 'U', - !> P**T * A * P = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular, and - !> P is stored as vector PIV. - !> This algorithm does not attempt to check that A is positive - !> semidefinite. This version of the algorithm calls level 3 BLAS. + !! DPSTRF computes the Cholesky factorization with complete + !! pivoting of a real symmetric positive semidefinite matrix A. + !! The factorization has the form + !! P**T * A * P = U**T * U , if UPLO = 'U', + !! P**T * A * P = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular, and + !! P is stored as vector PIV. + !! This algorithm does not attempt to check that A is positive + !! semidefinite. This version of the algorithm calls level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38546,12 +38542,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpttrs( n, nrhs, d, e, b, ldb, info ) - !> DPTTRS solves a tridiagonal system of the form - !> A * X = B - !> using the L*D*L**T factorization of A computed by DPTTRF. D is a - !> diagonal matrix specified in the vector D, L is a unit bidiagonal - !> matrix whose subdiagonal is specified in the vector E, and X and B - !> are N by NRHS matrices. + !! DPTTRS solves a tridiagonal system of the form + !! A * X = B + !! using the L*D*L**T factorization of A computed by DPTTRF. D is a + !! diagonal matrix specified in the vector D, L is a unit bidiagonal + !! matrix whose subdiagonal is specified in the vector E, and X and B + !! are N by NRHS matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38601,8 +38597,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, lda, & - !> DSB2ST_KERNELS is an internal routine used by the DSYTRD_SB2ST - !> subroutine. + !! DSB2ST_KERNELS is an internal routine used by the DSYTRD_SB2ST + !! subroutine. v, tau, ldvt, work) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38746,11 +38742,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dspcon( uplo, n, ap, ipiv, anorm, rcond, work, iwork,info ) - !> DSPCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric packed matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by DSPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! DSPCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric packed matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by DSPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38828,10 +38824,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& - !> DSPRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite - !> and packed, and provides error bounds and backward error estimates - !> for the solution. + !! DSPRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric indefinite + !! and packed, and provides error bounds and backward error estimates + !! for the solution. iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39021,17 +39017,17 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> DSPSV computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric 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**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, D is symmetric 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. + !! DSPSV computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric 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**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, D is symmetric 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39072,12 +39068,12 @@ module stdlib_linalg_lapack_d subroutine stdlib_dspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & - !> DSPSVX uses the diagonal pivoting factorization A = U*D*U**T or - !> A = L*D*L**T to compute the solution to a real system of linear - !> equations A * X = B, where A is an N-by-N symmetric matrix stored - !> in packed format and X and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DSPSVX uses the diagonal pivoting factorization A = U*D*U**T or + !! A = L*D*L**T to compute the solution to a real system of linear + !! equations A * X = B, where A is an N-by-N symmetric matrix stored + !! in packed format and X and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39150,9 +39146,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsptrd( uplo, n, ap, d, e, tau, info ) - !> DSPTRD reduces a real symmetric matrix A stored in packed form to - !> symmetric tridiagonal form T by an orthogonal similarity - !> transformation: Q**T * A * Q = T. + !! DSPTRD reduces a real symmetric matrix A stored in packed form to + !! symmetric tridiagonal form T by an orthogonal similarity + !! transformation: Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39247,11 +39243,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & - !> DSTEIN computes the eigenvectors of a real symmetric tridiagonal - !> matrix T corresponding to specified eigenvalues, using inverse - !> iteration. - !> The maximum number of iterations allowed for each eigenvector is - !> specified by an internal parameter MAXITS (currently set to 5). + !! DSTEIN computes the eigenvectors of a real symmetric tridiagonal + !! matrix T corresponding to specified eigenvalues, using inverse + !! iteration. + !! The maximum number of iterations allowed for each eigenvector is + !! specified by an internal parameter MAXITS (currently set to 5). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39445,11 +39441,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsteqr( compz, n, d, e, z, ldz, work, info ) - !> DSTEQR computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric tridiagonal matrix using the implicit QL or QR method. - !> The eigenvectors of a full or band symmetric matrix can also be found - !> if DSYTRD or DSPTRD or DSBTRD has been used to reduce this matrix to - !> tridiagonal form. + !! DSTEQR computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric tridiagonal matrix using the implicit QL or QR method. + !! The eigenvectors of a full or band symmetric matrix can also be found + !! if DSYTRD or DSPTRD or DSBTRD has been used to reduce this matrix to + !! tridiagonal form. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39762,8 +39758,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsterf( n, d, e, info ) - !> DSTERF computes all eigenvalues of a symmetric tridiagonal matrix - !> using the Pal-Walker-Kahan variant of the QL or QR algorithm. + !! DSTERF computes all eigenvalues of a symmetric tridiagonal matrix + !! using the Pal-Walker-Kahan variant of the QL or QR algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39997,8 +39993,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dstev( jobz, n, d, e, z, ldz, work, info ) - !> DSTEV computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric tridiagonal matrix A. + !! DSTEV computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric tridiagonal matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -40080,10 +40076,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dstevx( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & - !> DSTEVX computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix A. Eigenvalues and - !> eigenvectors can be selected by specifying either a range of values - !> or a range of indices for the desired eigenvalues. + !! DSTEVX computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix A. Eigenvalues and + !! eigenvectors can be selected by specifying either a range of values + !! or a range of indices for the desired eigenvalues. work, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40274,11 +40270,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsycon( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) - !> DSYCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by DSYTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! DSYCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by DSYTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40357,11 +40353,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) - !> DSYCON_ROOK estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by DSYTRF_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))). + !! DSYCON_ROOK estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by DSYTRF_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))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40440,9 +40436,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & - !> DSYRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite, and - !> provides error bounds and backward error estimates for the solution. + !! DSYRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric indefinite, and + !! provides error bounds and backward error estimates for the solution. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40629,20 +40625,20 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,work, lwork, info ) - !> DSYSV_RK computes the solution to a real system of linear - !> equations A * X = B, where A is an N-by-N symmetric 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**T)*(P**T), if UPLO = 'U', or - !> A = P*L*D*(L**T)*(P**T), if UPLO = 'L', - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric and block - !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. - !> DSYTRF_RK is called to compute the factorization of a real - !> symmetric matrix. The factored form of A is then used to solve - !> the system of equations A * X = B by calling BLAS3 routine DSYTRS_3. + !! DSYSV_RK computes the solution to a real system of linear + !! equations A * X = B, where A is an N-by-N symmetric 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**T)*(P**T), if UPLO = 'U', or + !! A = P*L*D*(L**T)*(P**T), if UPLO = 'L', + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric and block + !! diagonal with 1-by-1 and 2-by-2 diagonal blocks. + !! DSYTRF_RK is called to compute the factorization of a real + !! symmetric matrix. The factored form of A is then used to solve + !! the system of equations A * X = B by calling BLAS3 routine DSYTRS_3. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40706,22 +40702,22 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> DSYSV_ROOK computes the solution to a real system of linear - !> equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> The 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 symmetric and block diagonal with - !> 1-by-1 and 2-by-2 diagonal blocks. - !> DSYTRF_ROOK is called to compute the factorization of a real - !> symmetric 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 DSYTRS_ROOK. + !! DSYSV_ROOK computes the solution to a real system of linear + !! equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! The 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 symmetric and block diagonal with + !! 1-by-1 and 2-by-2 diagonal blocks. + !! DSYTRF_ROOK is called to compute the factorization of a real + !! symmetric 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 DSYTRS_ROOK. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40785,8 +40781,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytd2( uplo, n, a, lda, d, e, tau, info ) - !> DSYTD2 reduces a real symmetric matrix A to symmetric tridiagonal - !> form T by an orthogonal similarity transformation: Q**T * A * Q = T. + !! DSYTD2 reduces a real symmetric matrix A to symmetric tridiagonal + !! form T by an orthogonal similarity transformation: Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -40879,13 +40875,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytf2( uplo, n, a, lda, ipiv, info ) - !> DSYTF2 computes the factorization of a real symmetric matrix A using - !> the Bunch-Kaufman diagonal pivoting method: - !> 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, U**T is the transpose of U, and D is symmetric 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. + !! DSYTF2 computes the factorization of a real symmetric matrix A using + !! the Bunch-Kaufman diagonal pivoting method: + !! 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, U**T is the transpose of U, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41164,9 +41160,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) - !> DSYTRD reduces a real symmetric matrix A to real symmetric - !> tridiagonal form T by an orthogonal similarity transformation: - !> Q**T * A * Q = T. + !! DSYTRD reduces a real symmetric matrix A to real symmetric + !! tridiagonal form T by an orthogonal similarity transformation: + !! Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41290,9 +41286,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & - !> DSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric - !> tridiagonal form T by a orthogonal similarity transformation: - !> Q**T * A * Q = T. + !! DSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric + !! tridiagonal form T by a orthogonal similarity transformation: + !! Q**T * A * Q = T. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41536,14 +41532,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytrf( uplo, n, a, lda, ipiv, work, lwork, info ) - !> DSYTRF computes the factorization of a real symmetric matrix A using - !> the Bunch-Kaufman diagonal pivoting method. The form of the - !> factorization is - !> A = U**T*D*U or A = L*D*L**T - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and D is symmetric 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. + !! DSYTRF computes the factorization of a real symmetric matrix A using + !! the Bunch-Kaufman diagonal pivoting method. The form of the + !! factorization is + !! A = U**T*D*U or A = L*D*L**T + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41662,12 +41658,12 @@ module stdlib_linalg_lapack_d subroutine stdlib_dtbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,iwork, info ) - !> DTBCON estimates the reciprocal of the condition number of a - !> triangular band matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! DTBCON estimates the reciprocal of the condition number of a + !! triangular band matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41766,9 +41762,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtftri( transr, uplo, diag, n, a, info ) - !> DTFTRI computes the inverse of a triangular matrix A stored in RFP - !> format. - !> This is a Level 3 BLAS version of the algorithm. + !! DTFTRI computes the inverse of a triangular matrix A stored in RFP + !! format. + !! This is a Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41949,34 +41945,34 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & - !> DTGSY2 solves the generalized Sylvester equation: - !> A * R - L * B = scale * C (1) - !> D * R - L * E = scale * F, - !> using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices, - !> (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M, - !> N-by-N and M-by-N, respectively, with real entries. (A, D) and (B, E) - !> must be in generalized Schur canonical form, i.e. A, B are upper - !> quasi triangular and D, E are upper triangular. The solution (R, L) - !> overwrites (C, F). 0 <= SCALE <= 1 is an output scaling factor - !> chosen to avoid overflow. - !> In matrix notation solving equation (1) corresponds to solve - !> Z*x = scale*b, where Z is defined as - !> Z = [ kron(In, A) -kron(B**T, Im) ] (2) - !> [ kron(In, D) -kron(E**T, Im) ], - !> Ik is the identity matrix of size k and X**T is the transpose of X. - !> kron(X, Y) is the Kronecker product between the matrices X and Y. - !> In the process of solving (1), we solve a number of such systems - !> where Dim(In), Dim(In) = 1 or 2. - !> If TRANS = 'T', solve the transposed system Z**T*y = scale*b for y, - !> which is equivalent to solve for R and L in - !> A**T * R + D**T * L = scale * C (3) - !> R * B**T + L * E**T = scale * -F - !> This case is used to compute an estimate of Dif[(A, D), (B, E)] = - !> sigma_min(Z) using reverse communication with DLACON. - !> DTGSY2 also (IJOB >= 1) contributes to the computation in DTGSYL - !> of an upper bound on the separation between to matrix pairs. Then - !> the input (A, D), (B, E) are sub-pencils of the matrix pair in - !> DTGSYL. See DTGSYL for details. + !! DTGSY2 solves the generalized Sylvester equation: + !! A * R - L * B = scale * C (1) + !! D * R - L * E = scale * F, + !! using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices, + !! (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M, + !! N-by-N and M-by-N, respectively, with real entries. (A, D) and (B, E) + !! must be in generalized Schur canonical form, i.e. A, B are upper + !! quasi triangular and D, E are upper triangular. The solution (R, L) + !! overwrites (C, F). 0 <= SCALE <= 1 is an output scaling factor + !! chosen to avoid overflow. + !! In matrix notation solving equation (1) corresponds to solve + !! Z*x = scale*b, where Z is defined as + !! Z = [ kron(In, A) -kron(B**T, Im) ] (2) + !! [ kron(In, D) -kron(E**T, Im) ], + !! Ik is the identity matrix of size k and X**T is the transpose of X. + !! kron(X, Y) is the Kronecker product between the matrices X and Y. + !! In the process of solving (1), we solve a number of such systems + !! where Dim(In), Dim(In) = 1 or 2. + !! If TRANS = 'T', solve the transposed system Z**T*y = scale*b for y, + !! which is equivalent to solve for R and L in + !! A**T * R + D**T * L = scale * C (3) + !! R * B**T + L * E**T = scale * -F + !! This case is used to compute an estimate of Dif[(A, D), (B, E)] = + !! sigma_min(Z) using reverse communication with DLACON. + !! DTGSY2 also (IJOB >= 1) contributes to the computation in DTGSYL + !! of an upper bound on the separation between to matrix pairs. Then + !! the input (A, D), (B, E) are sub-pencils of the matrix pair in + !! DTGSYL. See DTGSYL for details. ldf, scale, rdsum, rdscal,iwork, pq, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42589,34 +42585,34 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & - !> DTGSYL solves the generalized Sylvester equation: - !> A * R - L * B = scale * C (1) - !> D * R - L * E = scale * F - !> where R and L are unknown m-by-n matrices, (A, D), (B, E) and - !> (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n, - !> respectively, with real entries. (A, D) and (B, E) must be in - !> generalized (real) Schur canonical form, i.e. A, B are upper quasi - !> triangular and D, E are upper triangular. - !> The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output - !> scaling factor chosen to avoid overflow. - !> In matrix notation (1) is equivalent to solve Zx = scale b, where - !> Z is defined as - !> Z = [ kron(In, A) -kron(B**T, Im) ] (2) - !> [ kron(In, D) -kron(E**T, Im) ]. - !> Here Ik is the identity matrix of size k and X**T is the transpose of - !> X. kron(X, Y) is the Kronecker product between the matrices X and Y. - !> If TRANS = 'T', DTGSYL solves the transposed system Z**T*y = scale*b, - !> which is equivalent to solve for R and L in - !> A**T * R + D**T * L = scale * C (3) - !> R * B**T + L * E**T = scale * -F - !> This case (TRANS = 'T') is used to compute an one-norm-based estimate - !> of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D) - !> and (B,E), using DLACON. - !> If IJOB >= 1, DTGSYL computes a Frobenius norm-based estimate - !> of Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the - !> reciprocal of the smallest singular value of Z. See [1-2] for more - !> information. - !> This is a level 3 BLAS algorithm. + !! DTGSYL solves the generalized Sylvester equation: + !! A * R - L * B = scale * C (1) + !! D * R - L * E = scale * F + !! where R and L are unknown m-by-n matrices, (A, D), (B, E) and + !! (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n, + !! respectively, with real entries. (A, D) and (B, E) must be in + !! generalized (real) Schur canonical form, i.e. A, B are upper quasi + !! triangular and D, E are upper triangular. + !! The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output + !! scaling factor chosen to avoid overflow. + !! In matrix notation (1) is equivalent to solve Zx = scale b, where + !! Z is defined as + !! Z = [ kron(In, A) -kron(B**T, Im) ] (2) + !! [ kron(In, D) -kron(E**T, Im) ]. + !! Here Ik is the identity matrix of size k and X**T is the transpose of + !! X. kron(X, Y) is the Kronecker product between the matrices X and Y. + !! If TRANS = 'T', DTGSYL solves the transposed system Z**T*y = scale*b, + !! which is equivalent to solve for R and L in + !! A**T * R + D**T * L = scale * C (3) + !! R * B**T + L * E**T = scale * -F + !! This case (TRANS = 'T') is used to compute an one-norm-based estimate + !! of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D) + !! and (B,E), using DLACON. + !! If IJOB >= 1, DTGSYL computes a Frobenius norm-based estimate + !! of Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the + !! reciprocal of the smallest singular value of Z. See [1-2] for more + !! information. + !! This is a level 3 BLAS algorithm. ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42918,12 +42914,12 @@ module stdlib_linalg_lapack_d subroutine stdlib_dtpcon( norm, uplo, diag, n, ap, rcond, work, iwork,info ) - !> DTPCON estimates the reciprocal of the condition number of a packed - !> triangular matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! DTPCON estimates the reciprocal of the condition number of a packed + !! triangular matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43017,9 +43013,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) - !> DTPLQT2 computes a LQ a factorization of a real "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. + !! DTPLQT2 computes a LQ a factorization of a real "triangular-pentagonal" + !! matrix C, which is composed of a triangular block A and pentagonal block B, + !! using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43114,9 +43110,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, ldb, & - !> DTPMQRT applies a real orthogonal matrix Q obtained from a - !> "triangular-pentagonal" real block reflector H to a general - !> real matrix C, which consists of two blocks A and B. + !! DTPMQRT applies a real orthogonal matrix Q obtained from a + !! "triangular-pentagonal" real block reflector H to a general + !! real matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43232,9 +43228,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, ldb, & - !> DTPMQRT applies a real orthogonal matrix Q obtained from a - !> "triangular-pentagonal" real block reflector H to a general - !> real matrix C, which consists of two blocks A and B. + !! DTPMQRT applies a real orthogonal matrix Q obtained from a + !! "triangular-pentagonal" real block reflector H to a general + !! real matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43352,9 +43348,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) - !> DTPQRT2 computes a QR factorization of a real "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. + !! DTPQRT2 computes a QR factorization of a real "triangular-pentagonal" + !! matrix C, which is composed of a triangular block A and pentagonal block B, + !! using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43443,12 +43439,12 @@ module stdlib_linalg_lapack_d subroutine stdlib_dtrcon( norm, uplo, diag, n, a, lda, rcond, work,iwork, info ) - !> DTRCON estimates the reciprocal of the condition number of a - !> triangular matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! DTRCON estimates the reciprocal of the condition number of a + !! triangular matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43544,12 +43540,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtzrzf( m, n, a, lda, tau, work, lwork, info ) - !> DTZRZF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A - !> to upper triangular form by means of orthogonal transformations. - !> The upper trapezoidal matrix A is factored as - !> A = ( R 0 ) * Z, - !> where Z is an N-by-N orthogonal matrix and R is an M-by-M upper - !> triangular matrix. + !! DTZRZF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A + !! to upper triangular form by means of orthogonal transformations. + !! The upper trapezoidal matrix A is factored as + !! A = ( R 0 ) * Z, + !! where Z is an N-by-N orthogonal matrix and R is an M-by-M upper + !! triangular matrix. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43660,14 +43656,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) - !> DGBSV computes the solution to a real 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. + !! DGBSV computes the solution to a real 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43712,12 +43708,12 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & - !> DGBSVX uses the LU factorization to compute the solution to a real - !> system of linear equations A * X = B, A**T * X = B, or A**H * 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. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DGBSVX uses the LU factorization to compute the solution to a real + !! system of linear equations A * X = B, A**T * X = B, or A**H * 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. + !! Error bounds on the solution and a condition estimate are also + !! provided. c, b, ldb, x, ldx,rcond, ferr, berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43935,14 +43931,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgebal( job, n, a, lda, ilo, ihi, scale, info ) - !> DGEBAL balances a general real 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. + !! DGEBAL balances a general real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44103,9 +44099,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgebd2( m, n, a, lda, d, e, tauq, taup, work, info ) - !> DGEBD2 reduces a real general m by n matrix A to upper or lower - !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. - !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. + !! DGEBD2 reduces a real general m by n matrix A to upper or lower + !! bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. + !! If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44195,8 +44191,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgehd2( n, ilo, ihi, a, lda, tau, work, info ) - !> DGEHD2 reduces a real general matrix A to upper Hessenberg form H by - !> an orthogonal similarity transformation: Q**T * A * Q = H . + !! DGEHD2 reduces a real general matrix A to upper Hessenberg form H by + !! an orthogonal similarity transformation: Q**T * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44247,12 +44243,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgelq2( m, n, a, lda, tau, work, info ) - !> DGELQ2 computes an LQ factorization of a real 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. + !! DGELQ2 computes an LQ factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44301,12 +44297,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgelqf( m, n, a, lda, tau, work, lwork, info ) - !> DGELQF computes an LQ factorization of a real 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. + !! DGELQF computes an LQ factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44398,10 +44394,10 @@ module stdlib_linalg_lapack_d pure recursive subroutine stdlib_dgelqt3( m, n, a, lda, t, ldt, info ) - !> DGELQT3 recursively computes a LQ factorization of a real 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. + !! DGELQT3 recursively computes a LQ factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44485,8 +44481,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgeql2( m, n, a, lda, tau, work, info ) - !> DGEQL2 computes a QL factorization of a real m by n matrix A: - !> A = Q * L. + !! DGEQL2 computes a QL factorization of a real m by n matrix A: + !! A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44534,8 +44530,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgeqlf( m, n, a, lda, tau, work, lwork, info ) - !> DGEQLF computes a QL factorization of a real M-by-N matrix A: - !> A = Q * L. + !! DGEQLF computes a QL factorization of a real M-by-N matrix A: + !! A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44640,13 +44636,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgeqr2( m, n, a, lda, tau, work, info ) - !> DGEQR2 computes a QR factorization of a real 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. + !! DGEQR2 computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44695,14 +44691,14 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgeqr2p( m, n, a, lda, tau, work, info ) - !> DGEQR2P computes a QR factorization of a real 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. + !! DGEQR2P computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44751,13 +44747,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgeqrf( m, n, a, lda, tau, work, lwork, info ) - !> DGEQRF computes a QR factorization of a real 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. + !! DGEQRF computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44853,14 +44849,14 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgeqrfp( m, n, a, lda, tau, work, lwork, info ) - !> DGEQR2P computes a QR factorization of a real 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. + !! DGEQR2P computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44952,8 +44948,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgeqrt2( m, n, a, lda, t, ldt, info ) - !> DGEQRT2 computes a QR factorization of a real M-by-N matrix A, - !> using the compact WY representation of Q. + !! DGEQRT2 computes a QR factorization of a real M-by-N matrix A, + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45020,10 +45016,10 @@ module stdlib_linalg_lapack_d pure recursive subroutine stdlib_dgeqrt3( m, n, a, lda, t, ldt, info ) - !> DGEQRT3 recursively computes a QR factorization of a real 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. + !! DGEQRT3 recursively computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45105,9 +45101,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & - !> DGERFS improves the computed solution to a system of linear - !> equations and provides error bounds and backward error estimates for - !> the solution. + !! DGERFS improves the computed solution to a system of linear + !! equations and provides error bounds and backward error estimates for + !! the solution. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45298,8 +45294,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgerq2( m, n, a, lda, tau, work, info ) - !> DGERQ2 computes an RQ factorization of a real m by n matrix A: - !> A = R * Q. + !! DGERQ2 computes an RQ factorization of a real m by n matrix A: + !! A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45347,8 +45343,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgerqf( m, n, a, lda, tau, work, lwork, info ) - !> DGERQF computes an RQ factorization of a real M-by-N matrix A: - !> A = R * Q. + !! DGERQF computes an RQ factorization of a real M-by-N matrix A: + !! A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45453,14 +45449,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgetrf( m, n, a, lda, ipiv, info ) - !> DGETRF 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. + !! DGETRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45531,31 +45527,31 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & - !> DGGHD3 reduces a pair of real matrices (A,B) to generalized upper - !> Hessenberg form using orthogonal 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 orthogonal matrix Q to the left side - !> of the equation. - !> This subroutine simultaneously reduces A to a Hessenberg matrix H: - !> Q**T*A*Z = H - !> and transforms B to another upper triangular matrix T: - !> Q**T*B*Z = T - !> in order to reduce the problem to its standard form - !> H*y = lambda*T*y - !> where y = Z**T*x. - !> The orthogonal 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**T = (Q1*Q) * H * (Z1*Z)**T - !> Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T - !> If Q1 is the orthogonal matrix from the QR factorization of B in the - !> original equation A*x = lambda*B*x, then DGGHD3 reduces the original - !> problem to generalized Hessenberg form. - !> This is a blocked variant of DGGHRD, using matrix-matrix - !> multiplications for parts of the computation to enhance performance. + !! DGGHD3 reduces a pair of real matrices (A,B) to generalized upper + !! Hessenberg form using orthogonal 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 orthogonal matrix Q to the left side + !! of the equation. + !! This subroutine simultaneously reduces A to a Hessenberg matrix H: + !! Q**T*A*Z = H + !! and transforms B to another upper triangular matrix T: + !! Q**T*B*Z = T + !! in order to reduce the problem to its standard form + !! H*y = lambda*T*y + !! where y = Z**T*x. + !! The orthogonal 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**T = (Q1*Q) * H * (Z1*Z)**T + !! Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T + !! If Q1 is the orthogonal matrix from the QR factorization of B in the + !! original equation A*x = lambda*B*x, then DGGHD3 reduces the original + !! problem to generalized Hessenberg form. + !! This is a blocked variant of DGGHRD, using matrix-matrix + !! multiplications for parts of the computation to enhance performance. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46058,24 +46054,24 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) - !> DGGQRF 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 orthogonal matrix, Z is a P-by-P orthogonal - !> 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**T*(inv(T)*R) - !> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the - !> transpose of the matrix Z. + !! DGGQRF 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 orthogonal matrix, Z is a P-by-P orthogonal + !! 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**T*(inv(T)*R) + !! where inv(B) denotes the inverse of the matrix B, and Z**T denotes the + !! transpose of the matrix Z. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46136,24 +46132,24 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) - !> DGGRQF 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 orthogonal matrix, Z is a P-by-P orthogonal - !> 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**T - !> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the - !> transpose of the matrix Z. + !! DGGRQF 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 orthogonal matrix, Z is a P-by-P orthogonal + !! 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**T + !! where inv(B) denotes the inverse of the matrix B, and Z**T denotes the + !! transpose of the matrix Z. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46214,10 +46210,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & - !> DGSVJ0 is called from DGESVJ as a pre-processor and that is its main - !> purpose. It applies Jacobi rotations in the same way as DGESVJ does, but - !> it does not check convergence (stopping criterion). Few tuning - !> parameters (marked by [TP]) are available for the implementer. + !! DGSVJ0 is called from DGESVJ as a pre-processor and that is its main + !! purpose. It applies Jacobi rotations in the same way as DGESVJ does, but + !! it does not check convergence (stopping criterion). Few tuning + !! parameters (marked by [TP]) are available for the implementer. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46862,30 +46858,30 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & - !> DGSVJ1 is called from DGESVJ as a pre-processor and that is its main - !> purpose. It applies Jacobi rotations in the same way as DGESVJ 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 - !> ~~~~~~~~~~~~~~~ - !> DGSVJ1 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. + !! DGSVJ1 is called from DGESVJ as a pre-processor and that is its main + !! purpose. It applies Jacobi rotations in the same way as DGESVJ 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 + !! ~~~~~~~~~~~~~~~ + !! DGSVJ1 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. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47293,11 +47289,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, iwork, info & - !> DGTCON estimates the reciprocal of the condition number of a real - !> tridiagonal matrix A using the LU factorization as computed by - !> DGTTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! DGTCON estimates the reciprocal of the condition number of a real + !! tridiagonal matrix A using the LU factorization as computed by + !! DGTTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47376,9 +47372,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, x, & - !> DGTRFS 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. + !! DGTRFS 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. ldx, ferr, berr, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47578,12 +47574,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & - !> DGTSVX uses the LU factorization to compute the solution to a real - !> system of linear equations A * X = B or A**T * X = B, - !> where A is a tridiagonal matrix of order N and X and B are N-by-NRHS - !> matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DGTSVX uses the LU factorization to compute the solution to a real + !! system of linear equations A * X = B or A**T * X = B, + !! where A is a tridiagonal matrix of order N and X and B are N-by-NRHS + !! matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ldb, x, ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47667,49 +47663,49 @@ module stdlib_linalg_lapack_d subroutine stdlib_dhgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alphar, alphai, & - !> DHGEQZ computes the eigenvalues of a real 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 real matrix pair (A,B): - !> A = Q1*H*Z1**T, B = Q1*T*Z1**T, - !> as computed by DGGHRD. - !> If JOB='S', then the Hessenberg-triangular pair (H,T) is - !> also reduced to generalized Schur form, - !> H = Q*S*Z**T, T = Q*P*Z**T, - !> where Q and Z are orthogonal matrices, P is an upper triangular - !> matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2 - !> diagonal blocks. - !> The 1-by-1 blocks correspond to real eigenvalues of the matrix pair - !> (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of - !> eigenvalues. - !> Additionally, the 2-by-2 upper triangular diagonal blocks of P - !> corresponding to 2-by-2 blocks of S are reduced to positive diagonal - !> form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0, - !> P(j,j) > 0, and P(j+1,j+1) > 0. - !> Optionally, the orthogonal matrix Q from the generalized Schur - !> factorization may be postmultiplied into an input matrix Q1, and the - !> orthogonal matrix Z may be postmultiplied into an input matrix Z1. - !> If Q1 and Z1 are the orthogonal matrices from DGGHRD that reduced - !> the matrix pair (A,B) to generalized upper Hessenberg form, then the - !> output matrices Q1*Q and Z1*Z are the orthogonal factors from the - !> generalized Schur factorization of (A,B): - !> A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T. - !> 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. - !> Real 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. + !! DHGEQZ computes the eigenvalues of a real 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 real matrix pair (A,B): + !! A = Q1*H*Z1**T, B = Q1*T*Z1**T, + !! as computed by DGGHRD. + !! If JOB='S', then the Hessenberg-triangular pair (H,T) is + !! also reduced to generalized Schur form, + !! H = Q*S*Z**T, T = Q*P*Z**T, + !! where Q and Z are orthogonal matrices, P is an upper triangular + !! matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2 + !! diagonal blocks. + !! The 1-by-1 blocks correspond to real eigenvalues of the matrix pair + !! (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of + !! eigenvalues. + !! Additionally, the 2-by-2 upper triangular diagonal blocks of P + !! corresponding to 2-by-2 blocks of S are reduced to positive diagonal + !! form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0, + !! P(j,j) > 0, and P(j+1,j+1) > 0. + !! Optionally, the orthogonal matrix Q from the generalized Schur + !! factorization may be postmultiplied into an input matrix Q1, and the + !! orthogonal matrix Z may be postmultiplied into an input matrix Z1. + !! If Q1 and Z1 are the orthogonal matrices from DGGHRD that reduced + !! the matrix pair (A,B) to generalized upper Hessenberg form, then the + !! output matrices Q1*Q and Z1*Z are the orthogonal factors from the + !! generalized Schur factorization of (A,B): + !! A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T. + !! 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. + !! Real 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. beta, q, ldq, z, ldz, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48542,13 +48538,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) - !> DLABRD reduces the first NB rows and columns of a real general - !> m by n matrix A to upper or lower bidiagonal form by an orthogonal - !> transformation Q**T * 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 DGEBRD + !! DLABRD reduces the first NB rows and columns of a real general + !! m by n matrix A to upper or lower bidiagonal form by an orthogonal + !! transformation Q**T * 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 DGEBRD ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48672,13 +48668,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dladiv( a, b, c, d, p, q ) - !> DLADIV 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" + !! DLADIV 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" ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48740,16 +48736,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaed4( n, i, d, z, delta, rho, dlam, info ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49345,12 +49341,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaed8( icompq, k, n, qsiz, d, q, ldq, indxq, rho,cutpnt, z, dlamda, & - !> DLAED8 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. + !! DLAED8 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. q2, ldq2, w, perm, givptr,givcol, givnum, indxp, indx, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49568,10 +49564,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaed9( k, kstart, kstop, n, d, q, ldq, rho, dlamda, w,s, lds, info ) - !> DLAED9 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. + !! DLAED9 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49674,9 +49670,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaein( rightv, noinit, n, h, ldh, wr, wi, vr, vi, b,ldb, work, eps3, & - !> DLAEIN uses inverse iteration to find a right or left eigenvector - !> corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg - !> matrix H. + !! DLAEIN uses inverse iteration to find a right or left eigenvector + !! corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg + !! matrix H. smlnum, bignum, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50020,23 +50016,23 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlagv2( a, lda, b, ldb, alphar, alphai, beta, csl, snl,csr, snr ) - !> DLAGV2 computes the Generalized Schur factorization of a real 2-by-2 - !> matrix pencil (A,B) where B is upper triangular. This routine - !> computes orthogonal (rotation) matrices given by CSL, SNL and CSR, - !> SNR such that - !> 1) if the pencil (A,B) has two real eigenvalues (include 0/0 or 1/0 - !> types), then - !> [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ] - !> [ 0 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ] - !> [ b11 b12 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] - !> [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ], - !> 2) if the pencil (A,B) has a pair of complex conjugate eigenvalues, - !> then - !> [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ] - !> [ a21 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ] - !> [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] - !> [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ] - !> where b11 >= b22 > 0. + !! DLAGV2 computes the Generalized Schur factorization of a real 2-by-2 + !! matrix pencil (A,B) where B is upper triangular. This routine + !! computes orthogonal (rotation) matrices given by CSL, SNL and CSR, + !! SNR such that + !! 1) if the pencil (A,B) has two real eigenvalues (include 0/0 or 1/0 + !! types), then + !! [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ] + !! [ 0 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ] + !! [ b11 b12 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] + !! [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ], + !! 2) if the pencil (A,B) has a pair of complex conjugate eigenvalues, + !! then + !! [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ] + !! [ a21 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ] + !! [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] + !! [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ] + !! where b11 >= b22 > 0. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50184,12 +50180,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) - !> DLAHR2 reduces the first NB columns of A real general n-BY-(n-k+1) - !> matrix A so that elements below the k-th subdiagonal are zero. The - !> reduction is performed by an orthogonal similarity transformation - !> Q**T * A * Q. The routine returns the matrices V and T which determine - !> Q as a block reflector I - V*T*V**T, and also the matrix Y = A * V * T. - !> This is an auxiliary routine called by DGEHRD. + !! DLAHR2 reduces the first NB columns of A real general n-BY-(n-k+1) + !! matrix A so that elements below the k-th subdiagonal are zero. The + !! reduction is performed by an orthogonal similarity transformation + !! Q**T * A * Q. The routine returns the matrices V and T which determine + !! Q as a block reflector I - V*T*V**T, and also the matrix Y = A * V * T. + !! This is an auxiliary routine called by DGEHRD. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50272,31 +50268,31 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaln2( ltrans, na, nw, smin, ca, a, lda, d1, d2, b,ldb, wr, wi, x, & - !> DLALN2 solves a system of the form (ca A - w D ) X = s B - !> or (ca A**T - w D) X = s B with possible scaling ("s") and - !> perturbation of A. (A**T means A-transpose.) - !> A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA - !> real diagonal matrix, w is a real or complex value, and X and B are - !> NA x 1 matrices -- real if w is real, complex if w is complex. NA - !> may be 1 or 2. - !> If w is complex, X and B are represented as NA x 2 matrices, - !> the first column of each being the real part and the second - !> being the imaginary part. - !> "s" is a scaling factor (<= 1), computed by DLALN2, which is - !> so chosen that X can be computed without overflow. X is further - !> scaled if necessary to assure that norm(ca A - w D)*norm(X) is less - !> than overflow. - !> If both singular values of (ca A - w D) are less than SMIN, - !> SMIN*identity will be used instead of (ca A - w D). If only one - !> singular value is less than SMIN, one element of (ca A - w D) will be - !> perturbed enough to make the smallest singular value roughly SMIN. - !> If both singular values are at least SMIN, (ca A - w D) will not be - !> perturbed. In any case, the perturbation will be at most some small - !> multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values - !> are computed by infinity-norm approximations, and thus will only be - !> correct to a factor of 2 or so. - !> Note: all input quantities are assumed to be smaller than overflow - !> by a reasonable factor. (See BIGNUM.) + !! DLALN2 solves a system of the form (ca A - w D ) X = s B + !! or (ca A**T - w D) X = s B with possible scaling ("s") and + !! perturbation of A. (A**T means A-transpose.) + !! A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA + !! real diagonal matrix, w is a real or complex value, and X and B are + !! NA x 1 matrices -- real if w is real, complex if w is complex. NA + !! may be 1 or 2. + !! If w is complex, X and B are represented as NA x 2 matrices, + !! the first column of each being the real part and the second + !! being the imaginary part. + !! "s" is a scaling factor (<= 1), computed by DLALN2, which is + !! so chosen that X can be computed without overflow. X is further + !! scaled if necessary to assure that norm(ca A - w D)*norm(X) is less + !! than overflow. + !! If both singular values of (ca A - w D) are less than SMIN, + !! SMIN*identity will be used instead of (ca A - w D). If only one + !! singular value is less than SMIN, one element of (ca A - w D) will be + !! perturbed enough to make the smallest singular value roughly SMIN. + !! If both singular values are at least SMIN, (ca A - w D) will not be + !! perturbed. In any case, the perturbation will be at most some small + !! multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values + !! are computed by infinity-norm approximations, and thus will only be + !! correct to a factor of 2 or so. + !! Note: all input quantities are assumed to be smaller than overflow + !! by a reasonable factor. (See BIGNUM.) ldx, scale, xnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50597,26 +50593,26 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, & - !> DLALS0 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). + !! DLALS0 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). givcol, ldgcol, givnum, ldgnum,poles, difl, difr, z, k, c, s, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50794,13 +50790,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & - !> DLAMSWLQ overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of blocked - !> elementary reflectors computed by short wide LQ - !> factorization (DLASWLQ) + !! DLAMSWLQ overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of blocked + !! elementary reflectors computed by short wide LQ + !! factorization (DLASWLQ) lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50952,13 +50948,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & - !> DLAMTSQR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product - !> of blocked elementary reflectors computed by tall skinny - !> QR factorization (DLATSQR) + !! DLAMTSQR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product + !! of blocked elementary reflectors computed by tall skinny + !! QR factorization (DLATSQR) lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51114,14 +51110,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlanv2( a, b, c, d, rt1r, rt1i, rt2r, rt2i, cs, sn ) - !> DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric - !> matrix in standard form: - !> [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ] - !> [ C D ] [ SN CS ] [ CC DD ] [-SN CS ] - !> where either - !> 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or - !> 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex - !> conjugate eigenvalues. + !! DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric + !! matrix in standard form: + !! [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ] + !! [ C D ] [ SN CS ] [ CC DD ] [-SN CS ] + !! where either + !! 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or + !! 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex + !! conjugate eigenvalues. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51260,12 +51256,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlapll( n, x, incx, y, incy, ssmin ) - !> 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. + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51300,9 +51296,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaqp2( m, n, offset, a, lda, jpvt, tau, vn1, vn2,work ) - !> DLAQP2 computes a QR factorization with column pivoting of - !> the block A(OFFSET+1:M,1:N). - !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. + !! DLAQP2 computes a QR factorization with column pivoting of + !! the block A(OFFSET+1:M,1:N). + !! The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51377,14 +51373,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & - !> DLAQPS computes a step of QR factorization with column pivoting - !> of a real 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. + !! DLAQPS computes a step of QR factorization with column pivoting + !! of a real 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. ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51511,8 +51507,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts,sr, si, h, ldh, & - !> DLAQR5 , called by DLAQR0, performs a - !> single small-bulge multi-shift QR sweep. + !! DLAQR5 , called by DLAQR0, performs a + !! single small-bulge multi-shift QR sweep. iloz, ihiz, z, ldz, v, ldv, u,ldu, nv, wv, ldwv, nh, wh, ldwh ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51918,24 +51914,24 @@ module stdlib_linalg_lapack_d subroutine stdlib_dlaqtr( ltran, lreal, n, t, ldt, b, w, scale, x, work,info ) - !> DLAQTR 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. + !! DLAQTR 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52364,17 +52360,17 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasd3( nl, nr, sqre, k, d, q, ldq, dsigma, u, ldu, u2,ldu2, vt, ldvt,& - !> DLASD3 finds all the square roots of the roots of the secular - !> equation, as defined by the values in D and Z. It makes the - !> appropriate calls to DLASD4 and then updates the singular - !> vectors by matrix multiplication. - !> 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. - !> DLASD3 is called from DLASD1. + !! DLASD3 finds all the square roots of the roots of the secular + !! equation, as defined by the values in D and Z. It makes the + !! appropriate calls to DLASD4 and then updates the singular + !! vectors by matrix multiplication. + !! 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. + !! DLASD3 is called from DLASD1. vt2, ldvt2, idxc, ctot, z,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52566,41 +52562,41 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasd6( icompq, nl, nr, sqre, d, vf, vl, alpha, beta,idxq, perm, & - !> DLASD6 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. - !> DLASD6 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 DLASD6. 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. - !> DLASD6 is called from DLASDA. + !! DLASD6 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. + !! DLASD6 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 DLASD6. 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. + !! DLASD6 is called from DLASDA. givptr, givcol, ldgcol, givnum,ldgnum, poles, difl, difr, z, k, c, s, work,iwork, info ) ! -- lapack auxiliary routine -- @@ -52694,11 +52690,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dopgtr( uplo, n, ap, tau, q, ldq, work, info ) - !> DOPGTR generates a real orthogonal matrix Q which is defined as the - !> product of n-1 elementary reflectors H(i) of order n, as returned by - !> DSPTRD using packed storage: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! DOPGTR generates a real orthogonal matrix Q which is defined as the + !! product of n-1 elementary reflectors H(i) of order n, as returned by + !! DSPTRD using packed storage: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52781,16 +52777,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dopmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) - !> DOPMTR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by DSPTRD using packed - !> storage: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! DOPMTR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by DSPTRD using packed + !! storage: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52928,21 +52924,21 @@ module stdlib_linalg_lapack_d subroutine stdlib_dorbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> DORBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, - !> M-P, or M-Q. Routines DORBDB2, DORBDB3, and DORBDB4 handle cases in - !> which Q is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! DORBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, + !! M-P, or M-Q. Routines DORBDB2, DORBDB3, and DORBDB4 handle cases in + !! which Q is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by + !! angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53031,21 +53027,21 @@ module stdlib_linalg_lapack_d subroutine stdlib_dorbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> DORBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, - !> Q, or M-Q. Routines DORBDB1, DORBDB3, and DORBDB4 handle cases in - !> which P is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! DORBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, + !! Q, or M-Q. Routines DORBDB1, DORBDB3, and DORBDB4 handle cases in + !! which P is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are P-by-P bidiagonal matrices represented implicitly by + !! angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53144,21 +53140,21 @@ module stdlib_linalg_lapack_d subroutine stdlib_dorbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> DORBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, - !> Q, or M-Q. Routines DORBDB1, DORBDB2, and DORBDB4 handle cases in - !> which M-P is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! DORBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, + !! Q, or M-Q. Routines DORBDB1, DORBDB2, and DORBDB4 handle cases in + !! which M-P is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53256,21 +53252,21 @@ module stdlib_linalg_lapack_d subroutine stdlib_dorbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> DORBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, - !> M-P, or Q. Routines DORBDB1, DORBDB2, and DORBDB3 handle cases in - !> which M-Q is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! DORBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, + !! M-P, or Q. Routines DORBDB1, DORBDB2, and DORBDB3 handle cases in + !! which M-Q is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53398,21 +53394,21 @@ module stdlib_linalg_lapack_d subroutine stdlib_dorcsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & - !> DORCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with - !> orthonormal columns that has been partitioned into a 2-by-1 block - !> structure: - !> [ I1 0 0 ] - !> [ 0 C 0 ] - !> [ X11 ] [ U1 | ] [ 0 0 0 ] - !> X = [-----] = [---------] [----------] V1**T . - !> [ X21 ] [ | U2 ] [ 0 0 0 ] - !> [ 0 S 0 ] - !> [ 0 0 I2] - !> X11 is P-by-Q. The orthogonal matrices U1, U2, and V1 are P-by-P, - !> (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R - !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which - !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a - !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). + !! DORCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with + !! orthonormal columns that has been partitioned into a 2-by-1 block + !! structure: + !! [ I1 0 0 ] + !! [ 0 C 0 ] + !! [ X11 ] [ U1 | ] [ 0 0 0 ] + !! X = [-----] = [---------] [----------] V1**T . + !! [ X21 ] [ | U2 ] [ 0 0 0 ] + !! [ 0 S 0 ] + !! [ 0 0 I2] + !! X11 is P-by-Q. The orthogonal matrices U1, U2, and V1 are P-by-P, + !! (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R + !! nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which + !! R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a + !! K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, iwork, info ) ! -- lapack computational routine (3.5.0_dp) -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53813,11 +53809,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorgtr( uplo, n, a, lda, tau, work, lwork, info ) - !> DORGTR generates a real orthogonal matrix Q which is defined as the - !> product of n-1 elementary reflectors of order N, as returned by - !> DSYTRD: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! DORGTR generates a real orthogonal matrix Q which is defined as the + !! product of n-1 elementary reflectors of order N, as returned by + !! DSYTRD: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53914,11 +53910,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorgtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) - !> DORGTSQR generates an M-by-N real matrix Q_out with orthonormal columns, - !> which are the first N columns of a product of real orthogonal - !> matrices of order M which are returned by DLATSQR - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> See the documentation for DLATSQR. + !! DORGTSQR generates an M-by-N real matrix Q_out with orthonormal columns, + !! which are the first N columns of a product of real orthogonal + !! matrices of order M which are returned by DLATSQR + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! See the documentation for DLATSQR. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54012,15 +54008,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dormtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & - !> DORMTR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by DSYTRD: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! DORMTR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by DSYTRD: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54128,12 +54124,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpbtrf( uplo, n, kd, ab, ldab, info ) - !> DPBTRF computes the Cholesky factorization of a real symmetric - !> positive definite band matrix A. - !> The factorization has the form - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. + !! DPBTRF computes the Cholesky factorization of a real symmetric + !! positive definite band matrix A. + !! The factorization has the form + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54327,9 +54323,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpftri( transr, uplo, n, a, info ) - !> DPFTRI computes the inverse of a (real) symmetric positive definite - !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T - !> computed by DPFTRF. + !! DPFTRI computes the inverse of a (real) symmetric positive definite + !! matrix A using the Cholesky factorization A = U**T*U or A = L*L**T + !! computed by DPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54485,13 +54481,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpotrf( uplo, n, a, lda, info ) - !> DPOTRF computes the Cholesky factorization of a real symmetric - !> positive definite matrix A. - !> The factorization has the form - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the block version of the algorithm, calling Level 3 BLAS. + !! DPOTRF computes the Cholesky factorization of a real symmetric + !! positive definite matrix A. + !! The factorization has the form + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the block version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54579,10 +54575,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dptrfs( n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr,berr, work, info ) - !> DPTRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric positive definite - !> and tridiagonal, and provides error bounds and backward error - !> estimates for the solution. + !! DPTRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric positive definite + !! and tridiagonal, and provides error bounds and backward error + !! estimates for the solution. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54751,11 +54747,11 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dptsv( n, nrhs, d, e, b, ldb, info ) - !> DPTSV computes the solution to a real system of linear equations - !> A*X = B, where A is an N-by-N symmetric positive definite tridiagonal - !> matrix, and X and B are N-by-NRHS matrices. - !> A is factored as A = L*D*L**T, and the factored form of A is then - !> used to solve the system of equations. + !! DPTSV computes the solution to a real system of linear equations + !! A*X = B, where A is an N-by-N symmetric positive definite tridiagonal + !! matrix, and X and B are N-by-NRHS matrices. + !! A is factored as A = L*D*L**T, and the factored form of A is then + !! used to solve the system of equations. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54792,12 +54788,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& - !> DPTSVX uses the factorization A = L*D*L**T to compute the solution - !> to a real system of linear equations A*X = B, where A is an N-by-N - !> symmetric positive definite tridiagonal matrix and X and B are - !> N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DPTSVX uses the factorization A = L*D*L**T to compute the solution + !! to a real system of linear equations A*X = B, where A is an N-by-N + !! symmetric positive definite tridiagonal matrix and X and B are + !! N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. work, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54866,8 +54862,8 @@ module stdlib_linalg_lapack_d subroutine stdlib_dsbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,info ) - !> DSBEV computes all the eigenvalues and, optionally, eigenvectors of - !> a real symmetric band matrix A. + !! DSBEV computes all the eigenvalues and, optionally, eigenvectors of + !! a real symmetric band matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54968,10 +54964,10 @@ module stdlib_linalg_lapack_d subroutine stdlib_dsbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & - !> DSBEVX computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric band matrix A. Eigenvalues and eigenvectors can - !> be selected by specifying either a range of values or a range of - !> indices for the desired eigenvalues. + !! DSBEVX computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric band matrix A. Eigenvalues and eigenvectors can + !! be selected by specifying either a range of values or a range of + !! indices for the desired eigenvalues. m, w, z, ldz, work, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55194,10 +55190,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & - !> DSBGV computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-definite banded eigenproblem, of - !> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric - !> and banded, and B is also positive definite. + !! DSBGV computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-definite banded eigenproblem, of + !! the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric + !! and banded, and B is also positive definite. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55272,12 +55268,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & - !> DSBGVX computes selected eigenvalues, and optionally, eigenvectors - !> of a real generalized symmetric-definite banded eigenproblem, of - !> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric - !> and banded, and B is also positive definite. Eigenvalues and - !> eigenvectors can be selected by specifying either all eigenvalues, - !> a range of values or a range of indices for the desired eigenvalues. + !! DSBGVX computes selected eigenvalues, and optionally, eigenvectors + !! of a real generalized symmetric-definite banded eigenproblem, of + !! the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric + !! and banded, and B is also positive definite. Eigenvalues and + !! eigenvectors can be selected by specifying either all eigenvalues, + !! a range of values or a range of indices for the desired eigenvalues. vu, il, iu, abstol, m, w, z,ldz, work, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55457,33 +55453,33 @@ module stdlib_linalg_lapack_d subroutine stdlib_dsgesv( n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work,swork, iter, info ) - !> DSGESV computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N matrix and X and B are N-by-NRHS matrices. - !> DSGESV first attempts to factorize the matrix in SINGLE PRECISION - !> and use this factorization within an iterative refinement procedure - !> to produce a solution with DOUBLE PRECISION normwise backward error - !> quality (see below). If the approach fails the method switches to a - !> DOUBLE PRECISION factorization and solve. - !> The iterative refinement is not going to be a winning strategy if - !> the ratio SINGLE PRECISION performance over DOUBLE PRECISION - !> performance is too small. A reasonable strategy should take the - !> number of right-hand sides and the size of the matrix into account. - !> This might be done with a call to ILAENV in the future. Up to now, we - !> always try iterative refinement. - !> The iterative refinement process is stopped if - !> ITER > ITERMAX - !> or for all the RHS we have: - !> RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX - !> where - !> o ITER is the number of the current iteration in the iterative - !> refinement process - !> o RNRM is the infinity-norm of the residual - !> o XNRM is the infinity-norm of the solution - !> o ANRM is the infinity-operator-norm of the matrix A - !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') - !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 - !> respectively. + !! DSGESV computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N matrix and X and B are N-by-NRHS matrices. + !! DSGESV first attempts to factorize the matrix in SINGLE PRECISION + !! and use this factorization within an iterative refinement procedure + !! to produce a solution with DOUBLE PRECISION normwise backward error + !! quality (see below). If the approach fails the method switches to a + !! DOUBLE PRECISION factorization and solve. + !! The iterative refinement is not going to be a winning strategy if + !! the ratio SINGLE PRECISION performance over DOUBLE PRECISION + !! performance is too small. A reasonable strategy should take the + !! number of right-hand sides and the size of the matrix into account. + !! This might be done with a call to ILAENV in the future. Up to now, we + !! always try iterative refinement. + !! The iterative refinement process is stopped if + !! ITER > ITERMAX + !! or for all the RHS we have: + !! RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX + !! where + !! o ITER is the number of the current iteration in the iterative + !! refinement process + !! o RNRM is the infinity-norm of the residual + !! o XNRM is the infinity-norm of the solution + !! o ANRM is the infinity-operator-norm of the matrix A + !! o EPS is the machine epsilon returned by DLAMCH('Epsilon') + !! The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 + !! respectively. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55637,8 +55633,8 @@ module stdlib_linalg_lapack_d subroutine stdlib_dspev( jobz, uplo, n, ap, w, z, ldz, work, info ) - !> DSPEV computes all the eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A in packed storage. + !! DSPEV computes all the eigenvalues and, optionally, eigenvectors of a + !! real symmetric matrix A in packed storage. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55730,10 +55726,10 @@ module stdlib_linalg_lapack_d subroutine stdlib_dspevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> DSPEVX computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric matrix A in packed storage. Eigenvalues/vectors - !> can be selected by specifying either a range of values or a range of - !> indices for the desired eigenvalues. + !! DSPEVX computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric matrix A in packed storage. Eigenvalues/vectors + !! can be selected by specifying either a range of values or a range of + !! indices for the desired eigenvalues. work, iwork, ifail,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55943,11 +55939,11 @@ module stdlib_linalg_lapack_d subroutine stdlib_dspgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,info ) - !> DSPGV computes all the eigenvalues and, optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric, stored in packed format, - !> and B is also positive definite. + !! DSPGV computes all the eigenvalues and, optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric, stored in packed format, + !! and B is also positive definite. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56027,13 +56023,13 @@ module stdlib_linalg_lapack_d subroutine stdlib_dspgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & - !> DSPGVX computes selected eigenvalues, and optionally, eigenvectors - !> of a real generalized symmetric-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 symmetric, stored in packed storage, and B - !> is also positive definite. Eigenvalues and eigenvectors can be - !> selected by specifying either a range of values or a range of indices - !> for the desired eigenvalues. + !! DSPGVX computes selected eigenvalues, and optionally, eigenvectors + !! of a real generalized symmetric-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 symmetric, stored in packed storage, and B + !! is also positive definite. Eigenvalues and eigenvectors can be + !! selected by specifying either a range of values or a range of indices + !! for the desired eigenvalues. z, ldz, work, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56139,34 +56135,34 @@ module stdlib_linalg_lapack_d subroutine stdlib_dsposv( uplo, n, nrhs, a, lda, b, ldb, x, ldx, work,swork, iter, info ) - !> DSPOSV computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> DSPOSV first attempts to factorize the matrix in SINGLE PRECISION - !> and use this factorization within an iterative refinement procedure - !> to produce a solution with DOUBLE PRECISION normwise backward error - !> quality (see below). If the approach fails the method switches to a - !> DOUBLE PRECISION factorization and solve. - !> The iterative refinement is not going to be a winning strategy if - !> the ratio SINGLE PRECISION performance over DOUBLE PRECISION - !> performance is too small. A reasonable strategy should take the - !> number of right-hand sides and the size of the matrix into account. - !> This might be done with a call to ILAENV in the future. Up to now, we - !> always try iterative refinement. - !> The iterative refinement process is stopped if - !> ITER > ITERMAX - !> or for all the RHS we have: - !> RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX - !> where - !> o ITER is the number of the current iteration in the iterative - !> refinement process - !> o RNRM is the infinity-norm of the residual - !> o XNRM is the infinity-norm of the solution - !> o ANRM is the infinity-operator-norm of the matrix A - !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') - !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 - !> respectively. + !! DSPOSV computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! DSPOSV first attempts to factorize the matrix in SINGLE PRECISION + !! and use this factorization within an iterative refinement procedure + !! to produce a solution with DOUBLE PRECISION normwise backward error + !! quality (see below). If the approach fails the method switches to a + !! DOUBLE PRECISION factorization and solve. + !! The iterative refinement is not going to be a winning strategy if + !! the ratio SINGLE PRECISION performance over DOUBLE PRECISION + !! performance is too small. A reasonable strategy should take the + !! number of right-hand sides and the size of the matrix into account. + !! This might be done with a call to ILAENV in the future. Up to now, we + !! always try iterative refinement. + !! The iterative refinement process is stopped if + !! ITER > ITERMAX + !! or for all the RHS we have: + !! RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX + !! where + !! o ITER is the number of the current iteration in the iterative + !! refinement process + !! o RNRM is the infinity-norm of the residual + !! o XNRM is the infinity-norm of the solution + !! o ANRM is the infinity-operator-norm of the matrix A + !! o EPS is the machine epsilon returned by DLAMCH('Epsilon') + !! The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 + !! respectively. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56318,8 +56314,8 @@ module stdlib_linalg_lapack_d subroutine stdlib_dsyev( jobz, uplo, n, a, lda, w, work, lwork, info ) - !> DSYEV computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A. + !! DSYEV computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56425,10 +56421,10 @@ module stdlib_linalg_lapack_d subroutine stdlib_dsyevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> DSYEVX computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric matrix A. Eigenvalues and eigenvectors can be - !> selected by specifying either a range of values or a range of indices - !> for the desired eigenvalues. + !! DSYEVX computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric matrix A. Eigenvalues and eigenvectors can be + !! selected by specifying either a range of values or a range of indices + !! for the desired eigenvalues. work, lwork, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56672,11 +56668,11 @@ module stdlib_linalg_lapack_d subroutine stdlib_dsygv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, info ) - !> DSYGV computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric and B is also - !> positive definite. + !! DSYGV computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric and B is also + !! positive definite. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56772,12 +56768,12 @@ module stdlib_linalg_lapack_d subroutine stdlib_dsygvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& - !> DSYGVX computes selected eigenvalues, and optionally, eigenvectors - !> of a real generalized symmetric-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 symmetric and B is also positive definite. - !> Eigenvalues and eigenvectors can be selected by specifying either a - !> range of values or a range of indices for the desired eigenvalues. + !! DSYGVX computes selected eigenvalues, and optionally, eigenvectors + !! of a real generalized symmetric-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 symmetric and B is also positive definite. + !! Eigenvalues and eigenvectors can be selected by specifying either a + !! range of values or a range of indices for the desired eigenvalues. m, w, z, ldz, work,lwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56900,17 +56896,17 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> DSYSV computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> The 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 symmetric 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. + !! DSYSV computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! The 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 symmetric 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56978,12 +56974,12 @@ module stdlib_linalg_lapack_d subroutine stdlib_dsysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & - !> DSYSVX uses the diagonal pivoting factorization to compute the - !> solution to a real system of linear equations A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DSYSVX uses the diagonal pivoting factorization to compute the + !! solution to a real system of linear equations A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ferr, berr, work, lwork,iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57075,9 +57071,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) - !> DSYTRD_SY2SB reduces a real symmetric matrix A to real symmetric - !> band-diagonal form AB by a orthogonal similarity transformation: - !> Q**T * A * Q = AB. + !! DSYTRD_SY2SB reduces a real symmetric matrix A to real symmetric + !! band-diagonal form AB by a orthogonal similarity transformation: + !! Q**T * A * Q = AB. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57251,24 +57247,24 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & - !> DTGEVC computes some or all of the right and/or left eigenvectors of - !> a pair of real matrices (S,P), where S is a quasi-triangular matrix - !> and P is upper triangular. Matrix pairs of this type are produced by - !> the generalized Schur factorization of a matrix pair (A,B): - !> A = Q*S*Z**T, B = Q*P*Z**T - !> as computed by DGGHRD + DHGEQZ. - !> The right eigenvector x and the left eigenvector y of (S,P) - !> corresponding to an eigenvalue w are defined by: - !> S*x = w*P*x, (y**H)*S = w*(y**H)*P, - !> where y**H denotes the conjugate tranpose of y. - !> The eigenvalues are not input to this routine, but are computed - !> directly from the diagonal blocks of S and P. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of (S,P), or the products Z*X and/or Q*Y, - !> where Z and Q are input matrices. - !> If Q and Z are the orthogonal factors from the generalized Schur - !> factorization of a matrix pair (A,B), then Z*X and Q*Y - !> are the matrices of right and left eigenvectors of (A,B). + !! DTGEVC computes some or all of the right and/or left eigenvectors of + !! a pair of real matrices (S,P), where S is a quasi-triangular matrix + !! and P is upper triangular. Matrix pairs of this type are produced by + !! the generalized Schur factorization of a matrix pair (A,B): + !! A = Q*S*Z**T, B = Q*P*Z**T + !! as computed by DGGHRD + DHGEQZ. + !! The right eigenvector x and the left eigenvector y of (S,P) + !! corresponding to an eigenvalue w are defined by: + !! S*x = w*P*x, (y**H)*S = w*(y**H)*P, + !! where y**H denotes the conjugate tranpose of y. + !! The eigenvalues are not input to this routine, but are computed + !! directly from the diagonal blocks of S and P. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of (S,P), or the products Z*X and/or Q*Y, + !! where Z and Q are input matrices. + !! If Q and Z are the orthogonal factors from the generalized Schur + !! factorization of a matrix pair (A,B), then Z*X and Q*Y + !! are the matrices of right and left eigenvectors of (A,B). mm, m, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57981,16 +57977,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, n1, n2, & - !> DTGEX2 swaps adjacent diagonal blocks (A11, B11) and (A22, B22) - !> of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair - !> (A, B) by an orthogonal equivalence transformation. - !> (A, B) must be in generalized real Schur canonical form (as returned - !> by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2 - !> diagonal blocks. B is upper triangular. - !> Optionally, the matrices Q and Z of generalized Schur vectors are - !> updated. - !> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T - !> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T + !! DTGEX2 swaps adjacent diagonal blocks (A11, B11) and (A22, B22) + !! of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair + !! (A, B) by an orthogonal equivalence transformation. + !! (A, B) must be in generalized real Schur canonical form (as returned + !! by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2 + !! diagonal blocks. B is upper triangular. + !! Optionally, the matrices Q and Z of generalized Schur vectors are + !! updated. + !! Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T + !! Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T work, lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58346,18 +58342,18 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & - !> DTGEXC reorders the generalized real Schur decomposition of a real - !> matrix pair (A,B) using an orthogonal equivalence transformation - !> (A, B) = Q * (A, B) * Z**T, - !> so that the diagonal block of (A, B) with row index IFST is moved - !> to row ILST. - !> (A, B) must be in generalized real Schur canonical form (as returned - !> by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2 - !> diagonal blocks. B is upper triangular. - !> Optionally, the matrices Q and Z of generalized Schur vectors are - !> updated. - !> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T - !> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T + !! DTGEXC reorders the generalized real Schur decomposition of a real + !! matrix pair (A,B) using an orthogonal equivalence transformation + !! (A, B) = Q * (A, B) * Z**T, + !! so that the diagonal block of (A, B) with row index IFST is moved + !! to row ILST. + !! (A, B) must be in generalized real Schur canonical form (as returned + !! by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2 + !! diagonal blocks. B is upper triangular. + !! Optionally, the matrices Q and Z of generalized Schur vectors are + !! updated. + !! Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T + !! Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58595,26 +58591,26 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alphar, alphai, & - !> DTGSEN reorders the generalized real Schur decomposition of a real - !> matrix pair (A, B) (in terms of an orthonormal equivalence trans- - !> formation Q**T * (A, B) * Z), so that a selected cluster of eigenvalues - !> appears in the leading diagonal blocks of the upper quasi-triangular - !> matrix A and the upper triangular B. The leading columns of Q and - !> Z form orthonormal bases of the corresponding left and right eigen- - !> spaces (deflating subspaces). (A, B) must be in generalized real - !> Schur canonical form (as returned by DGGES), i.e. A is block upper - !> triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper - !> triangular. - !> DTGSEN also computes the generalized eigenvalues - !> w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j) - !> of the reordered matrix pair (A, B). - !> Optionally, DTGSEN computes the estimates of reciprocal condition - !> numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11), - !> (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s) - !> between the matrix pairs (A11, B11) and (A22,B22) that correspond to - !> the selected cluster and the eigenvalues outside the cluster, resp., - !> and norms of "projections" onto left and right eigenspaces w.r.t. - !> the selected cluster in the (1,1)-block. + !! DTGSEN reorders the generalized real Schur decomposition of a real + !! matrix pair (A, B) (in terms of an orthonormal equivalence trans- + !! formation Q**T * (A, B) * Z), so that a selected cluster of eigenvalues + !! appears in the leading diagonal blocks of the upper quasi-triangular + !! matrix A and the upper triangular B. The leading columns of Q and + !! Z form orthonormal bases of the corresponding left and right eigen- + !! spaces (deflating subspaces). (A, B) must be in generalized real + !! Schur canonical form (as returned by DGGES), i.e. A is block upper + !! triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper + !! triangular. + !! DTGSEN also computes the generalized eigenvalues + !! w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j) + !! of the reordered matrix pair (A, B). + !! Optionally, DTGSEN computes the estimates of reciprocal condition + !! numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11), + !! (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s) + !! between the matrix pairs (A11, B11) and (A22,B22) that correspond to + !! the selected cluster and the eigenvalues outside the cluster, resp., + !! and norms of "projections" onto left and right eigenspaces w.r.t. + !! the selected cluster in the (1,1)-block. beta, q, ldq, z, ldz, m, pl,pr, dif, work, lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58921,67 +58917,67 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & - !> DTGSJA computes the generalized singular value decomposition (GSVD) - !> of two real upper triangular (or trapezoidal) matrices A and B. - !> On entry, it is assumed that matrices A and B have the following - !> forms, which may be obtained by the preprocessing subroutine DGGSVP - !> from a general M-by-N matrix A and P-by-N matrix B: - !> N-K-L K L - !> A = K ( 0 A12 A13 ) if M-K-L >= 0; - !> L ( 0 0 A23 ) - !> M-K-L ( 0 0 0 ) - !> N-K-L K L - !> A = K ( 0 A12 A13 ) if M-K-L < 0; - !> M-K ( 0 0 A23 ) - !> N-K-L K L - !> B = L ( 0 0 B13 ) - !> P-L ( 0 0 0 ) - !> where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular - !> upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, - !> otherwise A23 is (M-K)-by-L upper trapezoidal. - !> On exit, - !> U**T *A*Q = D1*( 0 R ), V**T *B*Q = D2*( 0 R ), - !> where U, V and Q are orthogonal matrices. - !> R is a nonsingular upper triangular matrix, and D1 and D2 are - !> ``diagonal'' matrices, which are of the following structures: - !> If M-K-L >= 0, - !> K L - !> D1 = K ( I 0 ) - !> L ( 0 C ) - !> M-K-L ( 0 0 ) - !> K L - !> D2 = L ( 0 S ) - !> P-L ( 0 0 ) - !> N-K-L K L - !> ( 0 R ) = K ( 0 R11 R12 ) K - !> L ( 0 0 R22 ) L - !> where - !> C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), - !> S = diag( BETA(K+1), ... , BETA(K+L) ), - !> C**2 + S**2 = I. - !> R is stored in A(1:K+L,N-K-L+1:N) on exit. - !> If M-K-L < 0, - !> K M-K K+L-M - !> D1 = K ( I 0 0 ) - !> M-K ( 0 C 0 ) - !> K M-K K+L-M - !> D2 = M-K ( 0 S 0 ) - !> K+L-M ( 0 0 I ) - !> P-L ( 0 0 0 ) - !> N-K-L K M-K K+L-M - !> ( 0 R ) = K ( 0 R11 R12 R13 ) - !> M-K ( 0 0 R22 R23 ) - !> K+L-M ( 0 0 0 R33 ) - !> where - !> C = diag( ALPHA(K+1), ... , ALPHA(M) ), - !> S = diag( BETA(K+1), ... , BETA(M) ), - !> C**2 + S**2 = I. - !> R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored - !> ( 0 R22 R23 ) - !> in B(M-K+1:L,N+M-K-L+1:N) on exit. - !> The computation of the orthogonal transformation matrices U, V or Q - !> is optional. These matrices may either be formed explicitly, or they - !> may be postmultiplied into input matrices U1, V1, or Q1. + !! DTGSJA computes the generalized singular value decomposition (GSVD) + !! of two real upper triangular (or trapezoidal) matrices A and B. + !! On entry, it is assumed that matrices A and B have the following + !! forms, which may be obtained by the preprocessing subroutine DGGSVP + !! from a general M-by-N matrix A and P-by-N matrix B: + !! N-K-L K L + !! A = K ( 0 A12 A13 ) if M-K-L >= 0; + !! L ( 0 0 A23 ) + !! M-K-L ( 0 0 0 ) + !! N-K-L K L + !! A = K ( 0 A12 A13 ) if M-K-L < 0; + !! M-K ( 0 0 A23 ) + !! N-K-L K L + !! B = L ( 0 0 B13 ) + !! P-L ( 0 0 0 ) + !! where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular + !! upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, + !! otherwise A23 is (M-K)-by-L upper trapezoidal. + !! On exit, + !! U**T *A*Q = D1*( 0 R ), V**T *B*Q = D2*( 0 R ), + !! where U, V and Q are orthogonal matrices. + !! R is a nonsingular upper triangular matrix, and D1 and D2 are + !! ``diagonal'' matrices, which are of the following structures: + !! If M-K-L >= 0, + !! K L + !! D1 = K ( I 0 ) + !! L ( 0 C ) + !! M-K-L ( 0 0 ) + !! K L + !! D2 = L ( 0 S ) + !! P-L ( 0 0 ) + !! N-K-L K L + !! ( 0 R ) = K ( 0 R11 R12 ) K + !! L ( 0 0 R22 ) L + !! where + !! C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), + !! S = diag( BETA(K+1), ... , BETA(K+L) ), + !! C**2 + S**2 = I. + !! R is stored in A(1:K+L,N-K-L+1:N) on exit. + !! If M-K-L < 0, + !! K M-K K+L-M + !! D1 = K ( I 0 0 ) + !! M-K ( 0 C 0 ) + !! K M-K K+L-M + !! D2 = M-K ( 0 S 0 ) + !! K+L-M ( 0 0 I ) + !! P-L ( 0 0 0 ) + !! N-K-L K M-K K+L-M + !! ( 0 R ) = K ( 0 R11 R12 R13 ) + !! M-K ( 0 0 R22 R23 ) + !! K+L-M ( 0 0 0 R33 ) + !! where + !! C = diag( ALPHA(K+1), ... , ALPHA(M) ), + !! S = diag( BETA(K+1), ... , BETA(M) ), + !! C**2 + S**2 = I. + !! R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored + !! ( 0 R22 R23 ) + !! in B(M-K+1:L,N+M-K-L+1:N) on exit. + !! The computation of the orthogonal transformation matrices U, V or Q + !! is optional. These matrices may either be formed explicitly, or they + !! may be postmultiplied into input matrices U1, V1, or Q1. alpha, beta, u, ldu, v, ldv,q, ldq, work, ncycle, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59162,14 +59158,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & - !> DTGSNA estimates reciprocal condition numbers for specified - !> eigenvalues and/or eigenvectors of a matrix pair (A, B) in - !> generalized real Schur canonical form (or of any matrix pair - !> (Q*A*Z**T, Q*B*Z**T) with orthogonal matrices Q and Z, where - !> Z**T denotes the transpose of Z. - !> (A, B) must be in generalized real Schur form (as returned by DGGES), - !> i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal - !> blocks. B is upper triangular. + !! DTGSNA estimates reciprocal condition numbers for specified + !! eigenvalues and/or eigenvectors of a matrix pair (A, B) in + !! generalized real Schur canonical form (or of any matrix pair + !! (Q*A*Z**T, Q*B*Z**T) with orthogonal matrices Q and Z, where + !! Z**T denotes the transpose of Z. + !! (A, B) must be in generalized real Schur form (as returned by DGGES), + !! i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal + !! blocks. B is upper triangular. dif, mm, m, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59410,10 +59406,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) - !> DTPLQT computes a blocked LQ factorization of a real - !> "triangular-pentagonal" matrix C, which is composed of a - !> triangular block A and pentagonal block B, using the compact - !> WY representation for Q. + !! DTPLQT computes a blocked LQ factorization of a real + !! "triangular-pentagonal" matrix C, which is composed of a + !! triangular block A and pentagonal block B, using the compact + !! WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59472,10 +59468,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) - !> DTPQRT computes a blocked QR factorization of a real - !> "triangular-pentagonal" matrix C, which is composed of a - !> triangular block A and pentagonal block B, using the compact - !> WY representation for Q. + !! DTPQRT computes a blocked QR factorization of a real + !! "triangular-pentagonal" matrix C, which is composed of a + !! triangular block A and pentagonal block B, using the compact + !! WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59534,21 +59530,21 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & - !> DTREVC computes some or all of the right and/or left eigenvectors of - !> a real upper quasi-triangular matrix T. - !> Matrices of this type are produced by the Schur factorization of - !> a real general matrix: A = Q*T*Q**T, as computed by DHSEQR. - !> The right eigenvector x and the left eigenvector y of T corresponding - !> to an eigenvalue w are defined by: - !> T*x = w*x, (y**H)*T = w*(y**H) - !> where y**H denotes the conjugate transpose of y. - !> The eigenvalues are not input to this routine, but are read directly - !> from the diagonal blocks of T. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an - !> input matrix. If Q is the orthogonal factor that reduces a matrix - !> A to Schur form T, then Q*X and Q*Y are the matrices of right and - !> left eigenvectors of A. + !! DTREVC computes some or all of the right and/or left eigenvectors of + !! a real upper quasi-triangular matrix T. + !! Matrices of this type are produced by the Schur factorization of + !! a real general matrix: A = Q*T*Q**T, as computed by DHSEQR. + !! The right eigenvector x and the left eigenvector y of T corresponding + !! to an eigenvalue w are defined by: + !! T*x = w*x, (y**H)*T = w*(y**H) + !! where y**H denotes the conjugate transpose of y. + !! The eigenvalues are not input to this routine, but are read directly + !! from the diagonal blocks of T. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an + !! input matrix. If Q is the orthogonal factor that reduces a matrix + !! A to Schur form T, then Q*X and Q*Y are the matrices of right and + !! left eigenvectors of A. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60147,22 +60143,22 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dtrevc3( side, howmny, select, n, t, ldt, vl, ldvl,vr, ldvr, mm, m, & - !> DTREVC3 computes some or all of the right and/or left eigenvectors of - !> a real upper quasi-triangular matrix T. - !> Matrices of this type are produced by the Schur factorization of - !> a real general matrix: A = Q*T*Q**T, as computed by DHSEQR. - !> The right eigenvector x and the left eigenvector y of T corresponding - !> to an eigenvalue w are defined by: - !> T*x = w*x, (y**T)*T = w*(y**T) - !> where y**T denotes the transpose of the vector y. - !> The eigenvalues are not input to this routine, but are read directly - !> from the diagonal blocks of T. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an - !> input matrix. If Q is the orthogonal factor that reduces a matrix - !> A to Schur form T, then Q*X and Q*Y are the matrices of right and - !> left eigenvectors of A. - !> This uses a Level 3 BLAS version of the back transformation. + !! DTREVC3 computes some or all of the right and/or left eigenvectors of + !! a real upper quasi-triangular matrix T. + !! Matrices of this type are produced by the Schur factorization of + !! a real general matrix: A = Q*T*Q**T, as computed by DHSEQR. + !! The right eigenvector x and the left eigenvector y of T corresponding + !! to an eigenvalue w are defined by: + !! T*x = w*x, (y**T)*T = w*(y**T) + !! where y**T denotes the transpose of the vector y. + !! The eigenvalues are not input to this routine, but are read directly + !! from the diagonal blocks of T. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an + !! input matrix. If Q is the orthogonal factor that reduces a matrix + !! A to Schur form T, then Q*X and Q*Y are the matrices of right and + !! left eigenvectors of A. + !! This uses a Level 3 BLAS version of the back transformation. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60969,17 +60965,17 @@ module stdlib_linalg_lapack_d subroutine stdlib_dtrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) - !> DTRSYL solves the real Sylvester matrix equation: - !> op(A)*X + X*op(B) = scale*C or - !> op(A)*X - X*op(B) = scale*C, - !> where op(A) = A or A**T, and A and B are both upper quasi- - !> triangular. A is M-by-M and B is N-by-N; the right hand side C and - !> the solution X are M-by-N; and scale is an output scale factor, set - !> <= 1 to avoid overflow in X. - !> A and B must be in Schur canonical form (as returned by DHSEQR), 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. + !! DTRSYL solves the real Sylvester matrix equation: + !! op(A)*X + X*op(B) = scale*C or + !! op(A)*X - X*op(B) = scale*C, + !! where op(A) = A or A**T, and A and B are both upper quasi- + !! triangular. A is M-by-M and B is N-by-N; the right hand side C and + !! the solution X are M-by-N; and scale is an output scale factor, set + !! <= 1 to avoid overflow in X. + !! A and B must be in Schur canonical form (as returned by DHSEQR), 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61630,9 +61626,9 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) - !> DGEBRD reduces a general real M-by-N matrix A to upper or lower - !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. - !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. + !! DGEBRD reduces a general real M-by-N matrix A to upper or lower + !! bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. + !! If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61735,8 +61731,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info ) - !> DGEHRD reduces a real general matrix A to upper Hessenberg form H by - !> an orthogonal similarity transformation: Q**T * A * Q = H . + !! DGEHRD reduces a real general matrix A to upper Hessenberg form H by + !! an orthogonal similarity transformation: Q**T * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61864,8 +61860,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgelqt( m, n, mb, a, lda, t, ldt, work, info ) - !> DGELQT computes a blocked LQ factorization of a real M-by-N matrix A - !> using the compact WY representation of Q. + !! DGELQT computes a blocked LQ factorization of a real M-by-N matrix A + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61915,24 +61911,24 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) - !> DGELS solves overdetermined or underdetermined real linear systems - !> involving an M-by-N matrix A, or its 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 = 'T' and m >= n: find the minimum norm solution of - !> an underdetermined system A**T * X = B. - !> 4. If TRANS = 'T' 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. + !! DGELS solves overdetermined or underdetermined real linear systems + !! involving an M-by-N matrix A, or its 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 = 'T' and m >= n: find the minimum norm solution of + !! an underdetermined system A**T * X = B. + !! 4. If TRANS = 'T' 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62132,13 +62128,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & - !> DGEMLQ overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product - !> of blocked elementary reflectors computed by short wide LQ - !> factorization (DGELQ) + !! DGEMLQ overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product + !! of blocked elementary reflectors computed by short wide LQ + !! factorization (DGELQ) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62229,13 +62225,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & - !> DGEMQR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product - !> of blocked elementary reflectors computed by tall skinny - !> QR factorization (DGEQR) + !! DGEMQR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product + !! of blocked elementary reflectors computed by tall skinny + !! QR factorization (DGEQR) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62326,8 +62322,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgeqp3( m, n, a, lda, jpvt, tau, work, lwork, info ) - !> DGEQP3 computes a QR factorization with column pivoting of a - !> matrix A: A*P = Q*R using Level 3 BLAS. + !! DGEQP3 computes a QR factorization with column pivoting of a + !! matrix A: A*P = Q*R using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62476,8 +62472,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgeqrt( m, n, nb, a, lda, t, ldt, work, info ) - !> DGEQRT computes a blocked QR factorization of a real M-by-N matrix A - !> using the compact WY representation of Q. + !! DGEQRT computes a blocked QR factorization of a real M-by-N matrix A + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62533,15 +62529,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) - !> DGESV computes the solution to a real 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. + !! DGESV computes the solution to a real 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62581,17 +62577,17 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, work, lwork, & - !> DGESVJ computes the singular value decomposition (SVD) of a real - !> M-by-N matrix A, where M >= N. The SVD of A is written as - !> [++] [xx] [x0] [xx] - !> A = U * SIGMA * V^t, [++] = [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 orthogonal 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. - !> DGESVJ can sometimes compute tiny singular values and their singular vectors much - !> more accurately than other SVD routines, see below under Further Details. + !! DGESVJ computes the singular value decomposition (SVD) of a real + !! M-by-N matrix A, where M >= N. The SVD of A is written as + !! [++] [xx] [x0] [xx] + !! A = U * SIGMA * V^t, [++] = [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 orthogonal 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. + !! DGESVJ can sometimes compute tiny singular values and their singular vectors much + !! more accurately than other SVD routines, see below under Further Details. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63560,12 +63556,12 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & - !> DGESVX uses the LU factorization to compute the solution to a real - !> system of linear equations - !> A * X = B, - !> where A is an N-by-N matrix and X and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DGESVX uses the LU factorization to compute the solution to a real + !! system of linear equations + !! A * X = B, + !! where A is an N-by-N matrix and X and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. x, ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63764,32 +63760,32 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alphar, & - !> DGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B), - !> the generalized eigenvalues, the generalized real Schur form (S,T), - !> optionally, the left and/or right matrices of Schur vectors (VSL and - !> VSR). This gives the generalized Schur factorization - !> (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T ) - !> Optionally, it also orders the eigenvalues so that a selected cluster - !> of eigenvalues appears in the leading diagonal blocks of the upper - !> quasi-triangular matrix S and the upper triangular matrix T.The - !> leading columns of VSL and VSR then form an orthonormal basis for the - !> corresponding left and right eigenspaces (deflating subspaces). - !> (If only the generalized eigenvalues are needed, use the driver - !> DGGEV 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 or both being zero. - !> A pair of matrices (S,T) is in generalized real Schur form if T is - !> upper triangular with non-negative diagonal and S is block upper - !> triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond - !> to real generalized eigenvalues, while 2-by-2 blocks of S will be - !> "standardized" by making the corresponding elements of T have the - !> form: - !> [ a 0 ] - !> [ 0 b ] - !> and the pair of corresponding 2-by-2 blocks in S and T will have a - !> complex conjugate pair of generalized eigenvalues. + !! DGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B), + !! the generalized eigenvalues, the generalized real Schur form (S,T), + !! optionally, the left and/or right matrices of Schur vectors (VSL and + !! VSR). This gives the generalized Schur factorization + !! (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T ) + !! Optionally, it also orders the eigenvalues so that a selected cluster + !! of eigenvalues appears in the leading diagonal blocks of the upper + !! quasi-triangular matrix S and the upper triangular matrix T.The + !! leading columns of VSL and VSR then form an orthonormal basis for the + !! corresponding left and right eigenspaces (deflating subspaces). + !! (If only the generalized eigenvalues are needed, use the driver + !! DGGEV 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 or both being zero. + !! A pair of matrices (S,T) is in generalized real Schur form if T is + !! upper triangular with non-negative diagonal and S is block upper + !! triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond + !! to real generalized eigenvalues, while 2-by-2 blocks of S will be + !! "standardized" by making the corresponding elements of T have the + !! form: + !! [ a 0 ] + !! [ 0 b ] + !! and the pair of corresponding 2-by-2 blocks in S and T will have a + !! complex conjugate pair of generalized eigenvalues. alphai, beta, vsl, ldvsl, vsr,ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64083,34 +64079,34 @@ module stdlib_linalg_lapack_d subroutine stdlib_dggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, & - !> DGGESX computes for a pair of N-by-N real nonsymmetric matrices - !> (A,B), the generalized eigenvalues, the real Schur form (S,T), and, - !> optionally, the left and/or right matrices of Schur vectors (VSL and - !> VSR). This gives the generalized Schur factorization - !> (A,B) = ( (VSL) S (VSR)**T, (VSL) T (VSR)**T ) - !> Optionally, it also orders the eigenvalues so that a selected cluster - !> of eigenvalues appears in the leading diagonal blocks of the upper - !> quasi-triangular matrix S and the upper triangular matrix T; computes - !> a reciprocal condition number for the average of the selected - !> eigenvalues (RCONDE); and computes a reciprocal condition number for - !> the right and left deflating subspaces corresponding to the selected - !> eigenvalues (RCONDV). The leading columns of VSL and VSR then form - !> an orthonormal basis for the corresponding left and right eigenspaces - !> (deflating subspaces). - !> 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 or for both being zero. - !> A pair of matrices (S,T) is in generalized real Schur form if T is - !> upper triangular with non-negative diagonal and S is block upper - !> triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond - !> to real generalized eigenvalues, while 2-by-2 blocks of S will be - !> "standardized" by making the corresponding elements of T have the - !> form: - !> [ a 0 ] - !> [ 0 b ] - !> and the pair of corresponding 2-by-2 blocks in S and T will have a - !> complex conjugate pair of generalized eigenvalues. + !! DGGESX computes for a pair of N-by-N real nonsymmetric matrices + !! (A,B), the generalized eigenvalues, the real Schur form (S,T), and, + !! optionally, the left and/or right matrices of Schur vectors (VSL and + !! VSR). This gives the generalized Schur factorization + !! (A,B) = ( (VSL) S (VSR)**T, (VSL) T (VSR)**T ) + !! Optionally, it also orders the eigenvalues so that a selected cluster + !! of eigenvalues appears in the leading diagonal blocks of the upper + !! quasi-triangular matrix S and the upper triangular matrix T; computes + !! a reciprocal condition number for the average of the selected + !! eigenvalues (RCONDE); and computes a reciprocal condition number for + !! the right and left deflating subspaces corresponding to the selected + !! eigenvalues (RCONDV). The leading columns of VSL and VSR then form + !! an orthonormal basis for the corresponding left and right eigenspaces + !! (deflating subspaces). + !! 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 or for both being zero. + !! A pair of matrices (S,T) is in generalized real Schur form if T is + !! upper triangular with non-negative diagonal and S is block upper + !! triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond + !! to real generalized eigenvalues, while 2-by-2 blocks of S will be + !! "standardized" by making the corresponding elements of T have the + !! form: + !! [ a 0 ] + !! [ 0 b ] + !! and the pair of corresponding 2-by-2 blocks in S and T will have a + !! complex conjugate pair of generalized eigenvalues. alphar, alphai, beta, vsl, ldvsl,vsr, ldvsr, rconde, rcondv, work, lwork, iwork,liwork, & bwork, info ) ! -- lapack driver routine -- @@ -64453,21 +64449,21 @@ module stdlib_linalg_lapack_d subroutine stdlib_dggev( jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai,beta, vl, ldvl, vr, & - !> DGGEV computes for a pair of N-by-N real 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) - !> of (A,B) satisfies - !> A * v(j) = lambda(j) * B * v(j). - !> The left eigenvector u(j) corresponding to the eigenvalue 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). + !! DGGEV computes for a pair of N-by-N real 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) + !! of (A,B) satisfies + !! A * v(j) = lambda(j) * B * v(j). + !! The left eigenvector u(j) corresponding to the eigenvalue 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). ldvr, work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64751,26 +64747,26 @@ module stdlib_linalg_lapack_d subroutine stdlib_dggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alphar, alphai, & - !> DGGEVX computes for a pair of N-by-N real nonsymmetric matrices (A,B) - !> the generalized eigenvalues, and optionally, the left and/or right - !> generalized eigenvectors. - !> Optionally also, it computes a balancing transformation to improve - !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, - !> LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for - !> the eigenvalues (RCONDE), and reciprocal condition numbers for the - !> right eigenvectors (RCONDV). - !> 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) - !> of (A,B) satisfies - !> A * v(j) = lambda(j) * B * v(j) . - !> The left eigenvector u(j) corresponding to the eigenvalue 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). + !! DGGEVX computes for a pair of N-by-N real nonsymmetric matrices (A,B) + !! the generalized eigenvalues, and optionally, the left and/or right + !! generalized eigenvectors. + !! Optionally also, it computes a balancing transformation to improve + !! the conditioning of the eigenvalues and eigenvectors (ILO, IHI, + !! LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for + !! the eigenvalues (RCONDE), and reciprocal condition numbers for the + !! right eigenvectors (RCONDV). + !! 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) + !! of (A,B) satisfies + !! A * v(j) = lambda(j) * B * v(j) . + !! The left eigenvector u(j) corresponding to the eigenvalue 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). beta, vl, ldvl, vr, ldvr, ilo,ihi, lscale, rscale, abnrm, bbnrm, rconde,rcondv, work, lwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -65146,24 +65142,24 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) - !> DGGGLM 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. + !! DGGGLM 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65282,18 +65278,18 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) - !> DGGLSE 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. + !! DGGLSE 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65414,12 +65410,12 @@ module stdlib_linalg_lapack_d subroutine stdlib_dhsein( side, eigsrc, initv, select, n, h, ldh, wr, wi,vl, ldvl, vr, ldvr, & - !> DHSEIN uses inverse iteration to find specified right and/or left - !> eigenvectors of a real 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. + !! DHSEIN uses inverse iteration to find specified right and/or left + !! eigenvectors of a real 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. mm, m, work, ifaill,ifailr, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65629,12 +65625,12 @@ module stdlib_linalg_lapack_d real(dp) function stdlib_dla_porpvgrw( uplo, ncols, a, lda, af,ldaf, work ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65717,18 +65713,18 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaed3( k, n, n1, d, q, ldq, rho, dlamda, q2, indx,ctot, w, s, info ) - !> DLAED3 finds the roots of the secular equation, as defined by the - !> values in D, W, and RHO, between 1 and K. It makes the - !> appropriate calls to DLAED4 and then updates the eigenvectors by - !> multiplying the matrix of eigenvectors of the pair of eigensystems - !> being combined by the matrix of eigenvectors of the K-by-K system - !> which is solved here. - !> 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. + !! DLAED3 finds the roots of the secular equation, as defined by the + !! values in D, W, and RHO, between 1 and K. It makes the + !! appropriate calls to DLAED4 and then updates the eigenvectors by + !! multiplying the matrix of eigenvectors of the pair of eigensystems + !! being combined by the matrix of eigenvectors of the K-by-K system + !! which is solved here. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65852,32 +65848,32 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaed7( icompq, n, qsiz, tlvls, curlvl, curpbm, d, q,ldq, indxq, rho, & - !> DLAED7 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 symmetric matrix - !> that has been reduced to tridiagonal form. DLAED1 handles - !> the case in which all eigenvalues and eigenvectors of a symmetric - !> tridiagonal matrix are desired. - !> T = Q(in) ( D(in) + RHO * Z*Z**T ) Q**T(in) = Q(out) * D(out) * Q**T(out) - !> where Z = Q**Tu, 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 DLAED8. - !> 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 DLAED9). - !> 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. + !! DLAED7 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 symmetric matrix + !! that has been reduced to tridiagonal form. DLAED1 handles + !! the case in which all eigenvalues and eigenvectors of a symmetric + !! tridiagonal matrix are desired. + !! T = Q(in) ( D(in) + RHO * Z*Z**T ) Q**T(in) = Q(out) * D(out) * Q**T(out) + !! where Z = Q**Tu, 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 DLAED8. + !! 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 DLAED9). + !! 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. cutpnt, qstore, qptr, prmptr,perm, givptr, givcol, givnum, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65986,13 +65982,13 @@ module stdlib_linalg_lapack_d subroutine stdlib_dlaexc( wantq, n, t, ldt, q, ldq, j1, n1, n2, work,info ) - !> DLAEXC 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. + !! DLAEXC 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -66184,10 +66180,10 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlahqr( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, & - !> DLAHQR is an auxiliary routine called by DHSEQR to update the - !> eigenvalues and Schur decomposition already computed by DHSEQR, by - !> dealing with the Hessenberg submatrix in rows and columns ILO to - !> IHI. + !! DLAHQR is an auxiliary routine called by DHSEQR to update the + !! eigenvalues and Schur decomposition already computed by DHSEQR, by + !! dealing with the Hessenberg submatrix in rows and columns ILO to + !! IHI. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66493,13 +66489,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasd2( nl, nr, sqre, k, d, z, alpha, beta, u, ldu, vt,ldvt, dsigma, & - !> DLASD2 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. - !> DLASD2 is called from DLASD1. + !! DLASD2 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. + !! DLASD2 is called from DLASD1. u2, ldu2, vt2, ldvt2, idxp, idx,idxc, idxq, coltyp, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66778,16 +66774,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) - !> DLASWLQ computes a blocked Tall-Skinny LQ factorization of - !> a real 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. + !! DLASWLQ computes a blocked Tall-Skinny LQ factorization of + !! a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -66862,17 +66858,17 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) - !> DLATSQR computes a blocked Tall-Skinny QR factorization of - !> a real M-by-N matrix A for M >= N: - !> A = Q * ( R ), - !> ( 0 ) - !> where: - !> Q is a M-by-M orthogonal matrix, stored on exit in an implicit - !> form in the elements below the diagonal of the array A and in - !> the elements of the array T; - !> R is an upper-triangular N-by-N matrix, stored on exit in - !> the elements on and above the diagonal of the array A. - !> 0 is a (M-N)-by-N zero matrix, and is not stored. + !! DLATSQR computes a blocked Tall-Skinny QR factorization of + !! a real M-by-N matrix A for M >= N: + !! A = Q * ( R ), + !! ( 0 ) + !! where: + !! Q is a M-by-M orthogonal matrix, stored on exit in an implicit + !! form in the elements below the diagonal of the array A and in + !! the elements of the array T; + !! R is an upper-triangular N-by-N matrix, stored on exit in + !! the elements on and above the diagonal of the array A. + !! 0 is a (M-N)-by-N zero matrix, and is not stored. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -66947,22 +66943,22 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dorgbr( vect, m, n, k, a, lda, tau, work, lwork, info ) - !> DORGBR generates one of the real orthogonal matrices Q or P**T - !> determined by DGEBRD when reducing a real matrix A to bidiagonal - !> form: A = Q * B * P**T. Q and P**T are defined as products of - !> elementary reflectors H(i) or G(i) respectively. - !> If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q - !> is of order M: - !> if m >= k, Q = H(1) H(2) . . . H(k) and DORGBR returns the first n - !> columns of Q, where m >= n >= k; - !> if m < k, Q = H(1) H(2) . . . H(m-1) and DORGBR returns Q as an - !> M-by-M matrix. - !> If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T - !> is of order N: - !> if k < n, P**T = G(k) . . . G(2) G(1) and DORGBR returns the first m - !> rows of P**T, where n >= m >= k; - !> if k >= n, P**T = G(n-1) . . . G(2) G(1) and DORGBR returns P**T as - !> an N-by-N matrix. + !! DORGBR generates one of the real orthogonal matrices Q or P**T + !! determined by DGEBRD when reducing a real matrix A to bidiagonal + !! form: A = Q * B * P**T. Q and P**T are defined as products of + !! elementary reflectors H(i) or G(i) respectively. + !! If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q + !! is of order M: + !! if m >= k, Q = H(1) H(2) . . . H(k) and DORGBR returns the first n + !! columns of Q, where m >= n >= k; + !! if m < k, Q = H(1) H(2) . . . H(m-1) and DORGBR returns Q as an + !! M-by-M matrix. + !! If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T + !! is of order N: + !! if k < n, P**T = G(k) . . . G(2) G(1) and DORGBR returns the first m + !! rows of P**T, where n >= m >= k; + !! if k >= n, P**T = G(n-1) . . . G(2) G(1) and DORGBR returns P**T as + !! an N-by-N matrix. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67096,28 +67092,28 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dormbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & - !> If VECT = 'Q', DORMBR: overwrites the general real M-by-N matrix C - !> with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> If VECT = 'P', DORMBR overwrites the general real M-by-N matrix C - !> with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': P * C C * P - !> TRANS = 'T': P**T * C C * P**T - !> Here Q and P**T are the orthogonal matrices determined by DGEBRD when - !> reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and - !> P**T are defined as products of elementary reflectors H(i) and G(i) - !> respectively. - !> Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the - !> order of the orthogonal matrix Q or P**T that is applied. - !> If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: - !> if nq >= k, Q = H(1) H(2) . . . H(k); - !> if nq < k, Q = H(1) H(2) . . . H(nq-1). - !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: - !> if k < nq, P = G(1) G(2) . . . G(k); - !> if k >= nq, P = G(1) G(2) . . . G(nq-1). + !! If VECT = 'Q', DORMBR: overwrites the general real M-by-N matrix C + !! with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! If VECT = 'P', DORMBR overwrites the general real M-by-N matrix C + !! with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': P * C C * P + !! TRANS = 'T': P**T * C C * P**T + !! Here Q and P**T are the orthogonal matrices determined by DGEBRD when + !! reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and + !! P**T are defined as products of elementary reflectors H(i) and G(i) + !! respectively. + !! Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the + !! order of the orthogonal matrix Q or P**T that is applied. + !! If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: + !! if nq >= k, Q = H(1) H(2) . . . H(k); + !! if nq < k, Q = H(1) H(2) . . . H(nq-1). + !! If VECT = 'P', A is assumed to have been a K-by-NQ matrix: + !! if k < nq, P = G(1) G(2) . . . G(k); + !! if k >= nq, P = G(1) G(2) . . . G(nq-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67254,17 +67250,17 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) - !> DPBSV computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite band matrix and X - !> and B are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular band matrix, and L is a lower - !> triangular band matrix, with the same number of superdiagonals or - !> subdiagonals as A. The factored form of A is then used to solve the - !> system of equations A * X = B. + !! DPBSV computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite band matrix and X + !! and B are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular band matrix, and L is a lower + !! triangular band matrix, with the same number of superdiagonals or + !! subdiagonals as A. The factored form of A is then used to solve the + !! system of equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67308,13 +67304,13 @@ module stdlib_linalg_lapack_d subroutine stdlib_dpbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & - !> DPBSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to - !> compute the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite band matrix and X - !> and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DPBSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to + !! compute the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite band matrix and X + !! and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67464,13 +67460,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpftrf( transr, uplo, n, a, info ) - !> DPFTRF computes the Cholesky factorization of a real symmetric - !> positive definite matrix A. - !> The factorization has the form - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the block version of the algorithm, calling Level 3 BLAS. + !! DPFTRF computes the Cholesky factorization of a real symmetric + !! positive definite matrix A. + !! The factorization has the form + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the block version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67639,16 +67635,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dposv( uplo, n, nrhs, a, lda, b, ldb, info ) - !> DPOSV computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**T* U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is a lower triangular - !> matrix. The factored form of A is then used to solve the system of - !> equations A * X = B. + !! DPOSV computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**T* U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is a lower triangular + !! matrix. The factored form of A is then used to solve the system of + !! equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67690,13 +67686,13 @@ module stdlib_linalg_lapack_d subroutine stdlib_dposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & - !> DPOSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to - !> compute the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DPOSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to + !! compute the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. rcond, ferr, berr, work,iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67833,16 +67829,16 @@ module stdlib_linalg_lapack_d subroutine stdlib_dtrexc( compq, n, t, ldt, q, ldq, ifst, ilst, work,info ) - !> DTREXC reorders the real Schur factorization of a real matrix - !> A = Q*T*Q**T, so that the diagonal block of T with row index IFST is - !> moved to row ILST. - !> The real Schur form T is reordered by an orthogonal similarity - !> transformation Z**T*T*Z, and optionally the matrix Q of Schur vectors - !> is updated by postmultiplying it with Z. - !> T must be in Schur canonical form (as returned by DHSEQR), 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. + !! DTREXC reorders the real Schur factorization of a real matrix + !! A = Q*T*Q**T, so that the diagonal block of T with row index IFST is + !! moved to row ILST. + !! The real Schur form T is reordered by an orthogonal similarity + !! transformation Z**T*T*Z, and optionally the matrix Q of Schur vectors + !! is updated by postmultiplying it with Z. + !! T must be in Schur canonical form (as returned by DHSEQR), 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -68037,17 +68033,17 @@ module stdlib_linalg_lapack_d subroutine stdlib_dtrsen( job, compq, select, n, t, ldt, q, ldq, wr, wi,m, s, sep, work, & - !> DTRSEN reorders the real Schur factorization of a real matrix - !> A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in - !> the leading diagonal blocks of the upper quasi-triangular matrix T, - !> and the leading columns of Q form an orthonormal basis of the - !> corresponding right invariant subspace. - !> Optionally the routine computes the reciprocal condition numbers of - !> the cluster of eigenvalues and/or the invariant subspace. - !> T must be in Schur canonical form (as returned by DHSEQR), 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. + !! DTRSEN reorders the real Schur factorization of a real matrix + !! A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in + !! the leading diagonal blocks of the upper quasi-triangular matrix T, + !! and the leading columns of Q form an orthonormal basis of the + !! corresponding right invariant subspace. + !! Optionally the routine computes the reciprocal condition numbers of + !! the cluster of eigenvalues and/or the invariant subspace. + !! T must be in Schur canonical form (as returned by DHSEQR), 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. lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68232,14 +68228,14 @@ module stdlib_linalg_lapack_d subroutine stdlib_dtrsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm, m, & - !> DTRSNA estimates reciprocal condition numbers for specified - !> eigenvalues and/or right eigenvectors of a real upper - !> quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q - !> orthogonal). - !> T must be in Schur canonical form (as returned by DHSEQR), 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. + !! DTRSNA estimates reciprocal condition numbers for specified + !! eigenvalues and/or right eigenvectors of a real upper + !! quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q + !! orthogonal). + !! T must be in Schur canonical form (as returned by DHSEQR), 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. work, ldwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68477,18 +68473,18 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & - !> DGEJSV computes the singular value decomposition (SVD) of a real M-by-N - !> matrix [A], where M >= N. The SVD of [A] is written as - !> [A] = [U] * [SIGMA] * [V]^t, - !> 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) orthonormal matrix, and - !> [V] is an N-by-N orthogonal 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. - !> DGEJSV can sometimes compute tiny singular values and their singular vectors much - !> more accurately than other SVD routines, see below under Further Details. + !! DGEJSV computes the singular value decomposition (SVD) of a real M-by-N + !! matrix [A], where M >= N. The SVD of [A] is written as + !! [A] = [U] * [SIGMA] * [V]^t, + !! 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) orthonormal matrix, and + !! [V] is an N-by-N orthogonal 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. + !! DGEJSV can sometimes compute tiny singular values and their singular vectors much + !! more accurately than other SVD routines, see below under Further Details. v, ldv,work, lwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69567,12 +69563,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgelq( m, n, a, lda, t, tsize, work, lwork,info ) - !> DGELQ computes an LQ factorization of a real 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. + !! DGELQ computes an LQ factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -69692,38 +69688,38 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, info ) - !> DGELSY computes the minimum-norm solution to a real 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 orthogonal 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**T [ inv(T11)*Q1**T*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 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. - !> o The permutation of matrix B (the right hand side) is faster and - !> more simple. + !! DGELSY computes the minimum-norm solution to a real 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 orthogonal 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**T [ inv(T11)*Q1**T*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 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. + !! o The permutation of matrix B (the right hand side) is faster and + !! more simple. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69925,13 +69921,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgeqr( m, n, a, lda, t, tsize, work, lwork,info ) - !> DGEQR computes a QR factorization of a real 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. + !! DGEQR computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -70040,24 +70036,24 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) - !> DGETSLS solves overdetermined or underdetermined real 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 = 'T' and m >= n: find the minimum norm solution of - !> an undetermined system A**T * X = B. - !> 4. If TRANS = 'T' 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. + !! DGETSLS solves overdetermined or underdetermined real 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 = 'T' and m >= n: find the minimum norm solution of + !! an undetermined system A**T * X = B. + !! 4. If TRANS = 'T' 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -70276,18 +70272,18 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) - !> DGETSQRHRT computes a NB2-sized column blocked QR-factorization - !> of a real 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 DGEQRT - !> (Q is in blocked compact WY-representation). See the documentation - !> of DGEQRT for more details on the format. + !! DGETSQRHRT computes a NB2-sized column blocked QR-factorization + !! of a real 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 DGEQRT + !! (Q is in blocked compact WY-representation). See the documentation + !! of DGEQRT for more details on the format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70409,12 +70405,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaed2( k, n, n1, d, q, ldq, indxq, rho, z, dlamda, w,q2, indx, indxc,& - !> DLAED2 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 entry in the - !> Z vector. For each such occurrence the order of the related secular - !> equation problem is reduced by one. + !! DLAED2 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 entry in the + !! Z vector. For each such occurrence the order of the related secular + !! equation problem is reduced by one. indxp, coltyp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70666,17 +70662,17 @@ module stdlib_linalg_lapack_d subroutine stdlib_dlaqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& - !> DLAQR2 is identical to DLAQR3 except that it avoids - !> recursion by calling DLAHQR instead of DLAQR4. - !> Aggressive early deflation: - !> This subroutine accepts as input an upper Hessenberg matrix - !> H and performs an orthogonal similarity transformation - !> designed to detect and deflate fully converged eigenvalues from - !> a trailing principal submatrix. On output H has been over- - !> written by a new Hessenberg matrix that is a perturbation of - !> an orthogonal similarity transformation of H. It is to be - !> hoped that the final version of H has many zero subdiagonal - !> entries. + !! DLAQR2 is identical to DLAQR3 except that it avoids + !! recursion by calling DLAHQR instead of DLAQR4. + !! Aggressive early deflation: + !! This subroutine accepts as input an upper Hessenberg matrix + !! H and performs an orthogonal similarity transformation + !! designed to detect and deflate fully converged eigenvalues from + !! a trailing principal submatrix. On output H has been over- + !! written by a new Hessenberg matrix that is a perturbation of + !! an orthogonal similarity transformation of H. It is to be + !! hoped that the final version of H has many zero subdiagonal + !! entries. sr, si, v, ldv, nh, t,ldt, nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70969,35 +70965,35 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasd1( nl, nr, sqre, d, alpha, beta, u, ldu, vt, ldvt,idxq, iwork, & - !> DLASD1 computes the SVD of an upper bidiagonal N-by-M matrix B, - !> where N = NL + NR + 1 and M = N + SQRE. DLASD1 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. - !> DLASD1 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. + !! DLASD1 computes the SVD of an upper bidiagonal N-by-M matrix B, + !! where N = NL + NR + 1 and M = N + SQRE. DLASD1 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. + !! DLASD1 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. work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71084,32 +71080,32 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaed1( n, d, q, ldq, indxq, rho, cutpnt, work, iwork,info ) - !> DLAED1 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. + !! DLAED1 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -71187,8 +71183,8 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlaed0( icompq, qsiz, n, d, e, q, ldq, qstore, ldqs,work, iwork, info & - !> DLAED0 computes all eigenvalues and corresponding eigenvectors of a - !> symmetric tridiagonal matrix using the divide and conquer method. + !! DLAED0 computes all eigenvalues and corresponding eigenvectors of a + !! symmetric tridiagonal matrix using the divide and conquer method. ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71391,17 +71387,17 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dstedc( compz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) - !> DSTEDC computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric tridiagonal matrix using the divide and conquer method. - !> The eigenvectors of a full or band real symmetric matrix can also be - !> found if DSYTRD or DSPTRD or DSBTRD has been used to reduce this - !> matrix to tridiagonal 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 DLAED3 for details. + !! DSTEDC computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric tridiagonal matrix using the divide and conquer method. + !! The eigenvectors of a full or band real symmetric matrix can also be + !! found if DSYTRD or DSPTRD or DSBTRD has been used to reduce this + !! matrix to tridiagonal 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 DLAED3 for details. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71617,15 +71613,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dstevd( jobz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) - !> DSTEVD computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric tridiagonal matrix. 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. + !! DSTEVD computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric tridiagonal matrix. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71722,17 +71718,17 @@ module stdlib_linalg_lapack_d subroutine stdlib_dsyevd( jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info ) - !> DSYEVD computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric 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. - !> Because of large use of BLAS of level 3, DSYEVD needs N**2 more - !> workspace than DSYEVX. + !! DSYEVD computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric 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. + !! Because of large use of BLAS of level 3, DSYEVD needs N**2 more + !! workspace than DSYEVX. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -71856,17 +71852,17 @@ module stdlib_linalg_lapack_d subroutine stdlib_dsygvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, iwork, liwork,& - !> DSYGVD computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric 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. + !! DSYGVD computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71977,15 +71973,15 @@ module stdlib_linalg_lapack_d subroutine stdlib_dsbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, iwork, liwork, & - !> DSBEVD computes all the eigenvalues and, optionally, eigenvectors of - !> a real symmetric 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. + !! DSBEVD computes all the eigenvalues and, optionally, eigenvectors of + !! a real symmetric 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72109,17 +72105,17 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & - !> DSBGVD computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-definite banded eigenproblem, of the - !> form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric 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. + !! DSBGVD computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-definite banded eigenproblem, of the + !! form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric 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. lwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72226,15 +72222,15 @@ module stdlib_linalg_lapack_d subroutine stdlib_dspevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,iwork, liwork, info ) - !> DSPEVD computes all the eigenvalues and, optionally, eigenvectors - !> of a real symmetric 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. + !! DSPEVD computes all the eigenvalues and, optionally, eigenvectors + !! of a real symmetric 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72351,18 +72347,18 @@ module stdlib_linalg_lapack_d subroutine stdlib_dspgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, iwork, liwork,& - !> DSPGVD computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric, 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. + !! DSPGVD computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric, 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72475,22 +72471,22 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dbdsdc( uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq,work, iwork, & - !> DBDSDC 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. DBDSDC 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. + !! DBDSDC 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. DBDSDC 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72733,30 +72729,30 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, work, & - !> DBDSQR 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**T - !> 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**T*VT instead of - !> P**T, for given real input matrices U and VT. When U and VT are the - !> orthogonal matrices that reduce a general matrix A to bidiagonal - !> form: A = U*B*VT, as computed by DGEBRD, then - !> A = (U*Q) * S * (P**T*VT) - !> is the SVD of A. Optionally, the subroutine may also compute Q**T*C - !> for a given real 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. + !! DBDSQR 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**T + !! 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**T*VT instead of + !! P**T, for given real input matrices U and VT. When U and VT are the + !! orthogonal matrices that reduce a general matrix A to bidiagonal + !! form: A = U*B*VT, as computed by DGEBRD, then + !! A = (U*Q) * S * (P**T*VT) + !! is the SVD of A. Optionally, the subroutine may also compute Q**T*C + !! for a given real 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73199,19 +73195,19 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgees( jobvs, sort, select, n, a, lda, sdim, wr, wi,vs, ldvs, work, lwork, & - !> DGEES computes for an N-by-N real nonsymmetric matrix A, the - !> eigenvalues, the real Schur form T, and, optionally, the matrix of - !> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). - !> Optionally, it also orders the eigenvalues on the diagonal of the - !> real 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 matrix is in real Schur form if it is upper quasi-triangular with - !> 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in the - !> form - !> [ a b ] - !> [ c a ] - !> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). + !! DGEES computes for an N-by-N real nonsymmetric matrix A, the + !! eigenvalues, the real Schur form T, and, optionally, the matrix of + !! Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). + !! Optionally, it also orders the eigenvalues on the diagonal of the + !! real 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 matrix is in real Schur form if it is upper quasi-triangular with + !! 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in the + !! form + !! [ a b ] + !! [ c a ] + !! where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73445,25 +73441,25 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgeesx( jobvs, sort, select, sense, n, a, lda, sdim,wr, wi, vs, ldvs, & - !> DGEESX computes for an N-by-N real nonsymmetric matrix A, the - !> eigenvalues, the real Schur form T, and, optionally, the matrix of - !> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). - !> Optionally, it also orders the eigenvalues on the diagonal of the - !> real Schur form so that selected eigenvalues are at the top left; - !> computes a reciprocal condition number for the average of the - !> selected eigenvalues (RCONDE); and computes a reciprocal condition - !> number for the right invariant subspace corresponding to the - !> selected eigenvalues (RCONDV). The leading columns of Z form an - !> orthonormal basis for this invariant subspace. - !> For further explanation of the reciprocal condition numbers RCONDE - !> and RCONDV, see Section 4.10_dp of the LAPACK Users' Guide (where - !> these quantities are called s and sep respectively). - !> A real matrix is in real Schur form if it is upper quasi-triangular - !> with 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in - !> the form - !> [ a b ] - !> [ c a ] - !> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). + !! DGEESX computes for an N-by-N real nonsymmetric matrix A, the + !! eigenvalues, the real Schur form T, and, optionally, the matrix of + !! Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). + !! Optionally, it also orders the eigenvalues on the diagonal of the + !! real Schur form so that selected eigenvalues are at the top left; + !! computes a reciprocal condition number for the average of the + !! selected eigenvalues (RCONDE); and computes a reciprocal condition + !! number for the right invariant subspace corresponding to the + !! selected eigenvalues (RCONDV). The leading columns of Z form an + !! orthonormal basis for this invariant subspace. + !! For further explanation of the reciprocal condition numbers RCONDE + !! and RCONDV, see Section 4.10_dp of the LAPACK Users' Guide (where + !! these quantities are called s and sep respectively). + !! A real matrix is in real Schur form if it is upper quasi-triangular + !! with 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in + !! the form + !! [ a b ] + !! [ c a ] + !! where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). rconde, rcondv, work, lwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73739,16 +73735,16 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgeev( jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr,ldvr, work, lwork, & - !> DGEEV computes for an N-by-N real 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. + !! DGEEV computes for an N-by-N real 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73998,31 +73994,31 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgeevx( balanc, jobvl, jobvr, sense, n, a, lda, wr, wi,vl, ldvl, vr, ldvr, & - !> DGEEVX computes for an N-by-N real nonsymmetric matrix A, the - !> eigenvalues and, optionally, the left and/or right eigenvectors. - !> Optionally also, it computes a balancing transformation to improve - !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, - !> SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues - !> (RCONDE), and reciprocal condition numbers for the right - !> eigenvectors (RCONDV). - !> 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. - !> Balancing a matrix means permuting the rows and columns to make it - !> more nearly upper triangular, and applying a diagonal similarity - !> transformation D * A * D**(-1), where D is a diagonal matrix, to - !> make its rows and columns closer in norm and the condition numbers - !> of its eigenvalues and eigenvectors smaller. The computed - !> reciprocal condition numbers correspond to the balanced matrix. - !> Permuting rows and columns will not change the condition numbers - !> (in exact arithmetic) but diagonal scaling will. For further - !> explanation of balancing, see section 4.10.2_dp of the LAPACK - !> Users' Guide. + !! DGEEVX computes for an N-by-N real nonsymmetric matrix A, the + !! eigenvalues and, optionally, the left and/or right eigenvectors. + !! Optionally also, it computes a balancing transformation to improve + !! the conditioning of the eigenvalues and eigenvectors (ILO, IHI, + !! SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues + !! (RCONDE), and reciprocal condition numbers for the right + !! eigenvectors (RCONDV). + !! 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. + !! Balancing a matrix means permuting the rows and columns to make it + !! more nearly upper triangular, and applying a diagonal similarity + !! transformation D * A * D**(-1), where D is a diagonal matrix, to + !! make its rows and columns closer in norm and the condition numbers + !! of its eigenvalues and eigenvectors smaller. The computed + !! reciprocal condition numbers correspond to the balanced matrix. + !! Permuting rows and columns will not change the condition numbers + !! (in exact arithmetic) but diagonal scaling will. For further + !! explanation of balancing, see section 4.10.2_dp of the LAPACK + !! Users' Guide. ilo, ihi, scale, abnrm,rconde, rcondv, work, lwork, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74310,31 +74306,31 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, iwork, & - !> DGELSD 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. + !! DGELSD 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74633,18 +74629,18 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, info ) - !> DGELSS 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 effective rank of A is determined by treating as zero those - !> singular values which are less than RCOND times the largest singular - !> value. + !! DGELSS 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 effective rank of A is determined by treating as zero those + !! singular values which are less than RCOND times the largest singular + !! value. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75075,25 +75071,25 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, iwork, info ) - !> DGESDD computes the singular value decomposition (SVD) of a real - !> M-by-N matrix A, optionally computing the left and right singular - !> vectors. If singular vectors are desired, it uses a - !> divide-and-conquer algorithm. - !> The SVD is written - !> A = U * SIGMA * 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 orthogonal matrix, and - !> V is an N-by-N orthogonal 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**T, 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. + !! DGESDD computes the singular value decomposition (SVD) of a real + !! M-by-N matrix A, optionally computing the left and right singular + !! vectors. If singular vectors are desired, it uses a + !! divide-and-conquer algorithm. + !! The SVD is written + !! A = U * SIGMA * 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 orthogonal matrix, and + !! V is an N-by-N orthogonal 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**T, 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76046,17 +76042,17 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,vt, ldvt, work, lwork, info ) - !> DGESVD computes the singular value decomposition (SVD) of a real - !> M-by-N matrix A, optionally computing the left and/or right singular - !> vectors. The SVD is written - !> A = U * SIGMA * 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 orthogonal matrix, and - !> V is an N-by-N orthogonal 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**T, not V. + !! DGESVD computes the singular value decomposition (SVD) of a real + !! M-by-N matrix A, optionally computing the left and/or right singular + !! vectors. The SVD is written + !! A = U * SIGMA * 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 orthogonal matrix, and + !! V is an N-by-N orthogonal 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**T, not V. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78305,15 +78301,15 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & - !> DGESVDQ computes the singular value decomposition (SVD) of a real - !> 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 orthogonal 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. + !! DGESVDQ computes the singular value decomposition (SVD) of a real + !! 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 orthogonal 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. numrank, iwork, liwork,work, lwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -79170,32 +79166,32 @@ module stdlib_linalg_lapack_d subroutine stdlib_dgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alphar, & - !> DGGES3 computes for a pair of N-by-N real nonsymmetric matrices (A,B), - !> the generalized eigenvalues, the generalized real Schur form (S,T), - !> optionally, the left and/or right matrices of Schur vectors (VSL and - !> VSR). This gives the generalized Schur factorization - !> (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T ) - !> Optionally, it also orders the eigenvalues so that a selected cluster - !> of eigenvalues appears in the leading diagonal blocks of the upper - !> quasi-triangular matrix S and the upper triangular matrix T.The - !> leading columns of VSL and VSR then form an orthonormal basis for the - !> corresponding left and right eigenspaces (deflating subspaces). - !> (If only the generalized eigenvalues are needed, use the driver - !> DGGEV 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 or both being zero. - !> A pair of matrices (S,T) is in generalized real Schur form if T is - !> upper triangular with non-negative diagonal and S is block upper - !> triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond - !> to real generalized eigenvalues, while 2-by-2 blocks of S will be - !> "standardized" by making the corresponding elements of T have the - !> form: - !> [ a 0 ] - !> [ 0 b ] - !> and the pair of corresponding 2-by-2 blocks in S and T will have a - !> complex conjugate pair of generalized eigenvalues. + !! DGGES3 computes for a pair of N-by-N real nonsymmetric matrices (A,B), + !! the generalized eigenvalues, the generalized real Schur form (S,T), + !! optionally, the left and/or right matrices of Schur vectors (VSL and + !! VSR). This gives the generalized Schur factorization + !! (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T ) + !! Optionally, it also orders the eigenvalues so that a selected cluster + !! of eigenvalues appears in the leading diagonal blocks of the upper + !! quasi-triangular matrix S and the upper triangular matrix T.The + !! leading columns of VSL and VSR then form an orthonormal basis for the + !! corresponding left and right eigenspaces (deflating subspaces). + !! (If only the generalized eigenvalues are needed, use the driver + !! DGGEV 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 or both being zero. + !! A pair of matrices (S,T) is in generalized real Schur form if T is + !! upper triangular with non-negative diagonal and S is block upper + !! triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond + !! to real generalized eigenvalues, while 2-by-2 blocks of S will be + !! "standardized" by making the corresponding elements of T have the + !! form: + !! [ a 0 ] + !! [ 0 b ] + !! and the pair of corresponding 2-by-2 blocks in S and T will have a + !! complex conjugate pair of generalized eigenvalues. alphai, beta, vsl, ldvsl,vsr, ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79484,21 +79480,21 @@ module stdlib_linalg_lapack_d subroutine stdlib_dggev3( jobvl, jobvr, n, a, lda, b, ldb, alphar,alphai, beta, vl, ldvl, vr,& - !> DGGEV3 computes for a pair of N-by-N real 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) - !> of (A,B) satisfies - !> A * v(j) = lambda(j) * B * v(j). - !> The left eigenvector u(j) corresponding to the eigenvalue 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). + !! DGGEV3 computes for a pair of N-by-N real 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) + !! of (A,B) satisfies + !! A * v(j) = lambda(j) * B * v(j). + !! The left eigenvector u(j) corresponding to the eigenvalue 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). ldvr, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79784,14 +79780,14 @@ module stdlib_linalg_lapack_d subroutine stdlib_dhseqr( job, compz, n, ilo, ihi, h, ldh, wr, wi, z,ldz, work, lwork, info ) - !> DHSEQR computes the eigenvalues of a Hessenberg matrix H - !> and, optionally, the matrices T and Z from the Schur decomposition - !> H = Z T Z**T, where T is an upper quasi-triangular matrix (the - !> Schur form), and Z is the orthogonal matrix of Schur vectors. - !> Optionally Z may be postmultiplied into an input orthogonal - !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. + !! DHSEQR computes the eigenvalues of a Hessenberg matrix H + !! and, optionally, the matrices T and Z from the Schur decomposition + !! H = Z T Z**T, where T is an upper quasi-triangular matrix (the + !! Schur form), and Z is the orthogonal matrix of Schur vectors. + !! Optionally Z may be postmultiplied into an input orthogonal + !! 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79931,15 +79927,15 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, difl,& - !> DLALSA 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, DLALSA applies the inverse of the left singular vector - !> matrix of an upper bidiagonal matrix to the right hand side; and if - !> ICOMPQ = 1, DLALSA applies the right singular vector matrix to the - !> right hand side. The singular vector matrices were generated in - !> compact form by DLALSA. + !! DLALSA 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, DLALSA applies the inverse of the left singular vector + !! matrix of an upper bidiagonal matrix to the right hand side; and if + !! ICOMPQ = 1, DLALSA applies the right singular vector matrix to the + !! right hand side. The singular vector matrices were generated in + !! compact form by DLALSA. difr, z, poles, givptr,givcol, ldgcol, perm, givnum, c, s, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80115,20 +80111,20 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, iwork, & - !> DLALSD 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. + !! DLALSD 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80388,14 +80384,14 @@ module stdlib_linalg_lapack_d subroutine stdlib_dlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& - !> DLAQR0 computes the eigenvalues of a Hessenberg matrix H - !> and, optionally, the matrices T and Z from the Schur decomposition - !> H = Z T Z**T, where T is an upper quasi-triangular matrix (the - !> Schur form), and Z is the orthogonal matrix of Schur vectors. - !> Optionally Z may be postmultiplied into an input orthogonal - !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. + !! DLAQR0 computes the eigenvalues of a Hessenberg matrix H + !! and, optionally, the matrices T and Z from the Schur decomposition + !! H = Z T Z**T, where T is an upper quasi-triangular matrix (the + !! Schur form), and Z is the orthogonal matrix of Schur vectors. + !! Optionally Z may be postmultiplied into an input orthogonal + !! 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80758,15 +80754,15 @@ module stdlib_linalg_lapack_d subroutine stdlib_dlaqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& - !> Aggressive early deflation: - !> DLAQR3 accepts as input an upper Hessenberg matrix - !> H and performs an orthogonal similarity transformation - !> designed to detect and deflate fully converged eigenvalues from - !> a trailing principal submatrix. On output H has been over- - !> written by a new Hessenberg matrix that is a perturbation of - !> an orthogonal similarity transformation of H. It is to be - !> hoped that the final version of H has many zero subdiagonal - !> entries. + !! Aggressive early deflation: + !! DLAQR3 accepts as input an upper Hessenberg matrix + !! H and performs an orthogonal similarity transformation + !! designed to detect and deflate fully converged eigenvalues from + !! a trailing principal submatrix. On output H has been over- + !! written by a new Hessenberg matrix that is a perturbation of + !! an orthogonal similarity transformation of H. It is to be + !! hoped that the final version of H has many zero subdiagonal + !! entries. sr, si, v, ldv, nh, t,ldt, nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -81069,20 +81065,20 @@ module stdlib_linalg_lapack_d subroutine stdlib_dlaqr4( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& - !> DLAQR4 implements one level of recursion for DLAQR0. - !> It is a complete implementation of the small bulge multi-shift - !> QR algorithm. It may be called by DLAQR0 and, for large enough - !> deflation window size, it may be called by DLAQR3. This - !> subroutine is identical to DLAQR0 except that it calls DLAQR2 - !> instead of DLAQR3. - !> DLAQR4 computes the eigenvalues of a Hessenberg matrix H - !> and, optionally, the matrices T and Z from the Schur decomposition - !> H = Z T Z**T, where T is an upper quasi-triangular matrix (the - !> Schur form), and Z is the orthogonal matrix of Schur vectors. - !> Optionally Z may be postmultiplied into an input orthogonal - !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. + !! DLAQR4 implements one level of recursion for DLAQR0. + !! It is a complete implementation of the small bulge multi-shift + !! QR algorithm. It may be called by DLAQR0 and, for large enough + !! deflation window size, it may be called by DLAQR3. This + !! subroutine is identical to DLAQR0 except that it calls DLAQR2 + !! instead of DLAQR3. + !! DLAQR4 computes the eigenvalues of a Hessenberg matrix H + !! and, optionally, the matrices T and Z from the Schur decomposition + !! H = Z T Z**T, where T is an upper quasi-triangular matrix (the + !! Schur form), and Z is the orthogonal matrix of Schur vectors. + !! Optionally Z may be postmultiplied into an input orthogonal + !! 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -81440,54 +81436,54 @@ module stdlib_linalg_lapack_d recursive subroutine stdlib_dlaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alphar, & - !> DLAQZ0 computes the eigenvalues of a real 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 real matrix pair (A,B): - !> A = Q1*H*Z1**T, B = Q1*T*Z1**T, - !> as computed by DGGHRD. - !> If JOB='S', then the Hessenberg-triangular pair (H,T) is - !> also reduced to generalized Schur form, - !> H = Q*S*Z**T, T = Q*P*Z**T, - !> where Q and Z are orthogonal matrices, P is an upper triangular - !> matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2 - !> diagonal blocks. - !> The 1-by-1 blocks correspond to real eigenvalues of the matrix pair - !> (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of - !> eigenvalues. - !> Additionally, the 2-by-2 upper triangular diagonal blocks of P - !> corresponding to 2-by-2 blocks of S are reduced to positive diagonal - !> form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0, - !> P(j,j) > 0, and P(j+1,j+1) > 0. - !> Optionally, the orthogonal matrix Q from the generalized Schur - !> factorization may be postmultiplied into an input matrix Q1, and the - !> orthogonal matrix Z may be postmultiplied into an input matrix Z1. - !> If Q1 and Z1 are the orthogonal matrices from DGGHRD that reduced - !> the matrix pair (A,B) to generalized upper Hessenberg form, then the - !> output matrices Q1*Q and Z1*Z are the orthogonal factors from the - !> generalized Schur factorization of (A,B): - !> A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T. - !> 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. - !> Real 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" + !! DLAQZ0 computes the eigenvalues of a real 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 real matrix pair (A,B): + !! A = Q1*H*Z1**T, B = Q1*T*Z1**T, + !! as computed by DGGHRD. + !! If JOB='S', then the Hessenberg-triangular pair (H,T) is + !! also reduced to generalized Schur form, + !! H = Q*S*Z**T, T = Q*P*Z**T, + !! where Q and Z are orthogonal matrices, P is an upper triangular + !! matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2 + !! diagonal blocks. + !! The 1-by-1 blocks correspond to real eigenvalues of the matrix pair + !! (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of + !! eigenvalues. + !! Additionally, the 2-by-2 upper triangular diagonal blocks of P + !! corresponding to 2-by-2 blocks of S are reduced to positive diagonal + !! form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0, + !! P(j,j) > 0, and P(j+1,j+1) > 0. + !! Optionally, the orthogonal matrix Q from the generalized Schur + !! factorization may be postmultiplied into an input matrix Q1, and the + !! orthogonal matrix Z may be postmultiplied into an input matrix Z1. + !! If Q1 and Z1 are the orthogonal matrices from DGGHRD that reduced + !! the matrix pair (A,B) to generalized upper Hessenberg form, then the + !! output matrices Q1*Q and Z1*Z are the orthogonal factors from the + !! generalized Schur factorization of (A,B): + !! A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T. + !! 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. + !! Real 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" alphai, beta,q, ldq, z, ldz, work, lwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -81832,7 +81828,7 @@ module stdlib_linalg_lapack_d recursive subroutine stdlib_dlaqz3( ilschur, ilq, ilz, n, ilo, ihi, nw,a, lda, b, ldb, q, & - !> DLAQZ3 performs AED + !! DLAQZ3 performs AED ldq, z, ldz, ns,nd, alphar, alphai, beta, qc, ldqc,zc, ldzc, work, lwork, rec, info ) ! arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -82104,19 +82100,19 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlarre( range, n, vl, vu, il, iu, d, e, e2,rtol1, rtol2, spltol, & - !> To find the desired eigenvalues of a given real symmetric - !> tridiagonal matrix T, DLARRE: 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, DLARRE also outputs the n - !> Gerschgorin intervals for the matrices L_i D_i L_i^T. + !! To find the desired eigenvalues of a given real symmetric + !! tridiagonal matrix T, DLARRE: 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, DLARRE also outputs the n + !! Gerschgorin intervals for the matrices L_i D_i L_i^T. nsplit, isplit, m,w, werr, wgap, iblock, indexw, gers, pivmin,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82629,13 +82625,13 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasd0( n, sqre, d, e, u, ldu, vt, ldvt, smlsiz, iwork,work, info ) - !> Using a divide and conquer approach, DLASD0: 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. + !! Using a divide and conquer approach, DLASD0: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82768,14 +82764,14 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasda( icompq, smlsiz, n, sqre, d, e, u, ldu, vt, k,difl, difr, z, & - !> Using a divide and conquer approach, DLASDA: 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. + !! Using a divide and conquer approach, DLASDA: 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. poles, givptr, givcol, ldgcol,perm, givnum, c, s, work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82970,18 +82966,18 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasdq( uplo, sqre, n, ncvt, nru, ncc, d, e, vt, ldvt,u, ldu, c, ldc, & - !> DLASDQ 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. + !! DLASDQ 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. work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83135,16 +83131,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasq1( n, d, e, work, info ) - !> DLASQ1 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. + !! DLASQ1 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83227,19 +83223,19 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasq2( n, z, info ) - !> DLASQ2 computes all the eigenvalues of the symmetric positive - !> definite tridiagonal matrix associated with the qd array Z to high - !> relative accuracy are computed to high relative accuracy, in the - !> absence of denormalization, underflow and overflow. - !> To see the relation of Z to the tridiagonal matrix, let L be a - !> unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and - !> let U be an upper bidiagonal matrix with 1's above and diagonal - !> Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the - !> symmetric tridiagonal to which it is similar. - !> Note : DLASQ2 defines a logical variable, IEEE, which is true - !> on machines which follow ieee-754 floating-point standard in their - !> handling of infinities and NaNs, and false otherwise. This variable - !> is passed to DLASQ3. + !! DLASQ2 computes all the eigenvalues of the symmetric positive + !! definite tridiagonal matrix associated with the qd array Z to high + !! relative accuracy are computed to high relative accuracy, in the + !! absence of denormalization, underflow and overflow. + !! To see the relation of Z to the tridiagonal matrix, let L be a + !! unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and + !! let U be an upper bidiagonal matrix with 1's above and diagonal + !! Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the + !! symmetric tridiagonal to which it is similar. + !! Note : DLASQ2 defines a logical variable, IEEE, which is true + !! on machines which follow ieee-754 floating-point standard in their + !! handling of infinities and NaNs, and false otherwise. This variable + !! is passed to DLASQ3. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83615,16 +83611,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dlasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) - !> DLATRF_AA factorizes a panel of a real 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. + !! DLATRF_AA factorizes a panel of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83849,21 +83845,21 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dpteqr( compz, n, d, e, z, ldz, work, info ) - !> DPTEQR computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric positive definite tridiagonal matrix by first factoring the - !> matrix using DPTTRF, and then calling DBDSQR to compute the singular - !> values of the bidiagonal factor. - !> This routine computes the eigenvalues of the positive definite - !> tridiagonal matrix to high relative accuracy. This means that if the - !> eigenvalues range over many orders of magnitude in size, then the - !> small eigenvalues and corresponding eigenvectors will be computed - !> more accurately than, for example, with the standard QR method. - !> The eigenvectors of a full or band symmetric positive definite matrix - !> can also be found if DSYTRD, DSPTRD, or DSBTRD has been used to - !> reduce this matrix to tridiagonal form. (The reduction to tridiagonal - !> form, however, may preclude the possibility of obtaining high - !> relative accuracy in the small eigenvalues of the original matrix, if - !> these eigenvalues range over many orders of magnitude.) + !! DPTEQR computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric positive definite tridiagonal matrix by first factoring the + !! matrix using DPTTRF, and then calling DBDSQR to compute the singular + !! values of the bidiagonal factor. + !! This routine computes the eigenvalues of the positive definite + !! tridiagonal matrix to high relative accuracy. This means that if the + !! eigenvalues range over many orders of magnitude in size, then the + !! small eigenvalues and corresponding eigenvectors will be computed + !! more accurately than, for example, with the standard QR method. + !! The eigenvectors of a full or band symmetric positive definite matrix + !! can also be found if DSYTRD, DSPTRD, or DSBTRD has been used to + !! reduce this matrix to tridiagonal form. (The reduction to tridiagonal + !! form, however, may preclude the possibility of obtaining high + !! relative accuracy in the small eigenvalues of the original matrix, if + !! these eigenvalues range over many orders of magnitude.) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83943,22 +83939,22 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> DSTEGR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has - !> a well defined set of pairwise different real eigenvalues, the corresponding - !> real eigenvectors are pairwise orthogonal. - !> The spectrum may be computed either completely or partially by specifying - !> either an interval (VL,VU] or a range of indices IL:IU for the desired - !> eigenvalues. - !> DSTEGR is a compatibility wrapper around the improved DSTEMR routine. - !> See DSTEMR for further details. - !> One important change is that the ABSTOL parameter no longer provides any - !> benefit and hence is no longer used. - !> Note : DSTEGR and DSTEMR work only on machines which follow - !> IEEE-754 floating-point standard in their handling of infinities and - !> NaNs. Normal execution may create these exceptiona values and hence - !> may abort due to a floating point exception in environments which - !> do not conform to the IEEE-754 standard. + !! DSTEGR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Any such unreduced matrix has + !! a well defined set of pairwise different real eigenvalues, the corresponding + !! real eigenvectors are pairwise orthogonal. + !! The spectrum may be computed either completely or partially by specifying + !! either an interval (VL,VU] or a range of indices IL:IU for the desired + !! eigenvalues. + !! DSTEGR is a compatibility wrapper around the improved DSTEMR routine. + !! See DSTEMR for further details. + !! One important change is that the ABSTOL parameter no longer provides any + !! benefit and hence is no longer used. + !! Note : DSTEGR and DSTEMR work only on machines which follow + !! IEEE-754 floating-point standard in their handling of infinities and + !! NaNs. Normal execution may create these exceptiona values and hence + !! may abort due to a floating point exception in environments which + !! do not conform to the IEEE-754 standard. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83985,51 +83981,51 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & - !> DSTEMR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has - !> a well defined set of pairwise different real eigenvalues, the corresponding - !> real eigenvectors are pairwise orthogonal. - !> The spectrum may be computed either completely or partially by specifying - !> either an interval (VL,VU] or a range of indices IL:IU for the desired - !> eigenvalues. - !> Depending on the number of desired eigenvalues, these are computed either - !> by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are - !> computed by the use of various suitable L D L^T factorizations near clusters - !> of close eigenvalues (referred to as RRRs, Relatively Robust - !> Representations). An informal sketch of the algorithm 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. - !> For more details, see: - !> - 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. - !> Further Details - !> 1.DSTEMR works only on machines which follow IEEE-754 - !> floating-point standard in their handling of infinities and NaNs. - !> This permits the use of efficient inner loops avoiding a check for - !> zero divisors. + !! DSTEMR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Any such unreduced matrix has + !! a well defined set of pairwise different real eigenvalues, the corresponding + !! real eigenvectors are pairwise orthogonal. + !! The spectrum may be computed either completely or partially by specifying + !! either an interval (VL,VU] or a range of indices IL:IU for the desired + !! eigenvalues. + !! Depending on the number of desired eigenvalues, these are computed either + !! by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are + !! computed by the use of various suitable L D L^T factorizations near clusters + !! of close eigenvalues (referred to as RRRs, Relatively Robust + !! Representations). An informal sketch of the algorithm 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. + !! For more details, see: + !! - 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. + !! Further Details + !! 1.DSTEMR works only on machines which follow IEEE-754 + !! floating-point standard in their handling of infinities and NaNs. + !! This permits the use of efficient inner loops avoiding a check for + !! zero divisors. isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84405,41 +84401,41 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dstevr( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & - !> DSTEVR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Eigenvalues and - !> eigenvectors can be selected by specifying either a range of values - !> or a range of indices for the desired eigenvalues. - !> Whenever possible, DSTEVR calls DSTEMR to compute the - !> eigenspectrum using Relatively Robust Representations. DSTEMR - !> 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 the i-th - !> unreduced block of T, - !> (a) Compute T - sigma_i = L_i D_i L_i^T, such that L_i D_i L_i^T - !> is a relatively robust representation, - !> (b) Compute the eigenvalues, lambda_j, of L_i D_i L_i^T to high - !> relative accuracy by the dqds algorithm, - !> (c) If there is a cluster of close eigenvalues, "choose" sigma_i - !> close to the cluster, and go to step (a), - !> (d) Given the approximate eigenvalue lambda_j of L_i D_i L_i^T, - !> compute the corresponding eigenvector by forming a - !> rank-revealing twisted factorization. - !> The desired accuracy of the output can be specified by the input - !> parameter ABSTOL. - !> For more details, see "A new O(n^2) algorithm for the symmetric - !> tridiagonal eigenvalue/eigenvector problem", by Inderjit Dhillon, - !> Computer Science Division Technical Report No. UCB//CSD-97-971, - !> UC Berkeley, May 1997. - !> Note 1 : DSTEVR calls DSTEMR when the full spectrum is requested - !> on machines which conform to the ieee-754 floating point standard. - !> DSTEVR calls DSTEBZ and DSTEIN on non-ieee machines and - !> when partial spectrum requests are made. - !> Normal execution of DSTEMR 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. + !! DSTEVR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Eigenvalues and + !! eigenvectors can be selected by specifying either a range of values + !! or a range of indices for the desired eigenvalues. + !! Whenever possible, DSTEVR calls DSTEMR to compute the + !! eigenspectrum using Relatively Robust Representations. DSTEMR + !! 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 the i-th + !! unreduced block of T, + !! (a) Compute T - sigma_i = L_i D_i L_i^T, such that L_i D_i L_i^T + !! is a relatively robust representation, + !! (b) Compute the eigenvalues, lambda_j, of L_i D_i L_i^T to high + !! relative accuracy by the dqds algorithm, + !! (c) If there is a cluster of close eigenvalues, "choose" sigma_i + !! close to the cluster, and go to step (a), + !! (d) Given the approximate eigenvalue lambda_j of L_i D_i L_i^T, + !! compute the corresponding eigenvector by forming a + !! rank-revealing twisted factorization. + !! The desired accuracy of the output can be specified by the input + !! parameter ABSTOL. + !! For more details, see "A new O(n^2) algorithm for the symmetric + !! tridiagonal eigenvalue/eigenvector problem", by Inderjit Dhillon, + !! Computer Science Division Technical Report No. UCB//CSD-97-971, + !! UC Berkeley, May 1997. + !! Note 1 : DSTEVR calls DSTEMR when the full spectrum is requested + !! on machines which conform to the ieee-754 floating point standard. + !! DSTEVR calls DSTEBZ and DSTEIN on non-ieee machines and + !! when partial spectrum requests are made. + !! Normal execution of DSTEMR 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. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84655,56 +84651,56 @@ module stdlib_linalg_lapack_d subroutine stdlib_dsyevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> DSYEVR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric matrix A. Eigenvalues and eigenvectors can be - !> selected by specifying either a range of values or a range of - !> indices for the desired eigenvalues. - !> DSYEVR first reduces the matrix A to tridiagonal form T with a call - !> to DSYTRD. Then, whenever possible, DSYEVR calls DSTEMR to compute - !> the eigenspectrum using Relatively Robust Representations. DSTEMR - !> 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 DSTEMR'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 : DSYEVR calls DSTEMR when the full spectrum is requested - !> on machines which conform to the ieee-754 floating point standard. - !> DSYEVR calls DSTEBZ and DSTEIN on non-ieee machines and - !> when partial spectrum requests are made. - !> Normal execution of DSTEMR 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. + !! DSYEVR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric matrix A. Eigenvalues and eigenvectors can be + !! selected by specifying either a range of values or a range of + !! indices for the desired eigenvalues. + !! DSYEVR first reduces the matrix A to tridiagonal form T with a call + !! to DSYTRD. Then, whenever possible, DSYEVR calls DSTEMR to compute + !! the eigenspectrum using Relatively Robust Representations. DSTEMR + !! 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 DSTEMR'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 : DSYEVR calls DSTEMR when the full spectrum is requested + !! on machines which conform to the ieee-754 floating point standard. + !! DSYEVR calls DSTEBZ and DSTEIN on non-ieee machines and + !! when partial spectrum requests are made. + !! Normal execution of DSTEMR 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. isuppz, work, lwork,iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84977,16 +84973,16 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> DSYSV computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> Aasen's algorithm is used to factor A as - !> A = U**T * T * U, if UPLO = 'U', or - !> A = L * T * L**T, if UPLO = 'L', - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and T is symmetric tridiagonal. The factored - !> form of A is then used to solve the system of equations A * X = B. + !! DSYSV computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! Aasen's algorithm is used to factor A as + !! A = U**T * T * U, if UPLO = 'U', or + !! A = L * T * L**T, if UPLO = 'L', + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and T is symmetric tridiagonal. The factored + !! form of A is then used to solve the system of equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -85049,12 +85045,12 @@ module stdlib_linalg_lapack_d pure subroutine stdlib_dsytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) - !> DSYTRF_AA computes the factorization of a real symmetric matrix A - !> using the Aasen's algorithm. The form of the factorization is - !> A = U**T*T*U or A = L*T*L**T - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and T is a symmetric tridiagonal matrix. - !> This is the blocked version of the algorithm, calling Level 3 BLAS. + !! DSYTRF_AA computes the factorization of a real symmetric matrix A + !! using the Aasen's algorithm. The form of the factorization is + !! A = U**T*T*U or A = L*T*L**T + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and T is a symmetric tridiagonal matrix. + !! This is the blocked version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_lapack_q.fypp b/src/stdlib_linalg_lapack_q.fypp index 6d4b7d263..a95edf203 100644 --- a/src/stdlib_linalg_lapack_q.fypp +++ b/src/stdlib_linalg_lapack_q.fypp @@ -525,27 +525,27 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qbbcsd( jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q,theta, phi, u1, & - !> DBBCSD: computes the CS decomposition of an orthogonal 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 | ]**T - !> = [---------] [---------------] [---------] . - !> [ | 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 DORCSD for details.) - !> The bidiagonal matrices B11, B12, B21, and B22 are represented - !> implicitly by angles THETA(1:Q) and PHI(1:Q-1). - !> The orthogonal matrices U1, U2, V1T, and V2T are input/output. - !> The input matrices are pre- or post-multiplied by the appropriate - !> singular vector matrices. + !! DBBCSD: computes the CS decomposition of an orthogonal 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 | ]**T + !! = [---------] [---------------] [---------] . + !! [ | 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 DORCSD for details.) + !! The bidiagonal matrices B11, B12, B21, and B22 are represented + !! implicitly by angles THETA(1:Q) and PHI(1:Q-1). + !! The orthogonal matrices U1, U2, V1T, and V2T are input/output. + !! The input matrices are pre- or post-multiplied by the appropriate + !! singular vector matrices. ldu1, u2, ldu2, v1t, ldv1t,v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e,b22d, b22e, work, & lwork, info ) ! -- lapack computational routine -- @@ -1133,22 +1133,22 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qbdsdc( uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq,work, iwork, & - !> DBDSDC: 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. DBDSDC 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. + !! DBDSDC: 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. DBDSDC 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1391,30 +1391,30 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, work, & - !> DBDSQR: 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**T - !> 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**T*VT instead of - !> P**T, for given real input matrices U and VT. When U and VT are the - !> orthogonal matrices that reduce a general matrix A to bidiagonal - !> form: A = U*B*VT, as computed by DGEBRD, then - !> A = (U*Q) * S * (P**T*VT) - !> is the SVD of A. Optionally, the subroutine may also compute Q**T*C - !> for a given real 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. + !! DBDSQR: 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**T + !! 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**T*VT instead of + !! P**T, for given real input matrices U and VT. When U and VT are the + !! orthogonal matrices that reduce a general matrix A to bidiagonal + !! form: A = U*B*VT, as computed by DGEBRD, then + !! A = (U*Q) * S * (P**T*VT) + !! is the SVD of A. Optionally, the subroutine may also compute Q**T*C + !! for a given real 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1857,19 +1857,19 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qdisna( job, m, n, d, sep, info ) - !> DDISNA: 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. - !> DDISNA may also be used to compute error bounds for eigenvectors of - !> the generalized symmetric definite eigenproblem. + !! DDISNA: 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. + !! DDISNA may also be used to compute error bounds for eigenvectors of + !! the generalized symmetric definite eigenproblem. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1962,10 +1962,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & - !> DGBBRD: reduces a real general m-by-n band matrix A to upper - !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. - !> The routine computes B, and optionally forms Q or P**T, or computes - !> Q**T*C for a given matrix C. + !! DGBBRD: reduces a real general m-by-n band matrix A to upper + !! bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. + !! The routine computes B, and optionally forms Q or P**T, or computes + !! Q**T*C for a given matrix C. ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2219,12 +2219,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, iwork, & - !> DGBCON: estimates the reciprocal of the condition number of a real - !> general band matrix A, in either the 1-norm or the infinity-norm, - !> using the LU factorization computed by DGBTRF. - !> 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)) ). + !! DGBCON: estimates the reciprocal of the condition number of a real + !! general band matrix A, in either the 1-norm or the infinity-norm, + !! using the LU factorization computed by DGBTRF. + !! 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)) ). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2348,15 +2348,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) - !> DGBEQU: 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. + !! DGBEQU: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2478,21 +2478,21 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) - !> DGBEQUB: 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 DGEEQU 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). + !! DGBEQUB: 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 DGEEQU 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). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2623,9 +2623,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, x, & - !> DGBRFS: 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. + !! DGBRFS: 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. ldx, ferr, berr, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2824,14 +2824,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) - !> DGBSV: computes the solution to a real 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. + !! DGBSV: computes the solution to a real 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2876,12 +2876,12 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & - !> DGBSVX: uses the LU factorization to compute the solution to a real - !> system of linear equations A * X = B, A**T * X = B, or A**H * 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. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DGBSVX: uses the LU factorization to compute the solution to a real + !! system of linear equations A * X = B, A**T * X = B, or A**H * 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. + !! Error bounds on the solution and a condition estimate are also + !! provided. c, b, ldb, x, ldx,rcond, ferr, berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -3099,9 +3099,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgbtf2( m, n, kl, ku, ab, ldab, ipiv, info ) - !> DGBTF2: computes an LU factorization of a real m-by-n band matrix A - !> using partial pivoting with row interchanges. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! DGBTF2: computes an LU factorization of a real m-by-n band matrix A + !! using partial pivoting with row interchanges. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3185,9 +3185,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) - !> DGBTRF: computes an LU factorization of a real m-by-n band matrix A - !> using partial pivoting with row interchanges. - !> This is the blocked version of the algorithm, calling Level 3 BLAS. + !! DGBTRF: computes an LU factorization of a real m-by-n band matrix A + !! using partial pivoting with row interchanges. + !! This is the blocked version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3435,10 +3435,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) - !> DGBTRS: solves a system of linear equations - !> A * X = B or A**T * X = B - !> with a general band matrix A using the LU factorization computed - !> by DGBTRF. + !! DGBTRS: solves a system of linear equations + !! A * X = B or A**T * X = B + !! with a general band matrix A using the LU factorization computed + !! by DGBTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3529,9 +3529,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) - !> DGEBAK: forms the right or left eigenvectors of a real general matrix - !> by backward transformation on the computed eigenvectors of the - !> balanced matrix output by DGEBAL. + !! DGEBAK: forms the right or left eigenvectors of a real general matrix + !! by backward transformation on the computed eigenvectors of the + !! balanced matrix output by DGEBAL. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3626,14 +3626,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgebal( job, n, a, lda, ilo, ihi, scale, info ) - !> DGEBAL: balances a general real 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. + !! DGEBAL: balances a general real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3794,9 +3794,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgebd2( m, n, a, lda, d, e, tauq, taup, work, info ) - !> DGEBD2: reduces a real general m by n matrix A to upper or lower - !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. - !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. + !! DGEBD2: reduces a real general m by n matrix A to upper or lower + !! bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. + !! If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3886,9 +3886,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) - !> DGEBRD: reduces a general real M-by-N matrix A to upper or lower - !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. - !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. + !! DGEBRD: reduces a general real M-by-N matrix A to upper or lower + !! bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. + !! If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3991,12 +3991,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgecon( norm, n, a, lda, anorm, rcond, work, iwork,info ) - !> DGECON: estimates the reciprocal of the condition number of a general - !> real matrix A, in either the 1-norm or the infinity-norm, using - !> the LU factorization computed by DGETRF. - !> 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)) ). + !! DGECON: estimates the reciprocal of the condition number of a general + !! real matrix A, in either the 1-norm or the infinity-norm, using + !! the LU factorization computed by DGETRF. + !! 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)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4092,15 +4092,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) - !> DGEEQU: 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. + !! DGEEQU: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4215,21 +4215,21 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) - !> DGEEQUB: 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 DGEEQU 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). + !! DGEEQUB: 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 DGEEQU 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). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4354,19 +4354,19 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgees( jobvs, sort, select, n, a, lda, sdim, wr, wi,vs, ldvs, work, lwork, & - !> DGEES: computes for an N-by-N real nonsymmetric matrix A, the - !> eigenvalues, the real Schur form T, and, optionally, the matrix of - !> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). - !> Optionally, it also orders the eigenvalues on the diagonal of the - !> real 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 matrix is in real Schur form if it is upper quasi-triangular with - !> 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in the - !> form - !> [ a b ] - !> [ c a ] - !> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). + !! DGEES: computes for an N-by-N real nonsymmetric matrix A, the + !! eigenvalues, the real Schur form T, and, optionally, the matrix of + !! Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). + !! Optionally, it also orders the eigenvalues on the diagonal of the + !! real 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 matrix is in real Schur form if it is upper quasi-triangular with + !! 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in the + !! form + !! [ a b ] + !! [ c a ] + !! where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4600,25 +4600,25 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgeesx( jobvs, sort, select, sense, n, a, lda, sdim,wr, wi, vs, ldvs, & - !> DGEESX: computes for an N-by-N real nonsymmetric matrix A, the - !> eigenvalues, the real Schur form T, and, optionally, the matrix of - !> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). - !> Optionally, it also orders the eigenvalues on the diagonal of the - !> real Schur form so that selected eigenvalues are at the top left; - !> computes a reciprocal condition number for the average of the - !> selected eigenvalues (RCONDE); and computes a reciprocal condition - !> number for the right invariant subspace corresponding to the - !> selected eigenvalues (RCONDV). The leading columns of Z form an - !> orthonormal basis for this invariant subspace. - !> For further explanation of the reciprocal condition numbers RCONDE - !> and RCONDV, see Section 4.10_qp of the LAPACK Users' Guide (where - !> these quantities are called s and sep respectively). - !> A real matrix is in real Schur form if it is upper quasi-triangular - !> with 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in - !> the form - !> [ a b ] - !> [ c a ] - !> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). + !! DGEESX: computes for an N-by-N real nonsymmetric matrix A, the + !! eigenvalues, the real Schur form T, and, optionally, the matrix of + !! Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). + !! Optionally, it also orders the eigenvalues on the diagonal of the + !! real Schur form so that selected eigenvalues are at the top left; + !! computes a reciprocal condition number for the average of the + !! selected eigenvalues (RCONDE); and computes a reciprocal condition + !! number for the right invariant subspace corresponding to the + !! selected eigenvalues (RCONDV). The leading columns of Z form an + !! orthonormal basis for this invariant subspace. + !! For further explanation of the reciprocal condition numbers RCONDE + !! and RCONDV, see Section 4.10_qp of the LAPACK Users' Guide (where + !! these quantities are called s and sep respectively). + !! A real matrix is in real Schur form if it is upper quasi-triangular + !! with 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in + !! the form + !! [ a b ] + !! [ c a ] + !! where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). rconde, rcondv, work, lwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4894,16 +4894,16 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgeev( jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr,ldvr, work, lwork, & - !> DGEEV: computes for an N-by-N real 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. + !! DGEEV: computes for an N-by-N real 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5153,31 +5153,31 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgeevx( balanc, jobvl, jobvr, sense, n, a, lda, wr, wi,vl, ldvl, vr, ldvr, & - !> DGEEVX: computes for an N-by-N real nonsymmetric matrix A, the - !> eigenvalues and, optionally, the left and/or right eigenvectors. - !> Optionally also, it computes a balancing transformation to improve - !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, - !> SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues - !> (RCONDE), and reciprocal condition numbers for the right - !> eigenvectors (RCONDV). - !> 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. - !> Balancing a matrix means permuting the rows and columns to make it - !> more nearly upper triangular, and applying a diagonal similarity - !> transformation D * A * D**(-1), where D is a diagonal matrix, to - !> make its rows and columns closer in norm and the condition numbers - !> of its eigenvalues and eigenvectors smaller. The computed - !> reciprocal condition numbers correspond to the balanced matrix. - !> Permuting rows and columns will not change the condition numbers - !> (in exact arithmetic) but diagonal scaling will. For further - !> explanation of balancing, see section 4.10.2_qp of the LAPACK - !> Users' Guide. + !! DGEEVX: computes for an N-by-N real nonsymmetric matrix A, the + !! eigenvalues and, optionally, the left and/or right eigenvectors. + !! Optionally also, it computes a balancing transformation to improve + !! the conditioning of the eigenvalues and eigenvectors (ILO, IHI, + !! SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues + !! (RCONDE), and reciprocal condition numbers for the right + !! eigenvectors (RCONDV). + !! 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. + !! Balancing a matrix means permuting the rows and columns to make it + !! more nearly upper triangular, and applying a diagonal similarity + !! transformation D * A * D**(-1), where D is a diagonal matrix, to + !! make its rows and columns closer in norm and the condition numbers + !! of its eigenvalues and eigenvectors smaller. The computed + !! reciprocal condition numbers correspond to the balanced matrix. + !! Permuting rows and columns will not change the condition numbers + !! (in exact arithmetic) but diagonal scaling will. For further + !! explanation of balancing, see section 4.10.2_qp of the LAPACK + !! Users' Guide. ilo, ihi, scale, abnrm,rconde, rcondv, work, lwork, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5465,8 +5465,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgehd2( n, ilo, ihi, a, lda, tau, work, info ) - !> DGEHD2: reduces a real general matrix A to upper Hessenberg form H by - !> an orthogonal similarity transformation: Q**T * A * Q = H . + !! DGEHD2: reduces a real general matrix A to upper Hessenberg form H by + !! an orthogonal similarity transformation: Q**T * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5517,8 +5517,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info ) - !> DGEHRD: reduces a real general matrix A to upper Hessenberg form H by - !> an orthogonal similarity transformation: Q**T * A * Q = H . + !! DGEHRD: reduces a real general matrix A to upper Hessenberg form H by + !! an orthogonal similarity transformation: Q**T * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5646,18 +5646,18 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & - !> DGEJSV: computes the singular value decomposition (SVD) of a real M-by-N - !> matrix [A], where M >= N. The SVD of [A] is written as - !> [A] = [U] * [SIGMA] * [V]^t, - !> 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) orthonormal matrix, and - !> [V] is an N-by-N orthogonal 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. - !> DGEJSV can sometimes compute tiny singular values and their singular vectors much - !> more accurately than other SVD routines, see below under Further Details. + !! DGEJSV: computes the singular value decomposition (SVD) of a real M-by-N + !! matrix [A], where M >= N. The SVD of [A] is written as + !! [A] = [U] * [SIGMA] * [V]^t, + !! 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) orthonormal matrix, and + !! [V] is an N-by-N orthogonal 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. + !! DGEJSV can sometimes compute tiny singular values and their singular vectors much + !! more accurately than other SVD routines, see below under Further Details. v, ldv,work, lwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -6736,12 +6736,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgelq( m, n, a, lda, t, tsize, work, lwork,info ) - !> DGELQ: computes an LQ factorization of a real 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. + !! DGELQ: computes an LQ factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -6861,12 +6861,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgelq2( m, n, a, lda, tau, work, info ) - !> DGELQ2: computes an LQ factorization of a real 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. + !! DGELQ2: computes an LQ factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6915,12 +6915,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgelqf( m, n, a, lda, tau, work, lwork, info ) - !> DGELQF: computes an LQ factorization of a real 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. + !! DGELQF: computes an LQ factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7012,8 +7012,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgelqt( m, n, mb, a, lda, t, ldt, work, info ) - !> DGELQT: computes a blocked LQ factorization of a real M-by-N matrix A - !> using the compact WY representation of Q. + !! DGELQT: computes a blocked LQ factorization of a real M-by-N matrix A + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7063,10 +7063,10 @@ module stdlib_linalg_lapack_q pure recursive subroutine stdlib_qgelqt3( m, n, a, lda, t, ldt, info ) - !> DGELQT3: recursively computes a LQ factorization of a real 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. + !! DGELQT3: recursively computes a LQ factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7150,24 +7150,24 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) - !> DGELS: solves overdetermined or underdetermined real linear systems - !> involving an M-by-N matrix A, or its 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 = 'T' and m >= n: find the minimum norm solution of - !> an underdetermined system A**T * X = B. - !> 4. If TRANS = 'T' 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. + !! DGELS: solves overdetermined or underdetermined real linear systems + !! involving an M-by-N matrix A, or its 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 = 'T' and m >= n: find the minimum norm solution of + !! an underdetermined system A**T * X = B. + !! 4. If TRANS = 'T' 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7367,31 +7367,31 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, iwork, & - !> DGELSD: 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. + !! DGELSD: 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7690,18 +7690,18 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, info ) - !> DGELSS: 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 effective rank of A is determined by treating as zero those - !> singular values which are less than RCOND times the largest singular - !> value. + !! DGELSS: 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 effective rank of A is determined by treating as zero those + !! singular values which are less than RCOND times the largest singular + !! value. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8132,38 +8132,38 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, info ) - !> DGELSY: computes the minimum-norm solution to a real 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 orthogonal 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**T [ inv(T11)*Q1**T*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 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. - !> o The permutation of matrix B (the right hand side) is faster and - !> more simple. + !! DGELSY: computes the minimum-norm solution to a real 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 orthogonal 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**T [ inv(T11)*Q1**T*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 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. + !! o The permutation of matrix B (the right hand side) is faster and + !! more simple. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8365,13 +8365,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & - !> DGEMLQ: overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product - !> of blocked elementary reflectors computed by short wide LQ - !> factorization (DGELQ) + !! DGEMLQ: overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product + !! of blocked elementary reflectors computed by short wide LQ + !! factorization (DGELQ) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8462,15 +8462,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) - !> DGEMLQT: overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q C C Q - !> TRANS = 'T': Q**T C C Q**T - !> where Q is a real orthogonal matrix defined as the product of K - !> elementary reflectors: - !> Q = H(1) H(2) . . . H(K) = I - V T V**T - !> generated using the compact WY representation as returned by DGELQT. - !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. + !! DGEMLQT: overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q C C Q + !! TRANS = 'T': Q**T C C Q**T + !! where Q is a real orthogonal matrix defined as the product of K + !! elementary reflectors: + !! Q = H(1) H(2) . . . H(K) = I - V T V**T + !! generated using the compact WY representation as returned by DGELQT. + !! Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8560,13 +8560,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & - !> DGEMQR: overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product - !> of blocked elementary reflectors computed by tall skinny - !> QR factorization (DGEQR) + !! DGEMQR: overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product + !! of blocked elementary reflectors computed by tall skinny + !! QR factorization (DGEQR) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8657,15 +8657,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) - !> DGEMQRT: overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q C C Q - !> TRANS = 'T': Q**T C C Q**T - !> where Q is a real orthogonal matrix defined as the product of K - !> elementary reflectors: - !> Q = H(1) H(2) . . . H(K) = I - V T V**T - !> generated using the compact WY representation as returned by DGEQRT. - !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. + !! DGEMQRT: overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q C C Q + !! TRANS = 'T': Q**T C C Q**T + !! where Q is a real orthogonal matrix defined as the product of K + !! elementary reflectors: + !! Q = H(1) H(2) . . . H(K) = I - V T V**T + !! generated using the compact WY representation as returned by DGEQRT. + !! Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8755,8 +8755,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgeql2( m, n, a, lda, tau, work, info ) - !> DGEQL2: computes a QL factorization of a real m by n matrix A: - !> A = Q * L. + !! DGEQL2: computes a QL factorization of a real m by n matrix A: + !! A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8804,8 +8804,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgeqlf( m, n, a, lda, tau, work, lwork, info ) - !> DGEQLF: computes a QL factorization of a real M-by-N matrix A: - !> A = Q * L. + !! DGEQLF: computes a QL factorization of a real M-by-N matrix A: + !! A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8910,8 +8910,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgeqp3( m, n, a, lda, jpvt, tau, work, lwork, info ) - !> DGEQP3: computes a QR factorization with column pivoting of a - !> matrix A: A*P = Q*R using Level 3 BLAS. + !! DGEQP3: computes a QR factorization with column pivoting of a + !! matrix A: A*P = Q*R using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9060,13 +9060,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgeqr( m, n, a, lda, t, tsize, work, lwork,info ) - !> DGEQR: computes a QR factorization of a real 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. + !! DGEQR: computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -9175,13 +9175,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgeqr2( m, n, a, lda, tau, work, info ) - !> DGEQR2: computes a QR factorization of a real 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. + !! DGEQR2: computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9230,14 +9230,14 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgeqr2p( m, n, a, lda, tau, work, info ) - !> DGEQR2P: computes a QR factorization of a real 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. + !! DGEQR2P: computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9286,13 +9286,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgeqrf( m, n, a, lda, tau, work, lwork, info ) - !> DGEQRF: computes a QR factorization of a real 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. + !! DGEQRF: computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9388,14 +9388,14 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgeqrfp( m, n, a, lda, tau, work, lwork, info ) - !> DGEQR2P computes a QR factorization of a real 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. + !! DGEQR2P computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9487,8 +9487,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgeqrt( m, n, nb, a, lda, t, ldt, work, info ) - !> DGEQRT: computes a blocked QR factorization of a real M-by-N matrix A - !> using the compact WY representation of Q. + !! DGEQRT: computes a blocked QR factorization of a real M-by-N matrix A + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9544,8 +9544,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgeqrt2( m, n, a, lda, t, ldt, info ) - !> DGEQRT2: computes a QR factorization of a real M-by-N matrix A, - !> using the compact WY representation of Q. + !! DGEQRT2: computes a QR factorization of a real M-by-N matrix A, + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9612,10 +9612,10 @@ module stdlib_linalg_lapack_q pure recursive subroutine stdlib_qgeqrt3( m, n, a, lda, t, ldt, info ) - !> DGEQRT3: recursively computes a QR factorization of a real 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. + !! DGEQRT3: recursively computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9697,9 +9697,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & - !> DGERFS: improves the computed solution to a system of linear - !> equations and provides error bounds and backward error estimates for - !> the solution. + !! DGERFS: improves the computed solution to a system of linear + !! equations and provides error bounds and backward error estimates for + !! the solution. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -9890,8 +9890,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgerq2( m, n, a, lda, tau, work, info ) - !> DGERQ2: computes an RQ factorization of a real m by n matrix A: - !> A = R * Q. + !! DGERQ2: computes an RQ factorization of a real m by n matrix A: + !! A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9939,8 +9939,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgerqf( m, n, a, lda, tau, work, lwork, info ) - !> DGERQF: computes an RQ factorization of a real M-by-N matrix A: - !> A = R * Q. + !! DGERQF: computes an RQ factorization of a real M-by-N matrix A: + !! A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10045,10 +10045,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) - !> DGESC2: solves a system of linear equations - !> A * X = scale* RHS - !> with a general N-by-N matrix A using the LU factorization with - !> complete pivoting computed by DGETC2. + !! DGESC2: solves a system of linear equations + !! A * X = scale* RHS + !! with a general N-by-N matrix A using the LU factorization with + !! complete pivoting computed by DGETC2. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10103,25 +10103,25 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, iwork, info ) - !> DGESDD: computes the singular value decomposition (SVD) of a real - !> M-by-N matrix A, optionally computing the left and right singular - !> vectors. If singular vectors are desired, it uses a - !> divide-and-conquer algorithm. - !> The SVD is written - !> A = U * SIGMA * 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 orthogonal matrix, and - !> V is an N-by-N orthogonal 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**T, 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. + !! DGESDD: computes the singular value decomposition (SVD) of a real + !! M-by-N matrix A, optionally computing the left and right singular + !! vectors. If singular vectors are desired, it uses a + !! divide-and-conquer algorithm. + !! The SVD is written + !! A = U * SIGMA * 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 orthogonal matrix, and + !! V is an N-by-N orthogonal 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**T, 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -11074,15 +11074,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) - !> DGESV: computes the solution to a real 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. + !! DGESV: computes the solution to a real 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11122,17 +11122,17 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,vt, ldvt, work, lwork, info ) - !> DGESVD: computes the singular value decomposition (SVD) of a real - !> M-by-N matrix A, optionally computing the left and/or right singular - !> vectors. The SVD is written - !> A = U * SIGMA * 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 orthogonal matrix, and - !> V is an N-by-N orthogonal 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**T, not V. + !! DGESVD: computes the singular value decomposition (SVD) of a real + !! M-by-N matrix A, optionally computing the left and/or right singular + !! vectors. The SVD is written + !! A = U * SIGMA * 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 orthogonal matrix, and + !! V is an N-by-N orthogonal 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**T, not V. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13381,15 +13381,15 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & - !> DGESVDQ: computes the singular value decomposition (SVD) of a real - !> 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 orthogonal 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. + !! DGESVDQ: computes the singular value decomposition (SVD) of a real + !! 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 orthogonal 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. numrank, iwork, liwork,work, lwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -14246,17 +14246,17 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, work, lwork, & - !> DGESVJ: computes the singular value decomposition (SVD) of a real - !> M-by-N matrix A, where M >= N. The SVD of A is written as - !> [++] [xx] [x0] [xx] - !> A = U * SIGMA * V^t, [++] = [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 orthogonal 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. - !> DGESVJ can sometimes compute tiny singular values and their singular vectors much - !> more accurately than other SVD routines, see below under Further Details. + !! DGESVJ: computes the singular value decomposition (SVD) of a real + !! M-by-N matrix A, where M >= N. The SVD of A is written as + !! [++] [xx] [x0] [xx] + !! A = U * SIGMA * V^t, [++] = [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 orthogonal 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. + !! DGESVJ can sometimes compute tiny singular values and their singular vectors much + !! more accurately than other SVD routines, see below under Further Details. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15225,12 +15225,12 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & - !> DGESVX: uses the LU factorization to compute the solution to a real - !> system of linear equations - !> A * X = B, - !> where A is an N-by-N matrix and X and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DGESVX: uses the LU factorization to compute the solution to a real + !! system of linear equations + !! A * X = B, + !! where A is an N-by-N matrix and X and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. x, ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15429,11 +15429,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgetc2( n, a, lda, ipiv, jpiv, info ) - !> DGETC2: computes an LU factorization with complete pivoting of the - !> n-by-n matrix A. The factorization has the form A = P * L * U * Q, - !> where P and Q are permutation matrices, L is lower triangular with - !> unit diagonal elements and U is upper triangular. - !> This is the Level 2 BLAS algorithm. + !! DGETC2: computes an LU factorization with complete pivoting of the + !! n-by-n matrix A. The factorization has the form A = P * L * U * Q, + !! where P and Q are permutation matrices, L is lower triangular with + !! unit diagonal elements and U is upper triangular. + !! This is the Level 2 BLAS algorithm. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15513,14 +15513,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgetf2( m, n, a, lda, ipiv, info ) - !> DGETF2: 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 2 BLAS version of the algorithm. + !! DGETF2: 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 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15586,14 +15586,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgetrf( m, n, a, lda, ipiv, info ) - !> DGETRF: 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. + !! DGETRF: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15664,25 +15664,25 @@ module stdlib_linalg_lapack_q pure recursive subroutine stdlib_qgetrf2( m, n, a, lda, ipiv, info ) - !> DGETRF2: 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. + !! DGETRF2: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15779,10 +15779,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgetri( n, a, lda, ipiv, work, lwork, info ) - !> DGETRI: computes the inverse of a matrix using the LU factorization - !> computed by DGETRF. - !> This method inverts U and then computes inv(A) by solving the system - !> inv(A)*L = inv(U) for inv(A). + !! DGETRI: computes the inverse of a matrix using the LU factorization + !! computed by DGETRF. + !! This method inverts U and then computes inv(A) by solving the system + !! inv(A)*L = inv(U) for inv(A). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15881,10 +15881,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) - !> DGETRS: solves a system of linear equations - !> A * X = B or A**T * X = B - !> with a general N-by-N matrix A using the LU factorization computed - !> by DGETRF. + !! DGETRS: solves a system of linear equations + !! A * X = B or A**T * X = B + !! with a general N-by-N matrix A using the LU factorization computed + !! by DGETRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15950,24 +15950,24 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) - !> DGETSLS: solves overdetermined or underdetermined real 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 = 'T' and m >= n: find the minimum norm solution of - !> an undetermined system A**T * X = B. - !> 4. If TRANS = 'T' 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. + !! DGETSLS: solves overdetermined or underdetermined real 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 = 'T' and m >= n: find the minimum norm solution of + !! an undetermined system A**T * X = B. + !! 4. If TRANS = 'T' 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16186,18 +16186,18 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) - !> DGETSQRHRT: computes a NB2-sized column blocked QR-factorization - !> of a real 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 DGEQRT - !> (Q is in blocked compact WY-representation). See the documentation - !> of DGEQRT for more details on the format. + !! DGETSQRHRT: computes a NB2-sized column blocked QR-factorization + !! of a real 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 DGEQRT + !! (Q is in blocked compact WY-representation). See the documentation + !! of DGEQRT for more details on the format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16319,10 +16319,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) - !> DGGBAK: forms the right or left eigenvectors of a real generalized - !> eigenvalue problem A*x = lambda*B*x, by backward transformation on - !> the computed eigenvectors of the balanced pair of matrices output by - !> DGGBAL. + !! DGGBAK: forms the right or left eigenvectors of a real generalized + !! eigenvalue problem A*x = lambda*B*x, by backward transformation on + !! the computed eigenvectors of the balanced pair of matrices output by + !! DGGBAL. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16432,15 +16432,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) - !> DGGBAL: balances a pair of general real 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. + !! DGGBAL: balances a pair of general real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16726,32 +16726,32 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alphar, & - !> DGGES: computes for a pair of N-by-N real nonsymmetric matrices (A,B), - !> the generalized eigenvalues, the generalized real Schur form (S,T), - !> optionally, the left and/or right matrices of Schur vectors (VSL and - !> VSR). This gives the generalized Schur factorization - !> (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T ) - !> Optionally, it also orders the eigenvalues so that a selected cluster - !> of eigenvalues appears in the leading diagonal blocks of the upper - !> quasi-triangular matrix S and the upper triangular matrix T.The - !> leading columns of VSL and VSR then form an orthonormal basis for the - !> corresponding left and right eigenspaces (deflating subspaces). - !> (If only the generalized eigenvalues are needed, use the driver - !> DGGEV 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 or both being zero. - !> A pair of matrices (S,T) is in generalized real Schur form if T is - !> upper triangular with non-negative diagonal and S is block upper - !> triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond - !> to real generalized eigenvalues, while 2-by-2 blocks of S will be - !> "standardized" by making the corresponding elements of T have the - !> form: - !> [ a 0 ] - !> [ 0 b ] - !> and the pair of corresponding 2-by-2 blocks in S and T will have a - !> complex conjugate pair of generalized eigenvalues. + !! DGGES: computes for a pair of N-by-N real nonsymmetric matrices (A,B), + !! the generalized eigenvalues, the generalized real Schur form (S,T), + !! optionally, the left and/or right matrices of Schur vectors (VSL and + !! VSR). This gives the generalized Schur factorization + !! (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T ) + !! Optionally, it also orders the eigenvalues so that a selected cluster + !! of eigenvalues appears in the leading diagonal blocks of the upper + !! quasi-triangular matrix S and the upper triangular matrix T.The + !! leading columns of VSL and VSR then form an orthonormal basis for the + !! corresponding left and right eigenspaces (deflating subspaces). + !! (If only the generalized eigenvalues are needed, use the driver + !! DGGEV 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 or both being zero. + !! A pair of matrices (S,T) is in generalized real Schur form if T is + !! upper triangular with non-negative diagonal and S is block upper + !! triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond + !! to real generalized eigenvalues, while 2-by-2 blocks of S will be + !! "standardized" by making the corresponding elements of T have the + !! form: + !! [ a 0 ] + !! [ 0 b ] + !! and the pair of corresponding 2-by-2 blocks in S and T will have a + !! complex conjugate pair of generalized eigenvalues. alphai, beta, vsl, ldvsl, vsr,ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17045,32 +17045,32 @@ module stdlib_linalg_lapack_q subroutine stdlib_qgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alphar, & - !> DGGES3: computes for a pair of N-by-N real nonsymmetric matrices (A,B), - !> the generalized eigenvalues, the generalized real Schur form (S,T), - !> optionally, the left and/or right matrices of Schur vectors (VSL and - !> VSR). This gives the generalized Schur factorization - !> (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T ) - !> Optionally, it also orders the eigenvalues so that a selected cluster - !> of eigenvalues appears in the leading diagonal blocks of the upper - !> quasi-triangular matrix S and the upper triangular matrix T.The - !> leading columns of VSL and VSR then form an orthonormal basis for the - !> corresponding left and right eigenspaces (deflating subspaces). - !> (If only the generalized eigenvalues are needed, use the driver - !> DGGEV 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 or both being zero. - !> A pair of matrices (S,T) is in generalized real Schur form if T is - !> upper triangular with non-negative diagonal and S is block upper - !> triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond - !> to real generalized eigenvalues, while 2-by-2 blocks of S will be - !> "standardized" by making the corresponding elements of T have the - !> form: - !> [ a 0 ] - !> [ 0 b ] - !> and the pair of corresponding 2-by-2 blocks in S and T will have a - !> complex conjugate pair of generalized eigenvalues. + !! DGGES3: computes for a pair of N-by-N real nonsymmetric matrices (A,B), + !! the generalized eigenvalues, the generalized real Schur form (S,T), + !! optionally, the left and/or right matrices of Schur vectors (VSL and + !! VSR). This gives the generalized Schur factorization + !! (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T ) + !! Optionally, it also orders the eigenvalues so that a selected cluster + !! of eigenvalues appears in the leading diagonal blocks of the upper + !! quasi-triangular matrix S and the upper triangular matrix T.The + !! leading columns of VSL and VSR then form an orthonormal basis for the + !! corresponding left and right eigenspaces (deflating subspaces). + !! (If only the generalized eigenvalues are needed, use the driver + !! DGGEV 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 or both being zero. + !! A pair of matrices (S,T) is in generalized real Schur form if T is + !! upper triangular with non-negative diagonal and S is block upper + !! triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond + !! to real generalized eigenvalues, while 2-by-2 blocks of S will be + !! "standardized" by making the corresponding elements of T have the + !! form: + !! [ a 0 ] + !! [ 0 b ] + !! and the pair of corresponding 2-by-2 blocks in S and T will have a + !! complex conjugate pair of generalized eigenvalues. alphai, beta, vsl, ldvsl,vsr, ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17359,34 +17359,34 @@ module stdlib_linalg_lapack_q subroutine stdlib_qggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, & - !> DGGESX: computes for a pair of N-by-N real nonsymmetric matrices - !> (A,B), the generalized eigenvalues, the real Schur form (S,T), and, - !> optionally, the left and/or right matrices of Schur vectors (VSL and - !> VSR). This gives the generalized Schur factorization - !> (A,B) = ( (VSL) S (VSR)**T, (VSL) T (VSR)**T ) - !> Optionally, it also orders the eigenvalues so that a selected cluster - !> of eigenvalues appears in the leading diagonal blocks of the upper - !> quasi-triangular matrix S and the upper triangular matrix T; computes - !> a reciprocal condition number for the average of the selected - !> eigenvalues (RCONDE); and computes a reciprocal condition number for - !> the right and left deflating subspaces corresponding to the selected - !> eigenvalues (RCONDV). The leading columns of VSL and VSR then form - !> an orthonormal basis for the corresponding left and right eigenspaces - !> (deflating subspaces). - !> 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 or for both being zero. - !> A pair of matrices (S,T) is in generalized real Schur form if T is - !> upper triangular with non-negative diagonal and S is block upper - !> triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond - !> to real generalized eigenvalues, while 2-by-2 blocks of S will be - !> "standardized" by making the corresponding elements of T have the - !> form: - !> [ a 0 ] - !> [ 0 b ] - !> and the pair of corresponding 2-by-2 blocks in S and T will have a - !> complex conjugate pair of generalized eigenvalues. + !! DGGESX: computes for a pair of N-by-N real nonsymmetric matrices + !! (A,B), the generalized eigenvalues, the real Schur form (S,T), and, + !! optionally, the left and/or right matrices of Schur vectors (VSL and + !! VSR). This gives the generalized Schur factorization + !! (A,B) = ( (VSL) S (VSR)**T, (VSL) T (VSR)**T ) + !! Optionally, it also orders the eigenvalues so that a selected cluster + !! of eigenvalues appears in the leading diagonal blocks of the upper + !! quasi-triangular matrix S and the upper triangular matrix T; computes + !! a reciprocal condition number for the average of the selected + !! eigenvalues (RCONDE); and computes a reciprocal condition number for + !! the right and left deflating subspaces corresponding to the selected + !! eigenvalues (RCONDV). The leading columns of VSL and VSR then form + !! an orthonormal basis for the corresponding left and right eigenspaces + !! (deflating subspaces). + !! 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 or for both being zero. + !! A pair of matrices (S,T) is in generalized real Schur form if T is + !! upper triangular with non-negative diagonal and S is block upper + !! triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond + !! to real generalized eigenvalues, while 2-by-2 blocks of S will be + !! "standardized" by making the corresponding elements of T have the + !! form: + !! [ a 0 ] + !! [ 0 b ] + !! and the pair of corresponding 2-by-2 blocks in S and T will have a + !! complex conjugate pair of generalized eigenvalues. alphar, alphai, beta, vsl, ldvsl,vsr, ldvsr, rconde, rcondv, work, lwork, iwork,liwork, & bwork, info ) ! -- lapack driver routine -- @@ -17729,21 +17729,21 @@ module stdlib_linalg_lapack_q subroutine stdlib_qggev( jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai,beta, vl, ldvl, vr, & - !> DGGEV: computes for a pair of N-by-N real 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) - !> of (A,B) satisfies - !> A * v(j) = lambda(j) * B * v(j). - !> The left eigenvector u(j) corresponding to the eigenvalue 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). + !! DGGEV: computes for a pair of N-by-N real 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) + !! of (A,B) satisfies + !! A * v(j) = lambda(j) * B * v(j). + !! The left eigenvector u(j) corresponding to the eigenvalue 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). ldvr, work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -18027,21 +18027,21 @@ module stdlib_linalg_lapack_q subroutine stdlib_qggev3( jobvl, jobvr, n, a, lda, b, ldb, alphar,alphai, beta, vl, ldvl, vr,& - !> DGGEV3: computes for a pair of N-by-N real 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) - !> of (A,B) satisfies - !> A * v(j) = lambda(j) * B * v(j). - !> The left eigenvector u(j) corresponding to the eigenvalue 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). + !! DGGEV3: computes for a pair of N-by-N real 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) + !! of (A,B) satisfies + !! A * v(j) = lambda(j) * B * v(j). + !! The left eigenvector u(j) corresponding to the eigenvalue 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). ldvr, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -18327,26 +18327,26 @@ module stdlib_linalg_lapack_q subroutine stdlib_qggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alphar, alphai, & - !> DGGEVX: computes for a pair of N-by-N real nonsymmetric matrices (A,B) - !> the generalized eigenvalues, and optionally, the left and/or right - !> generalized eigenvectors. - !> Optionally also, it computes a balancing transformation to improve - !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, - !> LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for - !> the eigenvalues (RCONDE), and reciprocal condition numbers for the - !> right eigenvectors (RCONDV). - !> 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) - !> of (A,B) satisfies - !> A * v(j) = lambda(j) * B * v(j) . - !> The left eigenvector u(j) corresponding to the eigenvalue 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). + !! DGGEVX: computes for a pair of N-by-N real nonsymmetric matrices (A,B) + !! the generalized eigenvalues, and optionally, the left and/or right + !! generalized eigenvectors. + !! Optionally also, it computes a balancing transformation to improve + !! the conditioning of the eigenvalues and eigenvectors (ILO, IHI, + !! LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for + !! the eigenvalues (RCONDE), and reciprocal condition numbers for the + !! right eigenvectors (RCONDV). + !! 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) + !! of (A,B) satisfies + !! A * v(j) = lambda(j) * B * v(j) . + !! The left eigenvector u(j) corresponding to the eigenvalue 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). beta, vl, ldvl, vr, ldvr, ilo,ihi, lscale, rscale, abnrm, bbnrm, rconde,rcondv, work, lwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -18722,24 +18722,24 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) - !> DGGGLM: 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. + !! DGGGLM: 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18858,31 +18858,31 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & - !> DGGHD3: reduces a pair of real matrices (A,B) to generalized upper - !> Hessenberg form using orthogonal 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 orthogonal matrix Q to the left side - !> of the equation. - !> This subroutine simultaneously reduces A to a Hessenberg matrix H: - !> Q**T*A*Z = H - !> and transforms B to another upper triangular matrix T: - !> Q**T*B*Z = T - !> in order to reduce the problem to its standard form - !> H*y = lambda*T*y - !> where y = Z**T*x. - !> The orthogonal 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**T = (Q1*Q) * H * (Z1*Z)**T - !> Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T - !> If Q1 is the orthogonal matrix from the QR factorization of B in the - !> original equation A*x = lambda*B*x, then DGGHD3 reduces the original - !> problem to generalized Hessenberg form. - !> This is a blocked variant of DGGHRD, using matrix-matrix - !> multiplications for parts of the computation to enhance performance. + !! DGGHD3: reduces a pair of real matrices (A,B) to generalized upper + !! Hessenberg form using orthogonal 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 orthogonal matrix Q to the left side + !! of the equation. + !! This subroutine simultaneously reduces A to a Hessenberg matrix H: + !! Q**T*A*Z = H + !! and transforms B to another upper triangular matrix T: + !! Q**T*B*Z = T + !! in order to reduce the problem to its standard form + !! H*y = lambda*T*y + !! where y = Z**T*x. + !! The orthogonal 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**T = (Q1*Q) * H * (Z1*Z)**T + !! Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T + !! If Q1 is the orthogonal matrix from the QR factorization of B in the + !! original equation A*x = lambda*B*x, then DGGHD3 reduces the original + !! problem to generalized Hessenberg form. + !! This is a blocked variant of DGGHRD, using matrix-matrix + !! multiplications for parts of the computation to enhance performance. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19385,29 +19385,29 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & - !> DGGHRD: reduces a pair of real matrices (A,B) to generalized upper - !> Hessenberg form using orthogonal 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 orthogonal matrix Q to the left side - !> of the equation. - !> This subroutine simultaneously reduces A to a Hessenberg matrix H: - !> Q**T*A*Z = H - !> and transforms B to another upper triangular matrix T: - !> Q**T*B*Z = T - !> in order to reduce the problem to its standard form - !> H*y = lambda*T*y - !> where y = Z**T*x. - !> The orthogonal 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**T = (Q1*Q) * H * (Z1*Z)**T - !> Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T - !> If Q1 is the orthogonal matrix from the QR factorization of B in the - !> original equation A*x = lambda*B*x, then DGGHRD reduces the original - !> problem to generalized Hessenberg form. + !! DGGHRD: reduces a pair of real matrices (A,B) to generalized upper + !! Hessenberg form using orthogonal 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 orthogonal matrix Q to the left side + !! of the equation. + !! This subroutine simultaneously reduces A to a Hessenberg matrix H: + !! Q**T*A*Z = H + !! and transforms B to another upper triangular matrix T: + !! Q**T*B*Z = T + !! in order to reduce the problem to its standard form + !! H*y = lambda*T*y + !! where y = Z**T*x. + !! The orthogonal 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**T = (Q1*Q) * H * (Z1*Z)**T + !! Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T + !! If Q1 is the orthogonal matrix from the QR factorization of B in the + !! original equation A*x = lambda*B*x, then DGGHRD reduces the original + !! problem to generalized Hessenberg form. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19515,18 +19515,18 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) - !> DGGLSE: 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. + !! DGGLSE: 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19647,24 +19647,24 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) - !> DGGQRF: 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 orthogonal matrix, Z is a P-by-P orthogonal - !> 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**T*(inv(T)*R) - !> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the - !> transpose of the matrix Z. + !! DGGQRF: 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 orthogonal matrix, Z is a P-by-P orthogonal + !! 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**T*(inv(T)*R) + !! where inv(B) denotes the inverse of the matrix B, and Z**T denotes the + !! transpose of the matrix Z. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19725,24 +19725,24 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) - !> DGGRQF: 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 orthogonal matrix, Z is a P-by-P orthogonal - !> 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**T - !> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the - !> transpose of the matrix Z. + !! DGGRQF: 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 orthogonal matrix, Z is a P-by-P orthogonal + !! 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**T + !! where inv(B) denotes the inverse of the matrix B, and Z**T denotes the + !! transpose of the matrix Z. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19803,10 +19803,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & - !> DGSVJ0: is called from DGESVJ as a pre-processor and that is its main - !> purpose. It applies Jacobi rotations in the same way as DGESVJ does, but - !> it does not check convergence (stopping criterion). Few tuning - !> parameters (marked by [TP]) are available for the implementer. + !! DGSVJ0: is called from DGESVJ as a pre-processor and that is its main + !! purpose. It applies Jacobi rotations in the same way as DGESVJ does, but + !! it does not check convergence (stopping criterion). Few tuning + !! parameters (marked by [TP]) are available for the implementer. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20451,30 +20451,30 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & - !> DGSVJ1: is called from DGESVJ as a pre-processor and that is its main - !> purpose. It applies Jacobi rotations in the same way as DGESVJ 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 - !> ~~~~~~~~~~~~~~~ - !> DGSVJ1 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. + !! DGSVJ1: is called from DGESVJ as a pre-processor and that is its main + !! purpose. It applies Jacobi rotations in the same way as DGESVJ 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 + !! ~~~~~~~~~~~~~~~ + !! DGSVJ1 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. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20882,11 +20882,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, iwork, info & - !> DGTCON: estimates the reciprocal of the condition number of a real - !> tridiagonal matrix A using the LU factorization as computed by - !> DGTTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! DGTCON: estimates the reciprocal of the condition number of a real + !! tridiagonal matrix A using the LU factorization as computed by + !! DGTTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20965,9 +20965,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, x, & - !> DGTRFS: 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. + !! DGTRFS: 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. ldx, ferr, berr, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21167,12 +21167,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgtsv( n, nrhs, dl, d, du, b, ldb, info ) - !> DGTSV: 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. + !! DGTSV: 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21346,12 +21346,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & - !> DGTSVX: uses the LU factorization to compute the solution to a real - !> system of linear equations A * X = B or A**T * X = B, - !> where A is a tridiagonal matrix of order N and X and B are N-by-NRHS - !> matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DGTSVX: uses the LU factorization to compute the solution to a real + !! system of linear equations A * X = B or A**T * X = B, + !! where A is a tridiagonal matrix of order N and X and B are N-by-NRHS + !! matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ldb, x, ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21435,13 +21435,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgttrf( n, dl, d, du, du2, ipiv, info ) - !> DGTTRF: computes an LU factorization of a real 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. + !! DGTTRF: computes an LU factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21527,10 +21527,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) - !> DGTTRS: solves one of the systems of equations - !> A*X = B or A**T*X = B, - !> with a tridiagonal matrix A using the LU factorization computed - !> by DGTTRF. + !! DGTTRS: solves one of the systems of equations + !! A*X = B or A**T*X = B, + !! with a tridiagonal matrix A using the LU factorization computed + !! by DGTTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21591,10 +21591,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) - !> DGTTS2: solves one of the systems of equations - !> A*X = B or A**T*X = B, - !> with a tridiagonal matrix A using the LU factorization computed - !> by DGTTRF. + !! DGTTS2: solves one of the systems of equations + !! A*X = B or A**T*X = B, + !! with a tridiagonal matrix A using the LU factorization computed + !! by DGTTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21704,49 +21704,49 @@ module stdlib_linalg_lapack_q subroutine stdlib_qhgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alphar, alphai, & - !> DHGEQZ: computes the eigenvalues of a real 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 real matrix pair (A,B): - !> A = Q1*H*Z1**T, B = Q1*T*Z1**T, - !> as computed by DGGHRD. - !> If JOB='S', then the Hessenberg-triangular pair (H,T) is - !> also reduced to generalized Schur form, - !> H = Q*S*Z**T, T = Q*P*Z**T, - !> where Q and Z are orthogonal matrices, P is an upper triangular - !> matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2 - !> diagonal blocks. - !> The 1-by-1 blocks correspond to real eigenvalues of the matrix pair - !> (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of - !> eigenvalues. - !> Additionally, the 2-by-2 upper triangular diagonal blocks of P - !> corresponding to 2-by-2 blocks of S are reduced to positive diagonal - !> form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0, - !> P(j,j) > 0, and P(j+1,j+1) > 0. - !> Optionally, the orthogonal matrix Q from the generalized Schur - !> factorization may be postmultiplied into an input matrix Q1, and the - !> orthogonal matrix Z may be postmultiplied into an input matrix Z1. - !> If Q1 and Z1 are the orthogonal matrices from DGGHRD that reduced - !> the matrix pair (A,B) to generalized upper Hessenberg form, then the - !> output matrices Q1*Q and Z1*Z are the orthogonal factors from the - !> generalized Schur factorization of (A,B): - !> A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T. - !> 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. - !> Real 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. + !! DHGEQZ: computes the eigenvalues of a real 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 real matrix pair (A,B): + !! A = Q1*H*Z1**T, B = Q1*T*Z1**T, + !! as computed by DGGHRD. + !! If JOB='S', then the Hessenberg-triangular pair (H,T) is + !! also reduced to generalized Schur form, + !! H = Q*S*Z**T, T = Q*P*Z**T, + !! where Q and Z are orthogonal matrices, P is an upper triangular + !! matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2 + !! diagonal blocks. + !! The 1-by-1 blocks correspond to real eigenvalues of the matrix pair + !! (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of + !! eigenvalues. + !! Additionally, the 2-by-2 upper triangular diagonal blocks of P + !! corresponding to 2-by-2 blocks of S are reduced to positive diagonal + !! form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0, + !! P(j,j) > 0, and P(j+1,j+1) > 0. + !! Optionally, the orthogonal matrix Q from the generalized Schur + !! factorization may be postmultiplied into an input matrix Q1, and the + !! orthogonal matrix Z may be postmultiplied into an input matrix Z1. + !! If Q1 and Z1 are the orthogonal matrices from DGGHRD that reduced + !! the matrix pair (A,B) to generalized upper Hessenberg form, then the + !! output matrices Q1*Q and Z1*Z are the orthogonal factors from the + !! generalized Schur factorization of (A,B): + !! A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T. + !! 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. + !! Real 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. beta, q, ldq, z, ldz, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22579,12 +22579,12 @@ module stdlib_linalg_lapack_q subroutine stdlib_qhsein( side, eigsrc, initv, select, n, h, ldh, wr, wi,vl, ldvl, vr, ldvr, & - !> DHSEIN: uses inverse iteration to find specified right and/or left - !> eigenvectors of a real 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. + !! DHSEIN: uses inverse iteration to find specified right and/or left + !! eigenvectors of a real 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. mm, m, work, ifaill,ifailr, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22794,14 +22794,14 @@ module stdlib_linalg_lapack_q subroutine stdlib_qhseqr( job, compz, n, ilo, ihi, h, ldh, wr, wi, z,ldz, work, lwork, info ) - !> DHSEQR: computes the eigenvalues of a Hessenberg matrix H - !> and, optionally, the matrices T and Z from the Schur decomposition - !> H = Z T Z**T, where T is an upper quasi-triangular matrix (the - !> Schur form), and Z is the orthogonal matrix of Schur vectors. - !> Optionally Z may be postmultiplied into an input orthogonal - !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. + !! DHSEQR: computes the eigenvalues of a Hessenberg matrix H + !! and, optionally, the matrices T and Z from the Schur decomposition + !! H = Z T Z**T, where T is an upper quasi-triangular matrix (the + !! Schur form), and Z is the orthogonal matrix of Schur vectors. + !! Optionally Z may be postmultiplied into an input orthogonal + !! 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22941,9 +22941,9 @@ module stdlib_linalg_lapack_q pure logical(lk) function stdlib_qisnan( din ) - !> DISNAN: returns .TRUE. if its argument is NaN, and .FALSE. - !> otherwise. To be replaced by the Fortran 2003 intrinsic in the - !> future. + !! DISNAN: returns .TRUE. if its argument is NaN, and .FALSE. + !! otherwise. To be replaced by the Fortran 2003 intrinsic in the + !! future. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22957,19 +22957,19 @@ module stdlib_linalg_lapack_q subroutine stdlib_qla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23143,15 +23143,15 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qla_gbrcond( trans, n, kl, ku, ab, ldab,afb, ldafb, ipiv, cmode, c,& - !> DLA_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. + !! DLA_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. info, work, iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23301,12 +23301,12 @@ module stdlib_linalg_lapack_q pure real(qp) function stdlib_qla_gbrpvgrw( n, kl, ku, ncols, ab,ldab, afb, ldafb ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23341,19 +23341,19 @@ module stdlib_linalg_lapack_q subroutine stdlib_qla_geamv ( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23520,15 +23520,15 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qla_gercond( trans, n, a, lda, af,ldaf, ipiv, cmode, c,info, work, & - !> DLA_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. + !! DLA_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. iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23670,12 +23670,12 @@ module stdlib_linalg_lapack_q pure real(qp) function stdlib_qla_gerpvgrw( n, ncols, a, lda, af,ldaf ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23709,11 +23709,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qla_lin_berr ( n, nz, nrhs, res, ayb, berr ) - !> DLA_LIN_BERR: computes component-wise 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 component-wise absolute value of the matrix - !> or vector Z. + !! DLA_LIN_BERR: computes component-wise 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 component-wise absolute value of the matrix + !! or vector Z. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23750,15 +23750,15 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qla_porcond( uplo, n, a, lda, af, ldaf,cmode, c, info, work,iwork ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23909,12 +23909,12 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qla_porpvgrw( uplo, ncols, a, lda, af,ldaf, work ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23997,18 +23997,18 @@ module stdlib_linalg_lapack_q subroutine stdlib_qla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24186,15 +24186,15 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qla_syrcond( uplo, n, a, lda, af, ldaf,ipiv, cmode, c, info, work,& - !> DLA_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. + !! DLA_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. iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24353,12 +24353,12 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qla_syrpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24537,9 +24537,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qla_wwaddw( n, x, y, w ) - !> DLA_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. + !! DLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24564,14 +24564,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlabad( small, large ) - !> DLABAD: 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. + !! DLABAD: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24592,13 +24592,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) - !> DLABRD: reduces the first NB rows and columns of a real general - !> m by n matrix A to upper or lower bidiagonal form by an orthogonal - !> transformation Q**T * 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 DGEBRD + !! DLABRD: reduces the first NB rows and columns of a real general + !! m by n matrix A to upper or lower bidiagonal form by an orthogonal + !! transformation Q**T * 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 DGEBRD ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24722,8 +24722,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlacn2( n, v, x, isgn, est, kase, isave ) - !> DLACN2: estimates the 1-norm of a square, real matrix A. - !> Reverse communication is used for evaluating matrix-vector products. + !! DLACN2: estimates the 1-norm of a square, real matrix A. + !! Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24855,8 +24855,8 @@ module stdlib_linalg_lapack_q subroutine stdlib_qlacon( n, v, x, isgn, est, kase ) - !> DLACON: estimates the 1-norm of a square, real matrix A. - !> Reverse communication is used for evaluating matrix-vector products. + !! DLACON: estimates the 1-norm of a square, real matrix A. + !! Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24976,8 +24976,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlacpy( uplo, m, n, a, lda, b, ldb ) - !> DLACPY: copies all or part of a two-dimensional matrix A to another - !> matrix B. + !! DLACPY: copies all or part of a two-dimensional matrix A to another + !! matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25017,13 +25017,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qladiv( a, b, c, d, p, q ) - !> DLADIV: 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" + !! DLADIV: 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" ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25132,11 +25132,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlae2( a, b, c, rt1, rt2 ) - !> DLAE2: computes the eigenvalues of a 2-by-2 symmetric matrix - !> [ A B ] - !> [ B C ]. - !> On return, RT1 is the eigenvalue of larger absolute value, and RT2 - !> is the eigenvalue of smaller absolute value. + !! DLAE2: computes the eigenvalues of a 2-by-2 symmetric matrix + !! [ A B ] + !! [ B C ]. + !! On return, RT1 is the eigenvalue of larger absolute value, and RT2 + !! is the eigenvalue of smaller absolute value. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25196,37 +25196,37 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaebz( ijob, nitmax, n, mmax, minp, nbmin, abstol,reltol, pivmin, d, & - !> DLAEBZ: 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. + !! DLAEBZ: 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. e, e2, nval, ab, c, mout,nab, work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25467,8 +25467,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaed0( icompq, qsiz, n, d, e, q, ldq, qstore, ldqs,work, iwork, info & - !> DLAED0: computes all eigenvalues and corresponding eigenvectors of a - !> symmetric tridiagonal matrix using the divide and conquer method. + !! DLAED0: computes all eigenvalues and corresponding eigenvectors of a + !! symmetric tridiagonal matrix using the divide and conquer method. ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25671,32 +25671,32 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaed1( n, d, q, ldq, indxq, rho, cutpnt, work, iwork,info ) - !> DLAED1: 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. + !! DLAED1: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25774,12 +25774,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaed2( k, n, n1, d, q, ldq, indxq, rho, z, dlamda, w,q2, indx, indxc,& - !> DLAED2: 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 entry in the - !> Z vector. For each such occurrence the order of the related secular - !> equation problem is reduced by one. + !! DLAED2: 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 entry in the + !! Z vector. For each such occurrence the order of the related secular + !! equation problem is reduced by one. indxp, coltyp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26031,18 +26031,18 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaed3( k, n, n1, d, q, ldq, rho, dlamda, q2, indx,ctot, w, s, info ) - !> DLAED3: finds the roots of the secular equation, as defined by the - !> values in D, W, and RHO, between 1 and K. It makes the - !> appropriate calls to DLAED4 and then updates the eigenvectors by - !> multiplying the matrix of eigenvectors of the pair of eigensystems - !> being combined by the matrix of eigenvectors of the K-by-K system - !> which is solved here. - !> 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. + !! DLAED3: finds the roots of the secular equation, as defined by the + !! values in D, W, and RHO, between 1 and K. It makes the + !! appropriate calls to DLAED4 and then updates the eigenvectors by + !! multiplying the matrix of eigenvectors of the pair of eigensystems + !! being combined by the matrix of eigenvectors of the K-by-K system + !! which is solved here. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26166,16 +26166,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaed4( n, i, d, z, delta, rho, dlam, info ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26771,13 +26771,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaed5( i, d, z, delta, rho, dlam ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26842,17 +26842,17 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaed6( kniter, orgati, rho, d, z, finit, tau, info ) - !> DLAED6: 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. + !! DLAED6: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27068,32 +27068,32 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaed7( icompq, n, qsiz, tlvls, curlvl, curpbm, d, q,ldq, indxq, rho, & - !> DLAED7: 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 symmetric matrix - !> that has been reduced to tridiagonal form. DLAED1 handles - !> the case in which all eigenvalues and eigenvectors of a symmetric - !> tridiagonal matrix are desired. - !> T = Q(in) ( D(in) + RHO * Z*Z**T ) Q**T(in) = Q(out) * D(out) * Q**T(out) - !> where Z = Q**Tu, 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 DLAED8. - !> 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 DLAED9). - !> 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. + !! DLAED7: 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 symmetric matrix + !! that has been reduced to tridiagonal form. DLAED1 handles + !! the case in which all eigenvalues and eigenvectors of a symmetric + !! tridiagonal matrix are desired. + !! T = Q(in) ( D(in) + RHO * Z*Z**T ) Q**T(in) = Q(out) * D(out) * Q**T(out) + !! where Z = Q**Tu, 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 DLAED8. + !! 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 DLAED9). + !! 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. cutpnt, qstore, qptr, prmptr,perm, givptr, givcol, givnum, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27202,12 +27202,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaed8( icompq, k, n, qsiz, d, q, ldq, indxq, rho,cutpnt, z, dlamda, & - !> DLAED8: 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. + !! DLAED8: 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. q2, ldq2, w, perm, givptr,givcol, givnum, indxp, indx, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27425,10 +27425,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaed9( k, kstart, kstop, n, d, q, ldq, rho, dlamda, w,s, lds, info ) - !> DLAED9: 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. + !! DLAED9: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27531,9 +27531,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaeda( n, tlvls, curlvl, curpbm, prmptr, perm, givptr,givcol, givnum,& - !> DLAEDA: computes the Z vector corresponding to the merge step in the - !> CURLVLth step of the merge process with TLVLS steps for the CURPBMth - !> problem. + !! DLAEDA: computes the Z vector corresponding to the merge step in the + !! CURLVLth step of the merge process with TLVLS steps for the CURPBMth + !! problem. q, qptr, z, ztemp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27636,9 +27636,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaein( rightv, noinit, n, h, ldh, wr, wi, vr, vi, b,ldb, work, eps3, & - !> DLAEIN: uses inverse iteration to find a right or left eigenvector - !> corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg - !> matrix H. + !! DLAEIN: uses inverse iteration to find a right or left eigenvector + !! corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg + !! matrix H. smlnum, bignum, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27982,14 +27982,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaev2( a, b, c, rt1, rt2, cs1, sn1 ) - !> DLAEV2: computes the eigendecomposition of a 2-by-2 symmetric matrix - !> [ A B ] - !> [ B C ]. - !> On return, RT1 is the eigenvalue of larger absolute value, RT2 is the - !> eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right - !> eigenvector for RT1, giving the decomposition - !> [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ] - !> [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ]. + !! DLAEV2: computes the eigendecomposition of a 2-by-2 symmetric matrix + !! [ A B ] + !! [ B C ]. + !! On return, RT1 is the eigenvalue of larger absolute value, RT2 is the + !! eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right + !! eigenvector for RT1, giving the decomposition + !! [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ] + !! [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ]. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28081,13 +28081,13 @@ module stdlib_linalg_lapack_q subroutine stdlib_qlaexc( wantq, n, t, ldt, q, ldq, j1, n1, n2, work,info ) - !> DLAEXC: 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. + !! DLAEXC: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28279,12 +28279,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlag2( a, lda, b, ldb, safmin, scale1, scale2, wr1,wr2, wi ) - !> DLAG2: computes the eigenvalues of a 2 x 2 generalized eigenvalue - !> problem A - w B, with scaling as necessary to avoid over-/underflow. - !> The scaling factor "s" results in a modified eigenvalue equation - !> s A - w B - !> where s is a non-negative scaling factor chosen so that w, w B, - !> and s A do not overflow and, if possible, do not underflow, either. + !! DLAG2: computes the eigenvalues of a 2 x 2 generalized eigenvalue + !! problem A - w B, with scaling as necessary to avoid over-/underflow. + !! The scaling factor "s" results in a modified eigenvalue equation + !! s A - w B + !! where s is a non-negative scaling factor chosen so that w, w B, + !! and s A do not overflow and, if possible, do not underflow, either. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28463,12 +28463,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlag2s( m, n, a, lda, sa, ldsa, info ) - !> DLAG2S: converts a DOUBLE PRECISION matrix, SA, to a SINGLE - !> PRECISION matrix, A. - !> RMAX is the overflow for the SINGLE PRECISION arithmetic - !> DLAG2S checks that all the entries of A are between -RMAX and - !> RMAX. If not the conversion is aborted and a flag is raised. - !> This is an auxiliary routine so there is no argument checking. + !! DLAG2S: converts a DOUBLE PRECISION matrix, SA, to a SINGLE + !! PRECISION matrix, A. + !! RMAX is the overflow for the SINGLE PRECISION arithmetic + !! DLAG2S checks that all the entries of A are between -RMAX and + !! RMAX. If not the conversion is aborted and a flag is raised. + !! This is an auxiliary routine so there is no argument checking. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28500,23 +28500,23 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) - !> DLAGS2: computes 2-by-2 orthogonal matrices U, V and Q, such - !> that if ( UPPER ) then - !> U**T *A*Q = U**T *( A1 A2 )*Q = ( x 0 ) - !> ( 0 A3 ) ( x x ) - !> and - !> V**T*B*Q = V**T *( B1 B2 )*Q = ( x 0 ) - !> ( 0 B3 ) ( x x ) - !> or if ( .NOT.UPPER ) then - !> U**T *A*Q = U**T *( A1 0 )*Q = ( x x ) - !> ( A2 A3 ) ( 0 x ) - !> and - !> V**T*B*Q = V**T*( B1 0 )*Q = ( x x ) - !> ( B2 B3 ) ( 0 x ) - !> The rows of the transformed A and B are parallel, where - !> U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ ) - !> ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ ) - !> Z**T denotes the transpose of Z. + !! DLAGS2: computes 2-by-2 orthogonal matrices U, V and Q, such + !! that if ( UPPER ) then + !! U**T *A*Q = U**T *( A1 A2 )*Q = ( x 0 ) + !! ( 0 A3 ) ( x x ) + !! and + !! V**T*B*Q = V**T *( B1 B2 )*Q = ( x 0 ) + !! ( 0 B3 ) ( x x ) + !! or if ( .NOT.UPPER ) then + !! U**T *A*Q = U**T *( A1 0 )*Q = ( x x ) + !! ( A2 A3 ) ( 0 x ) + !! and + !! V**T*B*Q = V**T*( B1 0 )*Q = ( x x ) + !! ( B2 B3 ) ( 0 x ) + !! The rows of the transformed A and B are parallel, where + !! U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ ) + !! ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ ) + !! Z**T denotes the transpose of Z. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28660,18 +28660,18 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlagtf( n, a, lambda, b, c, tol, d, in, info ) - !> DLAGTF: 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 DLAGTF may - !> be used, in conjunction with DLAGTS, to obtain eigenvectors of T by - !> inverse iteration. + !! DLAGTF: 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 DLAGTF may + !! be used, in conjunction with DLAGTS, to obtain eigenvectors of T by + !! inverse iteration. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28751,11 +28751,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) - !> DLAGTM: 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. + !! DLAGTM: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28853,15 +28853,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlagts( job, n, a, b, c, d, in, y, tol, info ) - !> DLAGTS: 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. + !! DLAGTS: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29050,23 +29050,23 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlagv2( a, lda, b, ldb, alphar, alphai, beta, csl, snl,csr, snr ) - !> DLAGV2: computes the Generalized Schur factorization of a real 2-by-2 - !> matrix pencil (A,B) where B is upper triangular. This routine - !> computes orthogonal (rotation) matrices given by CSL, SNL and CSR, - !> SNR such that - !> 1) if the pencil (A,B) has two real eigenvalues (include 0/0 or 1/0 - !> types), then - !> [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ] - !> [ 0 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ] - !> [ b11 b12 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] - !> [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ], - !> 2) if the pencil (A,B) has a pair of complex conjugate eigenvalues, - !> then - !> [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ] - !> [ a21 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ] - !> [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] - !> [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ] - !> where b11 >= b22 > 0. + !! DLAGV2: computes the Generalized Schur factorization of a real 2-by-2 + !! matrix pencil (A,B) where B is upper triangular. This routine + !! computes orthogonal (rotation) matrices given by CSL, SNL and CSR, + !! SNR such that + !! 1) if the pencil (A,B) has two real eigenvalues (include 0/0 or 1/0 + !! types), then + !! [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ] + !! [ 0 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ] + !! [ b11 b12 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] + !! [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ], + !! 2) if the pencil (A,B) has a pair of complex conjugate eigenvalues, + !! then + !! [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ] + !! [ a21 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ] + !! [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] + !! [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ] + !! where b11 >= b22 > 0. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29214,10 +29214,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlahqr( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, & - !> DLAHQR: is an auxiliary routine called by DHSEQR to update the - !> eigenvalues and Schur decomposition already computed by DHSEQR, by - !> dealing with the Hessenberg submatrix in rows and columns ILO to - !> IHI. + !! DLAHQR: is an auxiliary routine called by DHSEQR to update the + !! eigenvalues and Schur decomposition already computed by DHSEQR, by + !! dealing with the Hessenberg submatrix in rows and columns ILO to + !! IHI. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29523,12 +29523,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) - !> DLAHR2: reduces the first NB columns of A real general n-BY-(n-k+1) - !> matrix A so that elements below the k-th subdiagonal are zero. The - !> reduction is performed by an orthogonal similarity transformation - !> Q**T * A * Q. The routine returns the matrices V and T which determine - !> Q as a block reflector I - V*T*V**T, and also the matrix Y = A * V * T. - !> This is an auxiliary routine called by DGEHRD. + !! DLAHR2: reduces the first NB columns of A real general n-BY-(n-k+1) + !! matrix A so that elements below the k-th subdiagonal are zero. The + !! reduction is performed by an orthogonal similarity transformation + !! Q**T * A * Q. The routine returns the matrices V and T which determine + !! Q as a block reflector I - V*T*V**T, and also the matrix Y = A * V * T. + !! This is an auxiliary routine called by DGEHRD. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29611,26 +29611,26 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaic1( job, j, x, sest, w, gamma, sestpr, s, c ) - !> DLAIC1: 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 DLAIC1 computes sestpr, s, c such that - !> the vector - !> [ s*x ] - !> xhat = [ c ] - !> is an approximate singular vector of - !> [ L 0 ] - !> Lhat = [ w**T 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]**T and sestpr**2 is an eigenpair of the system - !> diag(sest*sest, 0) + [alpha gamma] * [ alpha ] - !> [ gamma ] - !> where alpha = x**T*w. + !! DLAIC1: 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 DLAIC1 computes sestpr, s, c such that + !! the vector + !! [ s*x ] + !! xhat = [ c ] + !! is an approximate singular vector of + !! [ L 0 ] + !! Lhat = [ w**T 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]**T and sestpr**2 is an eigenpair of the system + !! diag(sest*sest, 0) + [alpha gamma] * [ alpha ] + !! [ gamma ] + !! where alpha = x**T*w. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29823,17 +29823,17 @@ module stdlib_linalg_lapack_q pure logical(lk) function stdlib_qlaisnan( din1, din2 ) - !> This routine is not for general use. It exists solely to avoid - !> over-optimization in DISNAN. - !> DLAISNAN: 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. + !! This routine is not for general use. It exists solely to avoid + !! over-optimization in DISNAN. + !! DLAISNAN: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29847,31 +29847,31 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaln2( ltrans, na, nw, smin, ca, a, lda, d1, d2, b,ldb, wr, wi, x, & - !> DLALN2: solves a system of the form (ca A - w D ) X = s B - !> or (ca A**T - w D) X = s B with possible scaling ("s") and - !> perturbation of A. (A**T means A-transpose.) - !> A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA - !> real diagonal matrix, w is a real or complex value, and X and B are - !> NA x 1 matrices -- real if w is real, complex if w is complex. NA - !> may be 1 or 2. - !> If w is complex, X and B are represented as NA x 2 matrices, - !> the first column of each being the real part and the second - !> being the imaginary part. - !> "s" is a scaling factor (<= 1), computed by DLALN2, which is - !> so chosen that X can be computed without overflow. X is further - !> scaled if necessary to assure that norm(ca A - w D)*norm(X) is less - !> than overflow. - !> If both singular values of (ca A - w D) are less than SMIN, - !> SMIN*identity will be used instead of (ca A - w D). If only one - !> singular value is less than SMIN, one element of (ca A - w D) will be - !> perturbed enough to make the smallest singular value roughly SMIN. - !> If both singular values are at least SMIN, (ca A - w D) will not be - !> perturbed. In any case, the perturbation will be at most some small - !> multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values - !> are computed by infinity-norm approximations, and thus will only be - !> correct to a factor of 2 or so. - !> Note: all input quantities are assumed to be smaller than overflow - !> by a reasonable factor. (See BIGNUM.) + !! DLALN2: solves a system of the form (ca A - w D ) X = s B + !! or (ca A**T - w D) X = s B with possible scaling ("s") and + !! perturbation of A. (A**T means A-transpose.) + !! A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA + !! real diagonal matrix, w is a real or complex value, and X and B are + !! NA x 1 matrices -- real if w is real, complex if w is complex. NA + !! may be 1 or 2. + !! If w is complex, X and B are represented as NA x 2 matrices, + !! the first column of each being the real part and the second + !! being the imaginary part. + !! "s" is a scaling factor (<= 1), computed by DLALN2, which is + !! so chosen that X can be computed without overflow. X is further + !! scaled if necessary to assure that norm(ca A - w D)*norm(X) is less + !! than overflow. + !! If both singular values of (ca A - w D) are less than SMIN, + !! SMIN*identity will be used instead of (ca A - w D). If only one + !! singular value is less than SMIN, one element of (ca A - w D) will be + !! perturbed enough to make the smallest singular value roughly SMIN. + !! If both singular values are at least SMIN, (ca A - w D) will not be + !! perturbed. In any case, the perturbation will be at most some small + !! multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values + !! are computed by infinity-norm approximations, and thus will only be + !! correct to a factor of 2 or so. + !! Note: all input quantities are assumed to be smaller than overflow + !! by a reasonable factor. (See BIGNUM.) ldx, scale, xnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30172,26 +30172,26 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, & - !> DLALS0: 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). + !! DLALS0: 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). givcol, ldgcol, givnum, ldgnum,poles, difl, difr, z, k, c, s, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30369,15 +30369,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, difl,& - !> DLALSA: 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, DLALSA applies the inverse of the left singular vector - !> matrix of an upper bidiagonal matrix to the right hand side; and if - !> ICOMPQ = 1, DLALSA applies the right singular vector matrix to the - !> right hand side. The singular vector matrices were generated in - !> compact form by DLALSA. + !! DLALSA: 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, DLALSA applies the inverse of the left singular vector + !! matrix of an upper bidiagonal matrix to the right hand side; and if + !! ICOMPQ = 1, DLALSA applies the right singular vector matrix to the + !! right hand side. The singular vector matrices were generated in + !! compact form by DLALSA. difr, z, poles, givptr,givcol, ldgcol, perm, givnum, c, s, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30553,20 +30553,20 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, iwork, & - !> DLALSD: 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. + !! DLALSD: 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30826,7 +30826,7 @@ module stdlib_linalg_lapack_q pure real(qp) function stdlib_qlamch( cmach ) - !> DLAMCH: determines quad precision machine parameters. + !! DLAMCH: determines quad precision machine parameters. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30894,9 +30894,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlamrg( n1, n2, a, dtrd1, dtrd2, index ) - !> DLAMRG: 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. + !! DLAMRG: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30958,13 +30958,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & - !> DLAMSWLQ: overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of blocked - !> elementary reflectors computed by short wide LQ - !> factorization (DLASWLQ) + !! DLAMSWLQ: overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of blocked + !! elementary reflectors computed by short wide LQ + !! factorization (DLASWLQ) lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31116,13 +31116,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & - !> DLAMTSQR: overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product - !> of blocked elementary reflectors computed by tall skinny - !> QR factorization (DLATSQR) + !! DLAMTSQR: overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product + !! of blocked elementary reflectors computed by tall skinny + !! QR factorization (DLATSQR) lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31278,21 +31278,21 @@ module stdlib_linalg_lapack_q pure integer(ilp) function stdlib_qlaneg( n, d, lld, sigma, pivmin, r ) - !> DLANEG: 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.) + !! DLANEG: 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.) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31383,9 +31383,9 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qlangb( norm, n, kl, ku, ab, ldab,work ) - !> DLANGB: 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. + !! DLANGB: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31458,9 +31458,9 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qlange( norm, m, n, a, lda, work ) - !> DLANGE: 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 matrix A. + !! DLANGE: 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 matrix A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31530,9 +31530,9 @@ module stdlib_linalg_lapack_q pure real(qp) function stdlib_qlangt( norm, n, dl, d, du ) - !> DLANGT: 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 tridiagonal matrix A. + !! DLANGT: 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 tridiagonal matrix A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31606,9 +31606,9 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qlanhs( norm, n, a, lda, work ) - !> DLANHS: 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. + !! DLANHS: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31678,9 +31678,9 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qlansb( norm, uplo, n, k, ab, ldab,work ) - !> DLANSB: 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. + !! DLANSB: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31783,9 +31783,9 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qlansf( norm, transr, uplo, n, a, work ) - !> DLANSF: 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. + !! DLANSF: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32487,9 +32487,9 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qlansp( norm, uplo, n, ap, work ) - !> DLANSP: 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, supplied in packed form. + !! DLANSP: 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, supplied in packed form. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32611,9 +32611,9 @@ module stdlib_linalg_lapack_q pure real(qp) function stdlib_qlanst( norm, n, d, e ) - !> DLANST: 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. + !! DLANST: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32673,9 +32673,9 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qlansy( norm, uplo, n, a, lda, work ) - !> DLANSY: 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. + !! DLANSY: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32769,9 +32769,9 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qlantb( norm, uplo, diag, n, k, ab,ldab, work ) - !> DLANTB: 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. + !! DLANTB: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32962,9 +32962,9 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qlantp( norm, uplo, diag, n, ap, work ) - !> DLANTP: 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. + !! DLANTP: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33168,9 +33168,9 @@ module stdlib_linalg_lapack_q real(qp) function stdlib_qlantr( norm, uplo, diag, m, n, a, lda,work ) - !> DLANTR: 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. + !! DLANTR: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33354,14 +33354,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlanv2( a, b, c, d, rt1r, rt1i, rt2r, rt2i, cs, sn ) - !> DLANV2: computes the Schur factorization of a real 2-by-2 nonsymmetric - !> matrix in standard form: - !> [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ] - !> [ C D ] [ SN CS ] [ CC DD ] [-SN CS ] - !> where either - !> 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or - !> 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex - !> conjugate eigenvalues. + !! DLANV2: computes the Schur factorization of a real 2-by-2 nonsymmetric + !! matrix in standard form: + !! [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ] + !! [ C D ] [ SN CS ] [ CC DD ] [-SN CS ] + !! where either + !! 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or + !! 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex + !! conjugate eigenvalues. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33500,39 +33500,39 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaorhr_col_getrfnp( m, n, a, lda, d, info ) - !> DLAORHR_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 DLAORHR_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. + !! DLAORHR_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 DLAORHR_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33594,54 +33594,54 @@ module stdlib_linalg_lapack_q pure recursive subroutine stdlib_qlaorhr_col_getrfnp2( m, n, a, lda, d, info ) - !> DLAORHR_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]. - !> DLAORHR_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, DLAORHR_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. + !! DLAORHR_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]. + !! DLAORHR_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, DLAORHR_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33724,12 +33724,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlapll( n, x, incx, y, incy, ssmin ) - !> 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. + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33764,12 +33764,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlapmr( forwrd, m, n, x, ldx, k ) - !> DLAPMR: 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. + !! DLAPMR: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33832,12 +33832,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlapmt( forwrd, m, n, x, ldx, k ) - !> DLAPMT: 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. + !! DLAPMT: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33900,8 +33900,8 @@ module stdlib_linalg_lapack_q pure real(qp) function stdlib_qlapy2( x, y ) - !> DLAPY2: returns sqrt(x**2+y**2), taking care not to cause unnecessary - !> overflow and unnecessary underflow. + !! DLAPY2: returns sqrt(x**2+y**2), taking care not to cause unnecessary + !! overflow and unnecessary underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33937,8 +33937,8 @@ module stdlib_linalg_lapack_q pure real(qp) function stdlib_qlapy3( x, y, z ) - !> DLAPY3: returns sqrt(x**2+y**2+z**2), taking care not to cause - !> unnecessary overflow and unnecessary underflow. + !! DLAPY3: returns sqrt(x**2+y**2+z**2), taking care not to cause + !! unnecessary overflow and unnecessary underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33969,9 +33969,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) - !> DLAQGB: 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. + !! DLAQGB: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34039,8 +34039,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed ) - !> DLAQGE: equilibrates a general M by N matrix A using the row and - !> column scaling factors in the vectors R and C. + !! DLAQGE: equilibrates a general M by N matrix A using the row and + !! column scaling factors in the vectors R and C. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34105,9 +34105,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaqp2( m, n, offset, a, lda, jpvt, tau, vn1, vn2,work ) - !> DLAQP2: computes a QR factorization with column pivoting of - !> the block A(OFFSET+1:M,1:N). - !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. + !! DLAQP2: computes a QR factorization with column pivoting of + !! the block A(OFFSET+1:M,1:N). + !! The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34182,14 +34182,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & - !> DLAQPS: computes a step of QR factorization with column pivoting - !> of a real 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. + !! DLAQPS: computes a step of QR factorization with column pivoting + !! of a real 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. ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34316,14 +34316,14 @@ module stdlib_linalg_lapack_q subroutine stdlib_qlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& - !> DLAQR0: computes the eigenvalues of a Hessenberg matrix H - !> and, optionally, the matrices T and Z from the Schur decomposition - !> H = Z T Z**T, where T is an upper quasi-triangular matrix (the - !> Schur form), and Z is the orthogonal matrix of Schur vectors. - !> Optionally Z may be postmultiplied into an input orthogonal - !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. + !! DLAQR0: computes the eigenvalues of a Hessenberg matrix H + !! and, optionally, the matrices T and Z from the Schur decomposition + !! H = Z T Z**T, where T is an upper quasi-triangular matrix (the + !! Schur form), and Z is the orthogonal matrix of Schur vectors. + !! Optionally Z may be postmultiplied into an input orthogonal + !! 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34686,16 +34686,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaqr1( n, h, ldh, sr1, si1, sr2, si2, v ) - !> Given a 2-by-2 or 3-by-3 matrix H, DLAQR1: sets v to a - !> scalar multiple of the first column of the product - !> (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I) - !> scaling to avoid overflows and most underflows. It - !> is assumed that either - !> 1) sr1 = sr2 and si1 = -si2 - !> or - !> 2) si1 = si2 = 0. - !> This is useful for starting double implicit shift bulges - !> in the QR algorithm. + !! Given a 2-by-2 or 3-by-3 matrix H, DLAQR1: sets v to a + !! scalar multiple of the first column of the product + !! (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I) + !! scaling to avoid overflows and most underflows. It + !! is assumed that either + !! 1) sr1 = sr2 and si1 = -si2 + !! or + !! 2) si1 = si2 = 0. + !! This is useful for starting double implicit shift bulges + !! in the QR algorithm. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34746,17 +34746,17 @@ module stdlib_linalg_lapack_q subroutine stdlib_qlaqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& - !> DLAQR2: is identical to DLAQR3 except that it avoids - !> recursion by calling DLAHQR instead of DLAQR4. - !> Aggressive early deflation: - !> This subroutine accepts as input an upper Hessenberg matrix - !> H and performs an orthogonal similarity transformation - !> designed to detect and deflate fully converged eigenvalues from - !> a trailing principal submatrix. On output H has been over- - !> written by a new Hessenberg matrix that is a perturbation of - !> an orthogonal similarity transformation of H. It is to be - !> hoped that the final version of H has many zero subdiagonal - !> entries. + !! DLAQR2: is identical to DLAQR3 except that it avoids + !! recursion by calling DLAHQR instead of DLAQR4. + !! Aggressive early deflation: + !! This subroutine accepts as input an upper Hessenberg matrix + !! H and performs an orthogonal similarity transformation + !! designed to detect and deflate fully converged eigenvalues from + !! a trailing principal submatrix. On output H has been over- + !! written by a new Hessenberg matrix that is a perturbation of + !! an orthogonal similarity transformation of H. It is to be + !! hoped that the final version of H has many zero subdiagonal + !! entries. sr, si, v, ldv, nh, t,ldt, nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35049,15 +35049,15 @@ module stdlib_linalg_lapack_q subroutine stdlib_qlaqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& - !> Aggressive early deflation: - !> DLAQR3: accepts as input an upper Hessenberg matrix - !> H and performs an orthogonal similarity transformation - !> designed to detect and deflate fully converged eigenvalues from - !> a trailing principal submatrix. On output H has been over- - !> written by a new Hessenberg matrix that is a perturbation of - !> an orthogonal similarity transformation of H. It is to be - !> hoped that the final version of H has many zero subdiagonal - !> entries. + !! Aggressive early deflation: + !! DLAQR3: accepts as input an upper Hessenberg matrix + !! H and performs an orthogonal similarity transformation + !! designed to detect and deflate fully converged eigenvalues from + !! a trailing principal submatrix. On output H has been over- + !! written by a new Hessenberg matrix that is a perturbation of + !! an orthogonal similarity transformation of H. It is to be + !! hoped that the final version of H has many zero subdiagonal + !! entries. sr, si, v, ldv, nh, t,ldt, nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35360,20 +35360,20 @@ module stdlib_linalg_lapack_q subroutine stdlib_qlaqr4( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& - !> DLAQR4: implements one level of recursion for DLAQR0. - !> It is a complete implementation of the small bulge multi-shift - !> QR algorithm. It may be called by DLAQR0 and, for large enough - !> deflation window size, it may be called by DLAQR3. This - !> subroutine is identical to DLAQR0 except that it calls DLAQR2 - !> instead of DLAQR3. - !> DLAQR4 computes the eigenvalues of a Hessenberg matrix H - !> and, optionally, the matrices T and Z from the Schur decomposition - !> H = Z T Z**T, where T is an upper quasi-triangular matrix (the - !> Schur form), and Z is the orthogonal matrix of Schur vectors. - !> Optionally Z may be postmultiplied into an input orthogonal - !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. + !! DLAQR4: implements one level of recursion for DLAQR0. + !! It is a complete implementation of the small bulge multi-shift + !! QR algorithm. It may be called by DLAQR0 and, for large enough + !! deflation window size, it may be called by DLAQR3. This + !! subroutine is identical to DLAQR0 except that it calls DLAQR2 + !! instead of DLAQR3. + !! DLAQR4 computes the eigenvalues of a Hessenberg matrix H + !! and, optionally, the matrices T and Z from the Schur decomposition + !! H = Z T Z**T, where T is an upper quasi-triangular matrix (the + !! Schur form), and Z is the orthogonal matrix of Schur vectors. + !! Optionally Z may be postmultiplied into an input orthogonal + !! 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35731,8 +35731,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts,sr, si, h, ldh, & - !> DLAQR5:, called by DLAQR0, performs a - !> single small-bulge multi-shift QR sweep. + !! DLAQR5:, called by DLAQR0, performs a + !! single small-bulge multi-shift QR sweep. iloz, ihiz, z, ldz, v, ldv, u,ldu, nv, wv, ldwv, nh, wh, ldwh ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36138,8 +36138,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) - !> DLAQSB: equilibrates a symmetric band matrix A using the scaling - !> factors in the vector S. + !! DLAQSB: equilibrates a symmetric band matrix A using the scaling + !! factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36198,8 +36198,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaqsp( uplo, n, ap, s, scond, amax, equed ) - !> DLAQSP: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. + !! DLAQSP: equilibrates a symmetric matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36260,8 +36260,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaqsy( uplo, n, a, lda, s, scond, amax, equed ) - !> DLAQSY: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. + !! DLAQSY: equilibrates a symmetric matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36318,24 +36318,24 @@ module stdlib_linalg_lapack_q subroutine stdlib_qlaqtr( ltran, lreal, n, t, ldt, b, w, scale, x, work,info ) - !> DLAQTR: 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. + !! DLAQTR: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36764,54 +36764,54 @@ module stdlib_linalg_lapack_q recursive subroutine stdlib_qlaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alphar, & - !> DLAQZ0: computes the eigenvalues of a real 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 real matrix pair (A,B): - !> A = Q1*H*Z1**T, B = Q1*T*Z1**T, - !> as computed by DGGHRD. - !> If JOB='S', then the Hessenberg-triangular pair (H,T) is - !> also reduced to generalized Schur form, - !> H = Q*S*Z**T, T = Q*P*Z**T, - !> where Q and Z are orthogonal matrices, P is an upper triangular - !> matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2 - !> diagonal blocks. - !> The 1-by-1 blocks correspond to real eigenvalues of the matrix pair - !> (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of - !> eigenvalues. - !> Additionally, the 2-by-2 upper triangular diagonal blocks of P - !> corresponding to 2-by-2 blocks of S are reduced to positive diagonal - !> form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0, - !> P(j,j) > 0, and P(j+1,j+1) > 0. - !> Optionally, the orthogonal matrix Q from the generalized Schur - !> factorization may be postmultiplied into an input matrix Q1, and the - !> orthogonal matrix Z may be postmultiplied into an input matrix Z1. - !> If Q1 and Z1 are the orthogonal matrices from DGGHRD that reduced - !> the matrix pair (A,B) to generalized upper Hessenberg form, then the - !> output matrices Q1*Q and Z1*Z are the orthogonal factors from the - !> generalized Schur factorization of (A,B): - !> A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T. - !> 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. - !> Real 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" + !! DLAQZ0: computes the eigenvalues of a real 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 real matrix pair (A,B): + !! A = Q1*H*Z1**T, B = Q1*T*Z1**T, + !! as computed by DGGHRD. + !! If JOB='S', then the Hessenberg-triangular pair (H,T) is + !! also reduced to generalized Schur form, + !! H = Q*S*Z**T, T = Q*P*Z**T, + !! where Q and Z are orthogonal matrices, P is an upper triangular + !! matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2 + !! diagonal blocks. + !! The 1-by-1 blocks correspond to real eigenvalues of the matrix pair + !! (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of + !! eigenvalues. + !! Additionally, the 2-by-2 upper triangular diagonal blocks of P + !! corresponding to 2-by-2 blocks of S are reduced to positive diagonal + !! form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0, + !! P(j,j) > 0, and P(j+1,j+1) > 0. + !! Optionally, the orthogonal matrix Q from the generalized Schur + !! factorization may be postmultiplied into an input matrix Q1, and the + !! orthogonal matrix Z may be postmultiplied into an input matrix Z1. + !! If Q1 and Z1 are the orthogonal matrices from DGGHRD that reduced + !! the matrix pair (A,B) to generalized upper Hessenberg form, then the + !! output matrices Q1*Q and Z1*Z are the orthogonal factors from the + !! generalized Schur factorization of (A,B): + !! A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T. + !! 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. + !! Real 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" alphai, beta,q, ldq, z, ldz, work, lwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -37156,15 +37156,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaqz1( a, lda, b, ldb, sr1, sr2, si, beta1, beta2,v ) - !> Given a 3-by-3 matrix pencil (A,B), DLAQZ1: sets v to a - !> scalar multiple of the first column of the product - !> (*) K = (A - (beta2*sr2 - i*si)*B)*B^(-1)*(beta1*A - (sr2 + i*si2)*B)*B^(-1). - !> It is assumed that either - !> 1) sr1 = sr2 - !> or - !> 2) si = 0. - !> This is useful for starting double implicit shift bulges - !> in the QZ algorithm. + !! Given a 3-by-3 matrix pencil (A,B), DLAQZ1: sets v to a + !! scalar multiple of the first column of the product + !! (*) K = (A - (beta2*sr2 - i*si)*B)*B^(-1)*(beta1*A - (sr2 + i*si2)*B)*B^(-1). + !! It is assumed that either + !! 1) sr1 = sr2 + !! or + !! 2) si = 0. + !! This is useful for starting double implicit shift bulges + !! in the QZ algorithm. ! arguments integer(ilp), intent( in ) :: lda, ldb real(qp), intent( in ) :: a( lda, * ), b( ldb, * ), sr1,sr2, si, beta1, beta2 @@ -37211,7 +37211,7 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaqz2( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, qstart, & - !> DLAQZ2: chases a 2x2 shift bulge in a matrix pencil down a single position + !! DLAQZ2: chases a 2x2 shift bulge in a matrix pencil down a single position q, ldq, nz, zstart, z, ldz ) ! arguments logical(lk), intent( in ) :: ilq, ilz @@ -37322,7 +37322,7 @@ module stdlib_linalg_lapack_q recursive subroutine stdlib_qlaqz3( ilschur, ilq, ilz, n, ilo, ihi, nw,a, lda, b, ldb, q, & - !> DLAQZ3: performs AED + !! DLAQZ3: performs AED ldq, z, ldz, ns,nd, alphar, alphai, beta, qc, ldqc,zc, ldzc, work, lwork, rec, info ) ! arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -37594,7 +37594,7 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaqz4( ilschur, ilq, ilz, n, ilo, ihi, nshifts,nblock_qesired, sr, & - !> DLAQZ4: Executes a single multishift QZ sweep + !! DLAQZ4: Executes a single multishift QZ sweep si, ss, a, lda, b, ldb, q,ldq, z, ldz, qc, ldqc, zc, ldzc, work, lwork,info ) ! function arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -37851,21 +37851,21 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & - !> DLAR1V: 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. + !! DLAR1V: 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. negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38073,11 +38073,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlar2v( n, x, y, z, incx, c, s, incc ) - !> DLAR2V: applies a vector of real plane rotations from both sides to - !> a sequence of 2-by-2 real symmetric matrices, defined by the elements - !> of the vectors x, y and z. For i = 1,2,...,n - !> ( x(i) z(i) ) := ( c(i) s(i) ) ( x(i) z(i) ) ( c(i) -s(i) ) - !> ( z(i) y(i) ) ( -s(i) c(i) ) ( z(i) y(i) ) ( s(i) c(i) ) + !! DLAR2V: applies a vector of real plane rotations from both sides to + !! a sequence of 2-by-2 real symmetric matrices, defined by the elements + !! of the vectors x, y and z. For i = 1,2,...,n + !! ( x(i) z(i) ) := ( c(i) s(i) ) ( x(i) z(i) ) ( c(i) -s(i) ) + !! ( z(i) y(i) ) ( -s(i) c(i) ) ( z(i) y(i) ) ( s(i) c(i) ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38116,11 +38116,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarf( side, m, n, v, incv, tau, c, ldc, work ) - !> DLARF: applies a real elementary reflector H to a real m by n matrix - !> C, from either the left or the right. H is represented in the form - !> H = I - tau * v * v**T - !> where tau is a real scalar and v is a real vector. - !> If tau = 0, then H is taken to be the unit matrix. + !! DLARF: applies a real elementary reflector H to a real m by n matrix + !! C, from either the left or the right. H is represented in the form + !! H = I - tau * v * v**T + !! where tau is a real scalar and v is a real vector. + !! If tau = 0, then H is taken to be the unit matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38193,8 +38193,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, ldc, & - !> DLARFB: applies a real block reflector H or its transpose H**T to a - !> real m by n matrix C, from either the left or the right. + !! DLARFB: applies a real block reflector H or its transpose H**T to a + !! real m by n matrix C, from either the left or the right. work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38515,13 +38515,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) - !> DLARFB_GETT: applies a real Householder block reflector H from the - !> left to a real (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. + !! DLARFB_GETT: applies a real Householder block reflector H from the + !! left to a real (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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38652,19 +38652,19 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarfg( n, alpha, x, incx, tau ) - !> DLARFG: generates a real elementary reflector H of order n, such - !> that - !> H * ( alpha ) = ( beta ), H**T * H = I. - !> ( x ) ( 0 ) - !> where alpha and beta are scalars, and x is an (n-1)-element real - !> vector. H is represented in the form - !> H = I - tau * ( 1 ) * ( 1 v**T ) , - !> ( v ) - !> where tau is a real scalar and v is a real (n-1)-element - !> vector. - !> If the elements of x are all zero, then tau = 0 and H is taken to be - !> the unit matrix. - !> Otherwise 1 <= tau <= 2. + !! DLARFG: generates a real elementary reflector H of order n, such + !! that + !! H * ( alpha ) = ( beta ), H**T * H = I. + !! ( x ) ( 0 ) + !! where alpha and beta are scalars, and x is an (n-1)-element real + !! vector. H is represented in the form + !! H = I - tau * ( 1 ) * ( 1 v**T ) , + !! ( v ) + !! where tau is a real scalar and v is a real (n-1)-element + !! vector. + !! If the elements of x are all zero, then tau = 0 and H is taken to be + !! the unit matrix. + !! Otherwise 1 <= tau <= 2. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38721,18 +38721,18 @@ module stdlib_linalg_lapack_q subroutine stdlib_qlarfgp( n, alpha, x, incx, tau ) - !> DLARFGP: generates a real elementary reflector H of order n, such - !> that - !> H * ( alpha ) = ( beta ), H**T * H = I. - !> ( x ) ( 0 ) - !> where alpha and beta are scalars, beta is non-negative, and x is - !> an (n-1)-element real vector. H is represented in the form - !> H = I - tau * ( 1 ) * ( 1 v**T ) , - !> ( v ) - !> where tau is a real scalar and v is a real (n-1)-element - !> vector. - !> If the elements of x are all zero, then tau = 0 and H is taken to be - !> the unit matrix. + !! DLARFGP: generates a real elementary reflector H of order n, such + !! that + !! H * ( alpha ) = ( beta ), H**T * H = I. + !! ( x ) ( 0 ) + !! where alpha and beta are scalars, beta is non-negative, and x is + !! an (n-1)-element real vector. H is represented in the form + !! H = I - tau * ( 1 ) * ( 1 v**T ) , + !! ( v ) + !! where tau is a real scalar and v is a real (n-1)-element + !! vector. + !! If the elements of x are all zero, then tau = 0 and H is taken to be + !! the unit matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38829,16 +38829,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarft( direct, storev, n, k, v, ldv, tau, t, ldt ) - !> DLARFT: forms the triangular factor T of a real 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**T - !> 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**T * T * V + !! DLARFT: forms the triangular factor T of a real 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**T + !! 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**T * T * V ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38956,13 +38956,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarfx( side, m, n, v, tau, c, ldc, work ) - !> DLARFX: applies a real elementary reflector H to a real m by n - !> matrix C, from either the left or the right. H is represented in the - !> form - !> H = I - tau * v * v**T - !> where tau is a real scalar and v is a real vector. - !> If tau = 0, then H is taken to be the unit matrix - !> This version uses inline code if H has order < 11. + !! DLARFX: applies a real elementary reflector H to a real m by n + !! matrix C, from either the left or the right. H is represented in the + !! form + !! H = I - tau * v * v**T + !! where tau is a real scalar and v is a real vector. + !! If tau = 0, then H is taken to be the unit matrix + !! This version uses inline code if H has order < 11. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39459,12 +39459,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarfy( uplo, n, v, incv, tau, c, ldc, work ) - !> DLARFY: applies an elementary reflector, or Householder matrix, H, - !> to an n x n symmetric 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. + !! DLARFY: applies an elementary reflector, or Householder matrix, H, + !! to an n x n symmetric 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. ! -- lapack test routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39493,10 +39493,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlargv( n, x, incx, y, incy, c, incc ) - !> DLARGV: generates a vector of real plane rotations, determined by - !> elements of the real vectors x and y. For i = 1,2,...,n - !> ( c(i) s(i) ) ( x(i) ) = ( a(i) ) - !> ( -s(i) c(i) ) ( y(i) ) = ( 0 ) + !! DLARGV: generates a vector of real plane rotations, determined by + !! elements of the real vectors x and y. For i = 1,2,...,n + !! ( c(i) s(i) ) ( x(i) ) = ( a(i) ) + !! ( -s(i) c(i) ) ( y(i) ) = ( 0 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39547,8 +39547,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarnv( idist, iseed, n, x ) - !> DLARNV: returns a vector of n random real numbers from a uniform or - !> normal distribution. + !! DLARNV: returns a vector of n random real numbers from a uniform or + !! normal distribution. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39603,8 +39603,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarra( n, d, e, e2, spltol, tnrm,nsplit, isplit, info ) - !> Compute the splitting points with threshold SPLTOL. - !> DLARRA: sets any "small" off-diagonal elements to zero. + !! Compute the splitting points with threshold SPLTOL. + !! DLARRA: sets any "small" off-diagonal elements to zero. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39661,14 +39661,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarrb( n, d, lld, ifirst, ilast, rtol1,rtol2, offset, w, wgap, werr, & - !> Given the relatively robust representation(RRR) L D L^T, DLARRB: - !> 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. + !! Given the relatively robust representation(RRR) L D L^T, DLARRB: + !! 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. work, iwork,pivmin, spdiam, twist, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39834,9 +39834,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarrc( jobt, n, vl, vu, d, e, pivmin,eigcnt, lcnt, rcnt, info ) - !> 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'. + !! 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'. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39927,18 +39927,18 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarrd( range, order, n, vl, vu, il, iu, gers,reltol, d, e, e2, & - !> DLARRD: 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. + !! DLARRD: 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. pivmin, nsplit, isplit,m, w, werr, wl, wu, iblock, indexw,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40398,19 +40398,19 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarre( range, n, vl, vu, il, iu, d, e, e2,rtol1, rtol2, spltol, & - !> To find the desired eigenvalues of a given real symmetric - !> tridiagonal matrix T, DLARRE: 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, DLARRE also outputs the n - !> Gerschgorin intervals for the matrices L_i D_i L_i^T. + !! To find the desired eigenvalues of a given real symmetric + !! tridiagonal matrix T, DLARRE: 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, DLARRE also outputs the n + !! Gerschgorin intervals for the matrices L_i D_i L_i^T. nsplit, isplit, m,w, werr, wgap, iblock, indexw, gers, pivmin,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40923,11 +40923,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarrf( n, d, l, ld, clstrt, clend,w, wgap, werr,spdiam, clgapl, & - !> 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 ), DLARRF: 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. + !! 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 ), DLARRF: 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. clgapr, pivmin, sigma,dplus, lplus, work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41182,13 +41182,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarrj( n, d, e2, ifirst, ilast,rtol, offset, w, werr, work, iwork,& - !> Given the initial eigenvalue approximations of T, DLARRJ: - !> 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. + !! Given the initial eigenvalue approximations of T, DLARRJ: + !! 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. pivmin, spdiam, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41360,15 +41360,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarrk( n, iw, gl, gu,d, e2, pivmin, reltol, w, werr, info) - !> DLARRK: 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. + !! DLARRK: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41440,9 +41440,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarrr( n, d, e, info ) - !> Perform tests to decide whether the symmetric tridiagonal matrix T - !> warrants expensive computations which guarantee high relative accuracy - !> in the eigenvalues. + !! Perform tests to decide whether the symmetric tridiagonal matrix T + !! warrants expensive computations which guarantee high relative accuracy + !! in the eigenvalues. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41522,9 +41522,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, & - !> DLARRV: 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 DLARRE. + !! DLARRV: 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 DLARRE. rtol2, w, werr, wgap,iblock, indexw, gers, z, ldz, isuppz,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42153,30 +42153,28 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlartg( f, g, c, s, r ) - !> ! - !> - !> DLARTG: generates a plane rotation so that - !> [ C S ] . [ F ] = [ R ] - !> [ -S C ] [ G ] [ 0 ] - !> where C**2 + S**2 = 1. - !> The mathematical formulas used for C and S are - !> R = sign(F) * sqrt(F**2 + G**2) - !> C = F / R - !> S = G / R - !> Hence C >= 0. 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 version is discontinuous in R at F = 0 but it returns the same - !> C and S as ZLARTG for complex inputs (F,0) and (G,0). - !> This is a more accurate version of the BLAS1 routine DROTG, - !> with the following other differences: - !> F and G are unchanged on return. - !> If G=0, then C=1 and S=0. - !> If F=0 and (G .ne. 0), then C=0 and S=sign(1,G) without doing any - !> floating point operations (saves work in DBDSQR when - !> there are zeros on the diagonal). - !> If F exceeds G in magnitude, C will be positive. - !> Below, wp=>dp stands for quad precision from LA_CONSTANTS module. + !! DLARTG: generates a plane rotation so that + !! [ C S ] . [ F ] = [ R ] + !! [ -S C ] [ G ] [ 0 ] + !! where C**2 + S**2 = 1. + !! The mathematical formulas used for C and S are + !! R = sign(F) * sqrt(F**2 + G**2) + !! C = F / R + !! S = G / R + !! Hence C >= 0. 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 version is discontinuous in R at F = 0 but it returns the same + !! C and S as ZLARTG for complex inputs (F,0) and (G,0). + !! This is a more accurate version of the BLAS1 routine DROTG, + !! with the following other differences: + !! F and G are unchanged on return. + !! If G=0, then C=1 and S=0. + !! If F=0 and (G .ne. 0), then C=0 and S=sign(1,G) without doing any + !! floating point operations (saves work in DBDSQR when + !! there are zeros on the diagonal). + !! If F exceeds G in magnitude, C will be positive. + !! Below, wp=>dp stands for quad precision from LA_CONSTANTS module. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42222,15 +42220,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlartgp( f, g, cs, sn, r ) - !> DLARTGP: 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. + !! DLARTGP: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42316,14 +42314,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlartgs( x, y, sigma, cs, sn ) - !> DLARTGS: 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. + !! DLARTGS: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42372,10 +42370,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlartv( n, x, incx, y, incy, c, s, incc ) - !> DLARTV: applies a vector of real plane rotations to elements of the - !> real vectors x and y. For i = 1,2,...,n - !> ( x(i) ) := ( c(i) s(i) ) ( x(i) ) - !> ( y(i) ) ( -s(i) c(i) ) ( y(i) ) + !! DLARTV: applies a vector of real plane rotations to elements of the + !! real vectors x and y. For i = 1,2,...,n + !! ( x(i) ) := ( c(i) s(i) ) ( x(i) ) + !! ( y(i) ) ( -s(i) c(i) ) ( y(i) ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42406,9 +42404,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaruv( iseed, n, x ) - !> DLARUV: 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. + !! DLARUV: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42608,13 +42606,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarz( side, m, n, l, v, incv, tau, c, ldc, work ) - !> DLARZ: applies a real elementary reflector H to a real M-by-N - !> matrix C, from either the left or the right. H is represented in the - !> form - !> H = I - tau * v * v**T - !> where tau is a real scalar and v is a real vector. - !> If tau = 0, then H is taken to be the unit matrix. - !> H is a product of k elementary reflectors as returned by DTZRZF. + !! DLARZ: applies a real elementary reflector H to a real M-by-N + !! matrix C, from either the left or the right. H is represented in the + !! form + !! H = I - tau * v * v**T + !! where tau is a real scalar and v is a real vector. + !! If tau = 0, then H is taken to be the unit matrix. + !! H is a product of k elementary reflectors as returned by DTZRZF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42663,9 +42661,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & - !> DLARZB: applies a real block reflector H or its transpose H**T to - !> a real distributed M-by-N C from the left or the right. - !> Currently, only STOREV = 'R' and DIRECT = 'B' are supported. + !! DLARZB: applies a real block reflector H or its transpose H**T to + !! a real distributed M-by-N C from the left or the right. + !! Currently, only STOREV = 'R' and DIRECT = 'B' are supported. ldc, work, ldwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42752,18 +42750,18 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) - !> DLARZT: forms the triangular factor T of a real 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**T - !> 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**T * T * V - !> Currently, only STOREV = 'R' and DIRECT = 'B' are supported. + !! DLARZT: forms the triangular factor T of a real 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**T + !! 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**T * T * V + !! Currently, only STOREV = 'R' and DIRECT = 'B' are supported. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42814,11 +42812,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlas2( f, g, h, ssmin, ssmax ) - !> DLAS2: computes the singular values of the 2-by-2 matrix - !> [ F G ] - !> [ 0 H ]. - !> On return, SSMIN is the smaller singular value and SSMAX is the - !> larger singular value. + !! DLAS2: computes the singular values of the 2-by-2 matrix + !! [ F G ] + !! [ 0 H ]. + !! On return, SSMIN is the smaller singular value and SSMAX is the + !! larger singular value. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42878,11 +42876,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) - !> DLASCL: multiplies the M by N real 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. + !! DLASCL: multiplies the M by N real 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43048,13 +43046,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasd0( n, sqre, d, e, u, ldu, vt, ldvt, smlsiz, iwork,work, info ) - !> Using a divide and conquer approach, DLASD0: 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. + !! Using a divide and conquer approach, DLASD0: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43187,35 +43185,35 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasd1( nl, nr, sqre, d, alpha, beta, u, ldu, vt, ldvt,idxq, iwork, & - !> DLASD1: computes the SVD of an upper bidiagonal N-by-M matrix B, - !> where N = NL + NR + 1 and M = N + SQRE. DLASD1 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. - !> DLASD1 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. + !! DLASD1: computes the SVD of an upper bidiagonal N-by-M matrix B, + !! where N = NL + NR + 1 and M = N + SQRE. DLASD1 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. + !! DLASD1 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. work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43302,13 +43300,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasd2( nl, nr, sqre, k, d, z, alpha, beta, u, ldu, vt,ldvt, dsigma, & - !> DLASD2: 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. - !> DLASD2 is called from DLASD1. + !! DLASD2: 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. + !! DLASD2 is called from DLASD1. u2, ldu2, vt2, ldvt2, idxp, idx,idxc, idxq, coltyp, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43587,17 +43585,17 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasd3( nl, nr, sqre, k, d, q, ldq, dsigma, u, ldu, u2,ldu2, vt, ldvt,& - !> DLASD3: finds all the square roots of the roots of the secular - !> equation, as defined by the values in D and Z. It makes the - !> appropriate calls to DLASD4 and then updates the singular - !> vectors by matrix multiplication. - !> 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. - !> DLASD3 is called from DLASD1. + !! DLASD3: finds all the square roots of the roots of the secular + !! equation, as defined by the values in D and Z. It makes the + !! appropriate calls to DLASD4 and then updates the singular + !! vectors by matrix multiplication. + !! 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. + !! DLASD3 is called from DLASD1. vt2, ldvt2, idxc, ctot, z,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43789,17 +43787,17 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasd4( n, i, d, z, delta, rho, sigma, work, info ) - !> 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. + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44517,14 +44515,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasd5( i, d, z, delta, rho, dsigma, work ) - !> 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. + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44612,41 +44610,41 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasd6( icompq, nl, nr, sqre, d, vf, vl, alpha, beta,idxq, perm, & - !> DLASD6: 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. - !> DLASD6 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 DLASD6. 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. - !> DLASD6 is called from DLASDA. + !! DLASD6: 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. + !! DLASD6 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 DLASD6. 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. + !! DLASD6 is called from DLASDA. givptr, givcol, ldgcol, givnum,ldgnum, poles, difl, difr, z, k, c, s, work,iwork, info ) ! -- lapack auxiliary routine -- @@ -44740,13 +44738,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasd7( icompq, nl, nr, sqre, k, d, z, zw, vf, vfw, vl,vlw, alpha, & - !> DLASD7: 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. - !> DLASD7 is called from DLASD6. + !! DLASD7: 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. + !! DLASD7 is called from DLASD6. beta, dsigma, idx, idxp, idxq,perm, givptr, givcol, ldgcol, givnum, ldgnum,c, s, info ) ! -- lapack auxiliary routine -- @@ -44979,13 +44977,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasd8( icompq, k, d, z, vf, vl, difl, difr, lddifr,dsigma, work, & - !> DLASD8: 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. - !> DLASD8 is called from DLASD6. + !! DLASD8: 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. + !! DLASD8 is called from DLASD6. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45115,14 +45113,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasda( icompq, smlsiz, n, sqre, d, e, u, ldu, vt, k,difl, difr, z, & - !> Using a divide and conquer approach, DLASDA: 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. + !! Using a divide and conquer approach, DLASDA: 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. poles, givptr, givcol, ldgcol,perm, givnum, c, s, work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45317,18 +45315,18 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasdq( uplo, sqre, n, ncvt, nru, ncc, d, e, vt, ldvt,u, ldu, c, ldc, & - !> DLASDQ: 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. + !! DLASDQ: 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. work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45482,8 +45480,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasdt( n, lvl, nd, inode, ndiml, ndimr, msub ) - !> DLASDT: creates a tree of subproblems for bidiagonal divide and - !> conquer. + !! DLASDT: creates a tree of subproblems for bidiagonal divide and + !! conquer. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45533,8 +45531,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaset( uplo, m, n, alpha, beta, a, lda ) - !> DLASET: initializes an m-by-n matrix A to BETA on the diagonal and - !> ALPHA on the offdiagonals. + !! DLASET: initializes an m-by-n matrix A to BETA on the diagonal and + !! ALPHA on the offdiagonals. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45583,16 +45581,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasq1( n, d, e, work, info ) - !> DLASQ1: 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. + !! DLASQ1: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45675,19 +45673,19 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasq2( n, z, info ) - !> DLASQ2: computes all the eigenvalues of the symmetric positive - !> definite tridiagonal matrix associated with the qd array Z to high - !> relative accuracy are computed to high relative accuracy, in the - !> absence of denormalization, underflow and overflow. - !> To see the relation of Z to the tridiagonal matrix, let L be a - !> unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and - !> let U be an upper bidiagonal matrix with 1's above and diagonal - !> Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the - !> symmetric tridiagonal to which it is similar. - !> Note : DLASQ2 defines a logical variable, IEEE, which is true - !> on machines which follow ieee-754 floating-point standard in their - !> handling of infinities and NaNs, and false otherwise. This variable - !> is passed to DLASQ3. + !! DLASQ2: computes all the eigenvalues of the symmetric positive + !! definite tridiagonal matrix associated with the qd array Z to high + !! relative accuracy are computed to high relative accuracy, in the + !! absence of denormalization, underflow and overflow. + !! To see the relation of Z to the tridiagonal matrix, let L be a + !! unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and + !! let U be an upper bidiagonal matrix with 1's above and diagonal + !! Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the + !! symmetric tridiagonal to which it is similar. + !! Note : DLASQ2 defines a logical variable, IEEE, which is true + !! on machines which follow ieee-754 floating-point standard in their + !! handling of infinities and NaNs, and false otherwise. This variable + !! is passed to DLASQ3. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46063,9 +46061,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasq3( i0, n0, z, pp, dmin, sigma, desig, qmax, nfail,iter, ndiv, & - !> DLASQ3: checks for deflation, computes a shift (TAU) and calls dqds. - !> In case of failure it changes shifts, and tries again until output - !> is positive. + !! DLASQ3: checks for deflation, computes a shift (TAU) and calls dqds. + !! In case of failure it changes shifts, and tries again until output + !! is positive. ieee, ttype, dmin1, dmin2, dn, dn1,dn2, g, tau ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46233,8 +46231,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasq4( i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn,dn1, dn2, tau, & - !> DLASQ4: computes an approximation TAU to the smallest eigenvalue - !> using values of d from the previous transform. + !! DLASQ4: computes an approximation TAU to the smallest eigenvalue + !! using values of d from the previous transform. ttype, g ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46441,8 +46439,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasq5( i0, n0, z, pp, tau, sigma, dmin, dmin1, dmin2,dn, dnm1, dnm2, & - !> DLASQ5: computes one dqds transform in ping-pong form, one - !> version for IEEE machines another for non IEEE machines. + !! DLASQ5: computes one dqds transform in ping-pong form, one + !! version for IEEE machines another for non IEEE machines. ieee, eps ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46669,8 +46667,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasq6( i0, n0, z, pp, dmin, dmin1, dmin2, dn,dnm1, dnm2 ) - !> DLASQ6: computes one dqd (shift equal to zero) transform in - !> ping-pong form, with protection against underflow and overflow. + !! DLASQ6: computes one dqd (shift equal to zero) transform in + !! ping-pong form, with protection against underflow and overflow. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46779,57 +46777,57 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasr( side, pivot, direct, m, n, c, s, a, lda ) - !> DLASR: applies a sequence of plane rotations to a real 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. + !! DLASR: applies a sequence of plane rotations to a real 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47038,10 +47036,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasrt( id, n, d, info ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47212,26 +47210,24 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlassq( n, x, incx, scl, sumsq ) - !> ! - !> - !> DLASSQ: 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. + !! DLASSQ: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47329,15 +47325,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasv2( f, g, h, ssmin, ssmax, snr, csr, snl, csl ) - !> DLASV2: computes the singular value decomposition of a 2-by-2 - !> triangular matrix - !> [ F G ] - !> [ 0 H ]. - !> On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the - !> smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and - !> right singular vectors for abs(SSMAX), giving the decomposition - !> [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ] - !> [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ]. + !! DLASV2: computes the singular value decomposition of a 2-by-2 + !! triangular matrix + !! [ F G ] + !! [ 0 H ]. + !! On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the + !! smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and + !! right singular vectors for abs(SSMAX), giving the decomposition + !! [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ] + !! [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ]. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47474,16 +47470,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) - !> DLASWLQ: computes a blocked Tall-Skinny LQ factorization of - !> a real 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. + !! DLASWLQ: computes a blocked Tall-Skinny LQ factorization of + !! a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -47558,8 +47554,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlaswp( n, a, lda, k1, k2, ipiv, incx ) - !> DLASWP: performs a series of row interchanges on the matrix A. - !> One row interchange is initiated for each of rows K1 through K2 of A. + !! DLASWP: performs a series of row interchanges on the matrix A. + !! One row interchange is initiated for each of rows K1 through K2 of A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47625,10 +47621,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasy2( ltranl, ltranr, isgn, n1, n2, tl, ldtl, tr,ldtr, b, ldb, & - !> DLASY2: solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in - !> op(TL)*X + ISGN*X*op(TR) = SCALE*B, - !> where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or - !> -1. op(T) = T or T**T, where T**T denotes the transpose of T. + !! DLASY2: solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in + !! op(TL)*X + ISGN*X*op(TR) = SCALE*B, + !! where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or + !! -1. op(T) = T or T**T, where T**T denotes the transpose of T. scale, x, ldx, xnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47885,18 +47881,18 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) - !> DLASYF: computes a partial factorization of a real 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. - !> DLASYF is an auxiliary routine called by DSYTRF. It uses blocked code - !> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or - !> A22 (if UPLO = 'L'). + !! DLASYF: computes a partial factorization of a real 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. + !! DLASYF is an auxiliary routine called by DSYTRF. It uses blocked code + !! (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or + !! A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48322,16 +48318,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) - !> DLATRF_AA factorizes a panel of a real 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. + !! DLATRF_AA factorizes a panel of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48556,18 +48552,18 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) - !> DLASYF_RK: computes a partial factorization of a real 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. - !> DLASYF_RK is an auxiliary routine called by DSYTRF_RK. It uses - !> blocked code (calling Level 3 BLAS) to update the submatrix - !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). + !! DLASYF_RK: computes a partial factorization of a real 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. + !! DLASYF_RK is an auxiliary routine called by DSYTRF_RK. It uses + !! blocked code (calling Level 3 BLAS) to update the submatrix + !! A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48997,18 +48993,18 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) - !> DLASYF_ROOK: computes a partial factorization of a real 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. - !> DLASYF_ROOK is an auxiliary routine called by DSYTRF_ROOK. It uses - !> blocked code (calling Level 3 BLAS) to update the submatrix - !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). + !! DLASYF_ROOK: computes a partial factorization of a real 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. + !! DLASYF_ROOK is an auxiliary routine called by DSYTRF_ROOK. It uses + !! blocked code (calling Level 3 BLAS) to update the submatrix + !! A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49458,12 +49454,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlat2s( uplo, n, a, lda, sa, ldsa, info ) - !> DLAT2S: converts a DOUBLE PRECISION triangular matrix, SA, to a SINGLE - !> PRECISION triangular matrix, A. - !> RMAX is the overflow for the SINGLE PRECISION arithmetic - !> DLAS2S checks that all the entries of A are between -RMAX and - !> RMAX. If not the conversion is aborted and a flag is raised. - !> This is an auxiliary routine so there is no argument checking. + !! DLAT2S: converts a DOUBLE PRECISION triangular matrix, SA, to a SINGLE + !! PRECISION triangular matrix, A. + !! RMAX is the overflow for the SINGLE PRECISION arithmetic + !! DLAS2S checks that all the entries of A are between -RMAX and + !! RMAX. If not the conversion is aborted and a flag is raised. + !! This is an auxiliary routine so there is no argument checking. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49509,16 +49505,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & - !> DLATBS: solves one of the triangular systems - !> A *x = s*b or A**T*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 DTBSV 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. + !! DLATBS: solves one of the triangular systems + !! A *x = s*b or A**T*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 DTBSV 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. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49929,14 +49925,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) - !> DLATDF: uses the LU factorization of the n-by-n matrix Z computed by - !> DGETC2 and computes a contribution to the reciprocal Dif-estimate - !> by solving Z * x = b for x, and choosing the r.h.s. b such that - !> the norm of x is as large as possible. On entry RHS = b holds the - !> contribution from earlier solved sub-systems, and on return RHS = x. - !> The factorization of Z returned by DGETC2 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. + !! DLATDF: uses the LU factorization of the n-by-n matrix Z computed by + !! DGETC2 and computes a contribution to the reciprocal Dif-estimate + !! by solving Z * x = b for x, and choosing the r.h.s. b such that + !! the norm of x is as large as possible. On entry RHS = b holds the + !! contribution from earlier solved sub-systems, and on return RHS = x. + !! The factorization of Z returned by DGETC2 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50039,16 +50035,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) - !> DLATPS: solves one of the triangular systems - !> A *x = s*b or A**T*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, 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 - !> DTPSV 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. + !! DLATPS: solves one of the triangular systems + !! A *x = s*b or A**T*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, 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 + !! DTPSV 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50457,15 +50453,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) - !> DLATRD: reduces NB rows and columns of a real symmetric matrix A to - !> symmetric tridiagonal form by an orthogonal similarity - !> transformation Q**T * A * Q, and returns the matrices V and W which are - !> needed to apply the transformation to the unreduced part of A. - !> If UPLO = 'U', DLATRD reduces the last NB rows and columns of a - !> matrix, of which the upper triangle is supplied; - !> if UPLO = 'L', DLATRD reduces the first NB rows and columns of a - !> matrix, of which the lower triangle is supplied. - !> This is an auxiliary routine called by DSYTRD. + !! DLATRD: reduces NB rows and columns of a real symmetric matrix A to + !! symmetric tridiagonal form by an orthogonal similarity + !! transformation Q**T * A * Q, and returns the matrices V and W which are + !! needed to apply the transformation to the unreduced part of A. + !! If UPLO = 'U', DLATRD reduces the last NB rows and columns of a + !! matrix, of which the upper triangle is supplied; + !! if UPLO = 'L', DLATRD reduces the first NB rows and columns of a + !! matrix, of which the lower triangle is supplied. + !! This is an auxiliary routine called by DSYTRD. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50559,16 +50555,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) - !> DLATRS: solves one of the triangular systems - !> A *x = s*b or A**T *x = s*b - !> with scaling to prevent overflow. Here A is an upper or lower - !> triangular matrix, 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 DTRSV 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. + !! DLATRS: solves one of the triangular systems + !! A *x = s*b or A**T *x = s*b + !! with scaling to prevent overflow. Here A is an upper or lower + !! triangular matrix, 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 DTRSV 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50960,10 +50956,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlatrz( m, n, l, a, lda, tau, work ) - !> DLATRZ: factors the M-by-(M+L) real upper trapezoidal matrix - !> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z, by means - !> of orthogonal transformations. Z is an (M+L)-by-(M+L) orthogonal - !> matrix and, R and A1 are M-by-M upper triangular matrices. + !! DLATRZ: factors the M-by-(M+L) real upper trapezoidal matrix + !! [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z, by means + !! of orthogonal transformations. Z is an (M+L)-by-(M+L) orthogonal + !! matrix and, R and A1 are M-by-M upper triangular matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51000,17 +50996,17 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) - !> DLATSQR: computes a blocked Tall-Skinny QR factorization of - !> a real M-by-N matrix A for M >= N: - !> A = Q * ( R ), - !> ( 0 ) - !> where: - !> Q is a M-by-M orthogonal matrix, stored on exit in an implicit - !> form in the elements below the diagonal of the array A and in - !> the elements of the array T; - !> R is an upper-triangular N-by-N matrix, stored on exit in - !> the elements on and above the diagonal of the array A. - !> 0 is a (M-N)-by-N zero matrix, and is not stored. + !! DLATSQR: computes a blocked Tall-Skinny QR factorization of + !! a real M-by-N matrix A for M >= N: + !! A = Q * ( R ), + !! ( 0 ) + !! where: + !! Q is a M-by-M orthogonal matrix, stored on exit in an implicit + !! form in the elements below the diagonal of the array A and in + !! the elements of the array T; + !! R is an upper-triangular N-by-N matrix, stored on exit in + !! the elements on and above the diagonal of the array A. + !! 0 is a (M-N)-by-N zero matrix, and is not stored. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -51085,14 +51081,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlauu2( uplo, n, a, lda, info ) - !> DLAUU2: computes the product U * U**T or L**T * L, where the triangular - !> factor U or L is stored in the upper or lower triangular part of - !> the array A. - !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, - !> overwriting the factor U in A. - !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, - !> overwriting the factor L in A. - !> This is the unblocked form of the algorithm, calling Level 2 BLAS. + !! DLAUU2: computes the product U * U**T or L**T * L, where the triangular + !! factor U or L is stored in the upper or lower triangular part of + !! the array A. + !! If UPLO = 'U' or 'u' then the upper triangle of the result is stored, + !! overwriting the factor U in A. + !! If UPLO = 'L' or 'l' then the lower triangle of the result is stored, + !! overwriting the factor L in A. + !! This is the unblocked form of the algorithm, calling Level 2 BLAS. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51157,14 +51153,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlauum( uplo, n, a, lda, info ) - !> DLAUUM: computes the product U * U**T or L**T * L, where the triangular - !> factor U or L is stored in the upper or lower triangular part of - !> the array A. - !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, - !> overwriting the factor U in A. - !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, - !> overwriting the factor L in A. - !> This is the blocked form of the algorithm, calling Level 3 BLAS. + !! DLAUUM: computes the product U * U**T or L**T * L, where the triangular + !! factor U or L is stored in the upper or lower triangular part of + !! the array A. + !! If UPLO = 'U' or 'u' then the upper triangle of the result is stored, + !! overwriting the factor U in A. + !! If UPLO = 'L' or 'l' then the lower triangle of the result is stored, + !! overwriting the factor L in A. + !! This is the blocked form of the algorithm, calling Level 3 BLAS. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51240,11 +51236,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qopgtr( uplo, n, ap, tau, q, ldq, work, info ) - !> DOPGTR: generates a real orthogonal matrix Q which is defined as the - !> product of n-1 elementary reflectors H(i) of order n, as returned by - !> DSPTRD using packed storage: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! DOPGTR: generates a real orthogonal matrix Q which is defined as the + !! product of n-1 elementary reflectors H(i) of order n, as returned by + !! DSPTRD using packed storage: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51327,16 +51323,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qopmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) - !> DOPMTR: overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by DSPTRD using packed - !> storage: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! DOPMTR: overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by DSPTRD using packed + !! storage: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51474,22 +51470,22 @@ module stdlib_linalg_lapack_q subroutine stdlib_qorbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & - !> DORBDB: simultaneously bidiagonalizes the blocks of an M-by-M - !> partitioned orthogonal matrix X: - !> [ B11 | B12 0 0 ] - !> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**T - !> X = [-----------] = [---------] [----------------] [---------] . - !> [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] - !> [ 0 | 0 0 I ] - !> X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is - !> not the case, then X must be transposed and/or permuted. This can be - !> done in constant time using the TRANS and SIGNS options. See DORCSD - !> for details.) - !> The orthogonal matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- - !> (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are - !> represented implicitly by Householder vectors. - !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! DORBDB: simultaneously bidiagonalizes the blocks of an M-by-M + !! partitioned orthogonal matrix X: + !! [ B11 | B12 0 0 ] + !! [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**T + !! X = [-----------] = [---------] [----------------] [---------] . + !! [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] + !! [ 0 | 0 0 I ] + !! X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is + !! not the case, then X must be transposed and/or permuted. This can be + !! done in constant time using the TRANS and SIGNS options. See DORCSD + !! for details.) + !! The orthogonal matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- + !! (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are + !! represented implicitly by Householder vectors. + !! B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented + !! implicitly by angles THETA, PHI. ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51802,21 +51798,21 @@ module stdlib_linalg_lapack_q subroutine stdlib_qorbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> DORBDB1: simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, - !> M-P, or M-Q. Routines DORBDB2, DORBDB3, and DORBDB4 handle cases in - !> which Q is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! DORBDB1: simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, + !! M-P, or M-Q. Routines DORBDB2, DORBDB3, and DORBDB4 handle cases in + !! which Q is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by + !! angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51905,21 +51901,21 @@ module stdlib_linalg_lapack_q subroutine stdlib_qorbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> DORBDB2: simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, - !> Q, or M-Q. Routines DORBDB1, DORBDB3, and DORBDB4 handle cases in - !> which P is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! DORBDB2: simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, + !! Q, or M-Q. Routines DORBDB1, DORBDB3, and DORBDB4 handle cases in + !! which P is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are P-by-P bidiagonal matrices represented implicitly by + !! angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52018,21 +52014,21 @@ module stdlib_linalg_lapack_q subroutine stdlib_qorbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> DORBDB3: simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, - !> Q, or M-Q. Routines DORBDB1, DORBDB2, and DORBDB4 handle cases in - !> which M-P is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! DORBDB3: simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, + !! Q, or M-Q. Routines DORBDB1, DORBDB2, and DORBDB4 handle cases in + !! which M-P is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52130,21 +52126,21 @@ module stdlib_linalg_lapack_q subroutine stdlib_qorbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> DORBDB4: simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, - !> M-P, or Q. Routines DORBDB1, DORBDB2, and DORBDB3 handle cases in - !> which M-Q is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! DORBDB4: simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, + !! M-P, or Q. Routines DORBDB1, DORBDB2, and DORBDB3 handle cases in + !! which M-Q is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52272,17 +52268,17 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & - !> DORBDB5: orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then some other vector from the orthogonal complement - !> is returned. This vector is chosen in an arbitrary but deterministic - !> way. + !! DORBDB5: orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then some other vector from the orthogonal complement + !! is returned. This vector is chosen in an arbitrary but deterministic + !! way. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52371,15 +52367,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & - !> DORBDB6: orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then the zero vector is returned. + !! DORBDB6: orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then the zero vector is returned. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52499,19 +52495,19 @@ module stdlib_linalg_lapack_q recursive subroutine stdlib_qorcsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & - !> DORCSD: computes the CS decomposition of an M-by-M partitioned - !> orthogonal matrix X: - !> [ I 0 0 | 0 0 0 ] - !> [ 0 C 0 | 0 -S 0 ] - !> [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**T - !> X = [-----------] = [---------] [---------------------] [---------] . - !> [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] - !> [ 0 S 0 | 0 C 0 ] - !> [ 0 0 I | 0 0 0 ] - !> X11 is P-by-Q. The orthogonal matrices U1, U2, V1, and V2 are P-by-P, - !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are - !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in - !> which R = MIN(P,M-P,Q,M-Q). + !! DORCSD: computes the CS decomposition of an M-by-M partitioned + !! orthogonal matrix X: + !! [ I 0 0 | 0 0 0 ] + !! [ 0 C 0 | 0 -S 0 ] + !! [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**T + !! X = [-----------] = [---------] [---------------------] [---------] . + !! [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] + !! [ 0 S 0 | 0 C 0 ] + !! [ 0 0 I | 0 0 0 ] + !! X11 is P-by-Q. The orthogonal matrices U1, U2, V1, and V2 are P-by-P, + !! (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are + !! R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in + !! which R = MIN(P,M-P,Q,M-Q). ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, ldv1t, v2t,ldv2t, & work, lwork, iwork, info ) ! -- lapack computational routine -- @@ -52774,21 +52770,21 @@ module stdlib_linalg_lapack_q subroutine stdlib_qorcsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & - !> DORCSD2BY1: computes the CS decomposition of an M-by-Q matrix X with - !> orthonormal columns that has been partitioned into a 2-by-1 block - !> structure: - !> [ I1 0 0 ] - !> [ 0 C 0 ] - !> [ X11 ] [ U1 | ] [ 0 0 0 ] - !> X = [-----] = [---------] [----------] V1**T . - !> [ X21 ] [ | U2 ] [ 0 0 0 ] - !> [ 0 S 0 ] - !> [ 0 0 I2] - !> X11 is P-by-Q. The orthogonal matrices U1, U2, and V1 are P-by-P, - !> (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R - !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which - !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a - !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). + !! DORCSD2BY1: computes the CS decomposition of an M-by-Q matrix X with + !! orthonormal columns that has been partitioned into a 2-by-1 block + !! structure: + !! [ I1 0 0 ] + !! [ 0 C 0 ] + !! [ X11 ] [ U1 | ] [ 0 0 0 ] + !! X = [-----] = [---------] [----------] V1**T . + !! [ X21 ] [ | U2 ] [ 0 0 0 ] + !! [ 0 S 0 ] + !! [ 0 0 I2] + !! X11 is P-by-Q. The orthogonal matrices U1, U2, and V1 are P-by-P, + !! (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R + !! nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which + !! R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a + !! K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, iwork, info ) ! -- lapack computational routine (3.5.0_qp) -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53189,11 +53185,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorg2l( m, n, k, a, lda, tau, work, info ) - !> DORG2L: generates an m by n real matrix Q with orthonormal columns, - !> which is defined as the last n columns of a product of k elementary - !> reflectors of order m - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGEQLF. + !! DORG2L: generates an m by n real matrix Q with orthonormal columns, + !! which is defined as the last n columns of a product of k elementary + !! reflectors of order m + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGEQLF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53253,11 +53249,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorg2r( m, n, k, a, lda, tau, work, info ) - !> DORG2R: generates an m by n real matrix Q with orthonormal columns, - !> which is defined as the first n columns of a product of k elementary - !> reflectors of order m - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGEQRF. + !! DORG2R: generates an m by n real matrix Q with orthonormal columns, + !! which is defined as the first n columns of a product of k elementary + !! reflectors of order m + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGEQRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53318,22 +53314,22 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorgbr( vect, m, n, k, a, lda, tau, work, lwork, info ) - !> DORGBR: generates one of the real orthogonal matrices Q or P**T - !> determined by DGEBRD when reducing a real matrix A to bidiagonal - !> form: A = Q * B * P**T. Q and P**T are defined as products of - !> elementary reflectors H(i) or G(i) respectively. - !> If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q - !> is of order M: - !> if m >= k, Q = H(1) H(2) . . . H(k) and DORGBR returns the first n - !> columns of Q, where m >= n >= k; - !> if m < k, Q = H(1) H(2) . . . H(m-1) and DORGBR returns Q as an - !> M-by-M matrix. - !> If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T - !> is of order N: - !> if k < n, P**T = G(k) . . . G(2) G(1) and DORGBR returns the first m - !> rows of P**T, where n >= m >= k; - !> if k >= n, P**T = G(n-1) . . . G(2) G(1) and DORGBR returns P**T as - !> an N-by-N matrix. + !! DORGBR: generates one of the real orthogonal matrices Q or P**T + !! determined by DGEBRD when reducing a real matrix A to bidiagonal + !! form: A = Q * B * P**T. Q and P**T are defined as products of + !! elementary reflectors H(i) or G(i) respectively. + !! If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q + !! is of order M: + !! if m >= k, Q = H(1) H(2) . . . H(k) and DORGBR returns the first n + !! columns of Q, where m >= n >= k; + !! if m < k, Q = H(1) H(2) . . . H(m-1) and DORGBR returns Q as an + !! M-by-M matrix. + !! If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T + !! is of order N: + !! if k < n, P**T = G(k) . . . G(2) G(1) and DORGBR returns the first m + !! rows of P**T, where n >= m >= k; + !! if k >= n, P**T = G(n-1) . . . G(2) G(1) and DORGBR returns P**T as + !! an N-by-N matrix. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53467,10 +53463,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) - !> DORGHR: generates a real orthogonal matrix Q which is defined as the - !> product of IHI-ILO elementary reflectors of order N, as returned by - !> DGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! DORGHR: generates a real orthogonal matrix Q which is defined as the + !! product of IHI-ILO elementary reflectors of order N, as returned by + !! DGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53557,11 +53553,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorgl2( m, n, k, a, lda, tau, work, info ) - !> DORGL2: generates an m by n real matrix Q with orthonormal rows, - !> which is defined as the first m rows of a product of k elementary - !> reflectors of order n - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGELQF. + !! DORGL2: generates an m by n real matrix Q with orthonormal rows, + !! which is defined as the first m rows of a product of k elementary + !! reflectors of order n + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGELQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53626,11 +53622,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorglq( m, n, k, a, lda, tau, work, lwork, info ) - !> DORGLQ: generates an M-by-N real matrix Q with orthonormal rows, - !> which is defined as the first M rows of a product of K elementary - !> reflectors of order N - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGELQF. + !! DORGLQ: generates an M-by-N real matrix Q with orthonormal rows, + !! which is defined as the first M rows of a product of K elementary + !! reflectors of order N + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGELQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53742,11 +53738,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorgql( m, n, k, a, lda, tau, work, lwork, info ) - !> DORGQL: generates an M-by-N real matrix Q with orthonormal columns, - !> which is defined as the last N columns of a product of K elementary - !> reflectors of order M - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGEQLF. + !! DORGQL: generates an M-by-N real matrix Q with orthonormal columns, + !! which is defined as the last N columns of a product of K elementary + !! reflectors of order M + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGEQLF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53863,11 +53859,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorgqr( m, n, k, a, lda, tau, work, lwork, info ) - !> DORGQR: generates an M-by-N real matrix Q with orthonormal columns, - !> which is defined as the first N columns of a product of K elementary - !> reflectors of order M - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGEQRF. + !! DORGQR: generates an M-by-N real matrix Q with orthonormal columns, + !! which is defined as the first N columns of a product of K elementary + !! reflectors of order M + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGEQRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53979,11 +53975,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorgr2( m, n, k, a, lda, tau, work, info ) - !> DORGR2: generates an m by n real matrix Q with orthonormal rows, - !> which is defined as the last m rows of a product of k elementary - !> reflectors of order n - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGERQF. + !! DORGR2: generates an m by n real matrix Q with orthonormal rows, + !! which is defined as the last m rows of a product of k elementary + !! reflectors of order n + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGERQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54045,11 +54041,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorgrq( m, n, k, a, lda, tau, work, lwork, info ) - !> DORGRQ: generates an M-by-N real matrix Q with orthonormal rows, - !> which is defined as the last M rows of a product of K elementary - !> reflectors of order N - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGERQF. + !! DORGRQ: generates an M-by-N real matrix Q with orthonormal rows, + !! which is defined as the last M rows of a product of K elementary + !! reflectors of order N + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGERQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54166,11 +54162,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorgtr( uplo, n, a, lda, tau, work, lwork, info ) - !> DORGTR: generates a real orthogonal matrix Q which is defined as the - !> product of n-1 elementary reflectors of order N, as returned by - !> DSYTRD: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! DORGTR: generates a real orthogonal matrix Q which is defined as the + !! product of n-1 elementary reflectors of order N, as returned by + !! DSYTRD: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54267,11 +54263,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorgtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) - !> DORGTSQR: generates an M-by-N real matrix Q_out with orthonormal columns, - !> which are the first N columns of a product of real orthogonal - !> matrices of order M which are returned by DLATSQR - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> See the documentation for DLATSQR. + !! DORGTSQR: generates an M-by-N real matrix Q_out with orthonormal columns, + !! which are the first N columns of a product of real orthogonal + !! matrices of order M which are returned by DLATSQR + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! See the documentation for DLATSQR. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54365,21 +54361,21 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorgtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) - !> DORGTSQR_ROW: generates an M-by-N real matrix Q_out with - !> orthonormal columns from the output of DLATSQR. These N orthonormal - !> columns are the first N columns of a product of complex unitary - !> matrices Q(k)_in of order M, which are returned by DLATSQR in - !> a special format. - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> The input matrices Q(k)_in are stored in row and column blocks in A. - !> See the documentation of DLATSQR for more details on the format of - !> Q(k)_in, where each Q(k)_in is represented by block Householder - !> transformations. This routine calls an auxiliary routine DLARFB_GETT, - !> where the computation is performed on each individual block. The - !> algorithm first sweeps NB-sized column blocks from the right to left - !> starting in the bottom row block and continues to the top row block - !> (hence _ROW in the routine name). This sweep is in reverse order of - !> the order in which DLATSQR generates the output blocks. + !! DORGTSQR_ROW: generates an M-by-N real matrix Q_out with + !! orthonormal columns from the output of DLATSQR. These N orthonormal + !! columns are the first N columns of a product of complex unitary + !! matrices Q(k)_in of order M, which are returned by DLATSQR in + !! a special format. + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! The input matrices Q(k)_in are stored in row and column blocks in A. + !! See the documentation of DLATSQR for more details on the format of + !! Q(k)_in, where each Q(k)_in is represented by block Householder + !! transformations. This routine calls an auxiliary routine DLARFB_GETT, + !! where the computation is performed on each individual block. The + !! algorithm first sweeps NB-sized column blocks from the right to left + !! starting in the bottom row block and continues to the top row block + !! (hence _ROW in the routine name). This sweep is in reverse order of + !! the order in which DLATSQR generates the output blocks. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54508,15 +54504,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorhr_col( m, n, nb, a, lda, t, ldt, d, info ) - !> DORHR_COL: takes an M-by-N real matrix Q_in with orthonormal columns - !> as input, stored in A, and performs Householder Reconstruction (HR), - !> i.e. reconstructs Householder vectors V(i) implicitly representing - !> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, - !> where S is an N-by-N diagonal matrix with diagonal entries - !> equal to +1 or -1. The Householder vectors (columns V(i) of V) are - !> stored in A on output, and the diagonal entries of S are stored in D. - !> Block reflectors are also returned in T - !> (same output format as DGEQRT). + !! DORHR_COL: takes an M-by-N real matrix Q_in with orthonormal columns + !! as input, stored in A, and performs Householder Reconstruction (HR), + !! i.e. reconstructs Householder vectors V(i) implicitly representing + !! another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, + !! where S is an N-by-N diagonal matrix with diagonal entries + !! equal to +1 or -1. The Householder vectors (columns V(i) of V) are + !! stored in A on output, and the diagonal entries of S are stored in D. + !! Block reflectors are also returned in T + !! (same output format as DGEQRT). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54827,16 +54823,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> DORM2L: overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T * C if SIDE = 'L' and TRANS = 'T', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'T', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGEQLF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! DORM2L: overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T * C if SIDE = 'L' and TRANS = 'T', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'T', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGEQLF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54921,16 +54917,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> DORM2R: overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T* C if SIDE = 'L' and TRANS = 'T', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'T', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! DORM2R: overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T* C if SIDE = 'L' and TRANS = 'T', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'T', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55020,28 +55016,28 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qormbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & - !> If VECT = 'Q', DORMBR: overwrites the general real M-by-N matrix C - !> with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> If VECT = 'P', DORMBR overwrites the general real M-by-N matrix C - !> with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': P * C C * P - !> TRANS = 'T': P**T * C C * P**T - !> Here Q and P**T are the orthogonal matrices determined by DGEBRD when - !> reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and - !> P**T are defined as products of elementary reflectors H(i) and G(i) - !> respectively. - !> Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the - !> order of the orthogonal matrix Q or P**T that is applied. - !> If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: - !> if nq >= k, Q = H(1) H(2) . . . H(k); - !> if nq < k, Q = H(1) H(2) . . . H(nq-1). - !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: - !> if k < nq, P = G(1) G(2) . . . G(k); - !> if k >= nq, P = G(1) G(2) . . . G(nq-1). + !! If VECT = 'Q', DORMBR: overwrites the general real M-by-N matrix C + !! with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! If VECT = 'P', DORMBR overwrites the general real M-by-N matrix C + !! with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': P * C C * P + !! TRANS = 'T': P**T * C C * P**T + !! Here Q and P**T are the orthogonal matrices determined by DGEBRD when + !! reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and + !! P**T are defined as products of elementary reflectors H(i) and G(i) + !! respectively. + !! Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the + !! order of the orthogonal matrix Q or P**T that is applied. + !! If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: + !! if nq >= k, Q = H(1) H(2) . . . H(k); + !! if nq < k, Q = H(1) H(2) . . . H(nq-1). + !! If VECT = 'P', A is assumed to have been a K-by-NQ matrix: + !! if k < nq, P = G(1) G(2) . . . G(k); + !! if k >= nq, P = G(1) G(2) . . . G(nq-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55178,14 +55174,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qormhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & - !> DORMHR: overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> IHI-ILO elementary reflectors, as returned by DGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! DORMHR: overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! IHI-ILO elementary reflectors, as returned by DGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55277,16 +55273,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qorml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> DORML2: overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T* C if SIDE = 'L' and TRANS = 'T', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'T', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! DORML2: overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T* C if SIDE = 'L' and TRANS = 'T', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'T', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55376,15 +55372,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qormlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> DORMLQ: overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! DORMLQ: overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55519,15 +55515,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qormql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> DORMQL: overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! DORMQL: overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55656,15 +55652,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qormqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> DORMQR: overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! DORMQR: overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55793,16 +55789,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qormr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> DORMR2: overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T* C if SIDE = 'L' and TRANS = 'T', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'T', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGERQF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! DORMR2: overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T* C if SIDE = 'L' and TRANS = 'T', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'T', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGERQF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55887,16 +55883,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qormr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) - !> DORMR3: overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'C', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DTZRZF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! DORMR3: overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'C', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DTZRZF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55986,15 +55982,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qormrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> DORMRQ: overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DGERQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! DORMRQ: overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DGERQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56129,15 +56125,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qormrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & - !> DORMRZ: overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by DTZRZF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! DORMRZ: overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by DTZRZF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56282,15 +56278,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qormtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & - !> DORMTR: overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by DSYTRD: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! DORMTR: overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by DSYTRD: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56398,11 +56394,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,iwork, info ) - !> DPBCON: estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric positive definite band matrix using the - !> Cholesky factorization A = U**T*U or A = L*L**T computed by DPBTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! DPBCON: estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric positive definite band matrix using the + !! Cholesky factorization A = U**T*U or A = L*L**T computed by DPBTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56496,14 +56492,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) - !> DPBEQU: computes row and column scalings intended to equilibrate a - !> symmetric positive definite band matrix A and reduce its condition - !> number (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. + !! DPBEQU: computes row and column scalings intended to equilibrate a + !! symmetric positive definite band matrix A and reduce its condition + !! number (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56583,10 +56579,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & - !> DPBRFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric positive definite - !> and banded, and provides error bounds and backward error estimates - !> for the solution. + !! DPBRFS: improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric positive definite + !! and banded, and provides error bounds and backward error estimates + !! for the solution. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56777,15 +56773,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpbstf( uplo, n, kd, ab, ldab, info ) - !> DPBSTF: computes a split Cholesky factorization of a real - !> symmetric positive definite band matrix A. - !> This routine is designed to be used in conjunction with DSBGST. - !> The factorization has the form A = S**T*S where S is a band matrix - !> of the same bandwidth as A and the following structure: - !> S = ( U ) - !> ( M L ) - !> where U is upper triangular of order m = (n+kd)/2, and L is lower - !> triangular of order n-m. + !! DPBSTF: computes a split Cholesky factorization of a real + !! symmetric positive definite band matrix A. + !! This routine is designed to be used in conjunction with DSBGST. + !! The factorization has the form A = S**T*S where S is a band matrix + !! of the same bandwidth as A and the following structure: + !! S = ( U ) + !! ( M L ) + !! where U is upper triangular of order m = (n+kd)/2, and L is lower + !! triangular of order n-m. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56895,17 +56891,17 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) - !> DPBSV: computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite band matrix and X - !> and B are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular band matrix, and L is a lower - !> triangular band matrix, with the same number of superdiagonals or - !> subdiagonals as A. The factored form of A is then used to solve the - !> system of equations A * X = B. + !! DPBSV: computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite band matrix and X + !! and B are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular band matrix, and L is a lower + !! triangular band matrix, with the same number of superdiagonals or + !! subdiagonals as A. The factored form of A is then used to solve the + !! system of equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56949,13 +56945,13 @@ module stdlib_linalg_lapack_q subroutine stdlib_qpbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & - !> DPBSVX: uses the Cholesky factorization A = U**T*U or A = L*L**T to - !> compute the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite band matrix and X - !> and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DPBSVX: uses the Cholesky factorization A = U**T*U or A = L*L**T to + !! compute the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite band matrix and X + !! and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57105,14 +57101,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpbtf2( uplo, n, kd, ab, ldab, info ) - !> DPBTF2: computes the Cholesky factorization of a real symmetric - !> positive definite band matrix A. - !> The factorization has the form - !> A = U**T * U , if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix, U**T is the transpose of U, and - !> L is lower triangular. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! DPBTF2: computes the Cholesky factorization of a real symmetric + !! positive definite band matrix A. + !! The factorization has the form + !! A = U**T * U , if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix, U**T is the transpose of U, and + !! L is lower triangular. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57192,12 +57188,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpbtrf( uplo, n, kd, ab, ldab, info ) - !> DPBTRF: computes the Cholesky factorization of a real symmetric - !> positive definite band matrix A. - !> The factorization has the form - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. + !! DPBTRF: computes the Cholesky factorization of a real symmetric + !! positive definite band matrix A. + !! The factorization has the form + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57391,9 +57387,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) - !> DPBTRS: solves a system of linear equations A*X = B with a symmetric - !> positive definite band matrix A using the Cholesky factorization - !> A = U**T*U or A = L*L**T computed by DPBTRF. + !! DPBTRS: solves a system of linear equations A*X = B with a symmetric + !! positive definite band matrix A using the Cholesky factorization + !! A = U**T*U or A = L*L**T computed by DPBTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57459,13 +57455,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpftrf( transr, uplo, n, a, info ) - !> DPFTRF: computes the Cholesky factorization of a real symmetric - !> positive definite matrix A. - !> The factorization has the form - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the block version of the algorithm, calling Level 3 BLAS. + !! DPFTRF: computes the Cholesky factorization of a real symmetric + !! positive definite matrix A. + !! The factorization has the form + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the block version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57634,9 +57630,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpftri( transr, uplo, n, a, info ) - !> DPFTRI: computes the inverse of a (real) symmetric positive definite - !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T - !> computed by DPFTRF. + !! DPFTRI: computes the inverse of a (real) symmetric positive definite + !! matrix A using the Cholesky factorization A = U**T*U or A = L*L**T + !! computed by DPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57792,9 +57788,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpftrs( transr, uplo, n, nrhs, a, b, ldb, info ) - !> DPFTRS: solves a system of linear equations A*X = B with a symmetric - !> positive definite matrix A using the Cholesky factorization - !> A = U**T*U or A = L*L**T computed by DPFTRF. + !! DPFTRS: solves a system of linear equations A*X = B with a symmetric + !! positive definite matrix A using the Cholesky factorization + !! A = U**T*U or A = L*L**T computed by DPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57846,11 +57842,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpocon( uplo, n, a, lda, anorm, rcond, work, iwork,info ) - !> DPOCON: estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric positive definite matrix using the - !> Cholesky factorization A = U**T*U or A = L*L**T computed by DPOTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! DPOCON: estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric positive definite matrix using the + !! Cholesky factorization A = U**T*U or A = L*L**T computed by DPOTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57941,14 +57937,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpoequ( n, a, lda, s, scond, amax, info ) - !> DPOEQU: computes row and column scalings intended to equilibrate a - !> symmetric positive definite matrix A and reduce its condition number - !> (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. + !! DPOEQU: computes row and column scalings intended to equilibrate a + !! symmetric positive definite matrix A and reduce its condition number + !! (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58015,19 +58011,19 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpoequb( n, a, lda, s, scond, amax, info ) - !> DPOEQUB: computes row and column scalings intended to equilibrate a - !> symmetric positive definite matrix A and reduce its condition number - !> (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. - !> This routine differs from DPOEQU 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 diagonal entries are no longer approximately 1 but lie - !> between sqrt(radix) and 1/sqrt(radix). + !! DPOEQUB: computes row and column scalings intended to equilibrate a + !! symmetric positive definite matrix A and reduce its condition number + !! (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. + !! This routine differs from DPOEQU 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 diagonal entries are no longer approximately 1 but lie + !! between sqrt(radix) and 1/sqrt(radix). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58097,10 +58093,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & - !> DPORFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric positive definite, - !> and provides error bounds and backward error estimates for the - !> solution. + !! DPORFS: improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric positive definite, + !! and provides error bounds and backward error estimates for the + !! solution. work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58286,16 +58282,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qposv( uplo, n, nrhs, a, lda, b, ldb, info ) - !> DPOSV: computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**T* U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is a lower triangular - !> matrix. The factored form of A is then used to solve the system of - !> equations A * X = B. + !! DPOSV: computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**T* U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is a lower triangular + !! matrix. The factored form of A is then used to solve the system of + !! equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58337,13 +58333,13 @@ module stdlib_linalg_lapack_q subroutine stdlib_qposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & - !> DPOSVX: uses the Cholesky factorization A = U**T*U or A = L*L**T to - !> compute the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DPOSVX: uses the Cholesky factorization A = U**T*U or A = L*L**T to + !! compute the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. rcond, ferr, berr, work,iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58480,13 +58476,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpotf2( uplo, n, a, lda, info ) - !> DPOTF2: computes the Cholesky factorization of a real symmetric - !> positive definite matrix A. - !> The factorization has the form - !> A = U**T * U , if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! DPOTF2: computes the Cholesky factorization of a real symmetric + !! positive definite matrix A. + !! The factorization has the form + !! A = U**T * U , if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58567,13 +58563,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpotrf( uplo, n, a, lda, info ) - !> DPOTRF: computes the Cholesky factorization of a real symmetric - !> positive definite matrix A. - !> The factorization has the form - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the block version of the algorithm, calling Level 3 BLAS. + !! DPOTRF: computes the Cholesky factorization of a real symmetric + !! positive definite matrix A. + !! The factorization has the form + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the block version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58661,19 +58657,19 @@ module stdlib_linalg_lapack_q pure recursive subroutine stdlib_qpotrf2( uplo, n, a, lda, info ) - !> DPOTRF2: computes the Cholesky factorization of a real symmetric - !> positive definite matrix A using the recursive algorithm. - !> The factorization has the form - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> 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 = n/2 - !> [ A21 | A22 ] n2 = n-n1 - !> The subroutine calls itself to factor A11. Update and scale A21 - !> or A12, update A22 then calls itself to factor A22. + !! DPOTRF2: computes the Cholesky factorization of a real symmetric + !! positive definite matrix A using the recursive algorithm. + !! The factorization has the form + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! 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 = n/2 + !! [ A21 | A22 ] n2 = n-n1 + !! The subroutine calls itself to factor A11. Update and scale A21 + !! or A12, update A22 then calls itself to factor A22. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58759,9 +58755,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpotri( uplo, n, a, lda, info ) - !> DPOTRI: computes the inverse of a real symmetric positive definite - !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T - !> computed by DPOTRF. + !! DPOTRI: computes the inverse of a real symmetric positive definite + !! matrix A using the Cholesky factorization A = U**T*U or A = L*L**T + !! computed by DPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58800,9 +58796,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpotrs( uplo, n, nrhs, a, lda, b, ldb, info ) - !> DPOTRS: solves a system of linear equations A*X = B with a symmetric - !> positive definite matrix A using the Cholesky factorization - !> A = U**T*U or A = L*L**T computed by DPOTRF. + !! DPOTRS: solves a system of linear equations A*X = B with a symmetric + !! positive definite matrix A using the Cholesky factorization + !! A = U**T*U or A = L*L**T computed by DPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58862,12 +58858,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qppcon( uplo, n, ap, anorm, rcond, work, iwork, info ) - !> DPPCON: estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric positive definite packed matrix using - !> the Cholesky factorization A = U**T*U or A = L*L**T computed by - !> DPPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! DPPCON: estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric positive definite packed matrix using + !! the Cholesky factorization A = U**T*U or A = L*L**T computed by + !! DPPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58956,14 +58952,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qppequ( uplo, n, ap, s, scond, amax, info ) - !> DPPEQU: computes row and column scalings intended to equilibrate a - !> symmetric positive definite matrix A in packed storage and reduce - !> its condition number (with respect to the two-norm). S contains the - !> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix - !> B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal. - !> This choice of S puts the condition number of B within a factor N of - !> the smallest possible condition number over all possible diagonal - !> scalings. + !! DPPEQU: computes row and column scalings intended to equilibrate a + !! symmetric positive definite matrix A in packed storage and reduce + !! its condition number (with respect to the two-norm). S contains the + !! scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix + !! B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal. + !! This choice of S puts the condition number of B within a factor N of + !! the smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59049,10 +59045,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & - !> DPPRFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric positive definite - !> and packed, and provides error bounds and backward error estimates - !> for the solution. + !! DPPRFS: improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric positive definite + !! and packed, and provides error bounds and backward error estimates + !! for the solution. iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59241,16 +59237,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qppsv( uplo, n, nrhs, ap, b, ldb, info ) - !> DPPSV: computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite matrix stored in - !> packed format and X and B are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**T* U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is a lower triangular - !> matrix. The factored form of A is then used to solve the system of - !> equations A * X = B. + !! DPPSV: computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite matrix stored in + !! packed format and X and B are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**T* U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is a lower triangular + !! matrix. The factored form of A is then used to solve the system of + !! equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59290,13 +59286,13 @@ module stdlib_linalg_lapack_q subroutine stdlib_qppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& - !> DPPSVX: uses the Cholesky factorization A = U**T*U or A = L*L**T to - !> compute the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite matrix stored in - !> packed format and X and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DPPSVX: uses the Cholesky factorization A = U**T*U or A = L*L**T to + !! compute the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite matrix stored in + !! packed format and X and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59429,12 +59425,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpptrf( uplo, n, ap, info ) - !> DPPTRF: computes the Cholesky factorization of a real symmetric - !> positive definite matrix A stored in packed format. - !> The factorization has the form - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. + !! DPPTRF: computes the Cholesky factorization of a real symmetric + !! positive definite matrix A stored in packed format. + !! The factorization has the form + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59514,9 +59510,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpptri( uplo, n, ap, info ) - !> DPPTRI: computes the inverse of a real symmetric positive definite - !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T - !> computed by DPPTRF. + !! DPPTRI: computes the inverse of a real symmetric positive definite + !! matrix A using the Cholesky factorization A = U**T*U or A = L*L**T + !! computed by DPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59576,9 +59572,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpptrs( uplo, n, nrhs, ap, b, ldb, info ) - !> DPPTRS: solves a system of linear equations A*X = B with a symmetric - !> positive definite matrix A in packed storage using the Cholesky - !> factorization A = U**T*U or A = L*L**T computed by DPPTRF. + !! DPPTRS: solves a system of linear equations A*X = B with a symmetric + !! positive definite matrix A in packed storage using the Cholesky + !! factorization A = U**T*U or A = L*L**T computed by DPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59638,15 +59634,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpstf2( uplo, n, a, lda, piv, rank, tol, work, info ) - !> DPSTF2: computes the Cholesky factorization with complete - !> pivoting of a real symmetric positive semidefinite matrix A. - !> The factorization has the form - !> P**T * A * P = U**T * U , if UPLO = 'U', - !> P**T * A * P = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular, and - !> P is stored as vector PIV. - !> This algorithm does not attempt to check that A is positive - !> semidefinite. This version of the algorithm calls level 2 BLAS. + !! DPSTF2: computes the Cholesky factorization with complete + !! pivoting of a real symmetric positive semidefinite matrix A. + !! The factorization has the form + !! P**T * A * P = U**T * U , if UPLO = 'U', + !! P**T * A * P = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular, and + !! P is stored as vector PIV. + !! This algorithm does not attempt to check that A is positive + !! semidefinite. This version of the algorithm calls level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59817,15 +59813,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) - !> DPSTRF: computes the Cholesky factorization with complete - !> pivoting of a real symmetric positive semidefinite matrix A. - !> The factorization has the form - !> P**T * A * P = U**T * U , if UPLO = 'U', - !> P**T * A * P = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular, and - !> P is stored as vector PIV. - !> This algorithm does not attempt to check that A is positive - !> semidefinite. This version of the algorithm calls level 3 BLAS. + !! DPSTRF: computes the Cholesky factorization with complete + !! pivoting of a real symmetric positive semidefinite matrix A. + !! The factorization has the form + !! P**T * A * P = U**T * U , if UPLO = 'U', + !! P**T * A * P = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular, and + !! P is stored as vector PIV. + !! This algorithm does not attempt to check that A is positive + !! semidefinite. This version of the algorithm calls level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60028,13 +60024,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qptcon( n, d, e, anorm, rcond, work, info ) - !> DPTCON: computes the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric positive definite tridiagonal matrix - !> using the factorization A = L*D*L**T or A = U**T*D*U computed by - !> DPTTRF. - !> Norm(inv(A)) is computed by a direct method, and the reciprocal of - !> the condition number is computed as - !> RCOND = 1 / (ANORM * norm(inv(A))). + !! DPTCON: computes the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric positive definite tridiagonal matrix + !! using the factorization A = L*D*L**T or A = U**T*D*U computed by + !! DPTTRF. + !! Norm(inv(A)) is computed by a direct method, and the reciprocal of + !! the condition number is computed as + !! RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60101,21 +60097,21 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpteqr( compz, n, d, e, z, ldz, work, info ) - !> DPTEQR: computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric positive definite tridiagonal matrix by first factoring the - !> matrix using DPTTRF, and then calling DBDSQR to compute the singular - !> values of the bidiagonal factor. - !> This routine computes the eigenvalues of the positive definite - !> tridiagonal matrix to high relative accuracy. This means that if the - !> eigenvalues range over many orders of magnitude in size, then the - !> small eigenvalues and corresponding eigenvectors will be computed - !> more accurately than, for example, with the standard QR method. - !> The eigenvectors of a full or band symmetric positive definite matrix - !> can also be found if DSYTRD, DSPTRD, or DSBTRD has been used to - !> reduce this matrix to tridiagonal form. (The reduction to tridiagonal - !> form, however, may preclude the possibility of obtaining high - !> relative accuracy in the small eigenvalues of the original matrix, if - !> these eigenvalues range over many orders of magnitude.) + !! DPTEQR: computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric positive definite tridiagonal matrix by first factoring the + !! matrix using DPTTRF, and then calling DBDSQR to compute the singular + !! values of the bidiagonal factor. + !! This routine computes the eigenvalues of the positive definite + !! tridiagonal matrix to high relative accuracy. This means that if the + !! eigenvalues range over many orders of magnitude in size, then the + !! small eigenvalues and corresponding eigenvectors will be computed + !! more accurately than, for example, with the standard QR method. + !! The eigenvectors of a full or band symmetric positive definite matrix + !! can also be found if DSYTRD, DSPTRD, or DSBTRD has been used to + !! reduce this matrix to tridiagonal form. (The reduction to tridiagonal + !! form, however, may preclude the possibility of obtaining high + !! relative accuracy in the small eigenvalues of the original matrix, if + !! these eigenvalues range over many orders of magnitude.) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60195,10 +60191,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qptrfs( n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr,berr, work, info ) - !> DPTRFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric positive definite - !> and tridiagonal, and provides error bounds and backward error - !> estimates for the solution. + !! DPTRFS: improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric positive definite + !! and tridiagonal, and provides error bounds and backward error + !! estimates for the solution. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60367,11 +60363,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qptsv( n, nrhs, d, e, b, ldb, info ) - !> DPTSV: computes the solution to a real system of linear equations - !> A*X = B, where A is an N-by-N symmetric positive definite tridiagonal - !> matrix, and X and B are N-by-NRHS matrices. - !> A is factored as A = L*D*L**T, and the factored form of A is then - !> used to solve the system of equations. + !! DPTSV: computes the solution to a real system of linear equations + !! A*X = B, where A is an N-by-N symmetric positive definite tridiagonal + !! matrix, and X and B are N-by-NRHS matrices. + !! A is factored as A = L*D*L**T, and the factored form of A is then + !! used to solve the system of equations. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60408,12 +60404,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& - !> DPTSVX: uses the factorization A = L*D*L**T to compute the solution - !> to a real system of linear equations A*X = B, where A is an N-by-N - !> symmetric positive definite tridiagonal matrix and X and B are - !> N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DPTSVX: uses the factorization A = L*D*L**T to compute the solution + !! to a real system of linear equations A*X = B, where A is an N-by-N + !! symmetric positive definite tridiagonal matrix and X and B are + !! N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. work, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60482,9 +60478,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpttrf( n, d, e, info ) - !> DPTTRF: computes the L*D*L**T factorization of a real symmetric - !> positive definite tridiagonal matrix A. The factorization may also - !> be regarded as having the form A = U**T*D*U. + !! DPTTRF: computes the L*D*L**T factorization of a real symmetric + !! positive definite tridiagonal matrix A. The factorization may also + !! be regarded as having the form A = U**T*D*U. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60565,12 +60561,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qpttrs( n, nrhs, d, e, b, ldb, info ) - !> DPTTRS: solves a tridiagonal system of the form - !> A * X = B - !> using the L*D*L**T factorization of A computed by DPTTRF. D is a - !> diagonal matrix specified in the vector D, L is a unit bidiagonal - !> matrix whose subdiagonal is specified in the vector E, and X and B - !> are N by NRHS matrices. + !! DPTTRS: solves a tridiagonal system of the form + !! A * X = B + !! using the L*D*L**T factorization of A computed by DPTTRF. D is a + !! diagonal matrix specified in the vector D, L is a unit bidiagonal + !! matrix whose subdiagonal is specified in the vector E, and X and B + !! are N by NRHS matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60620,12 +60616,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qptts2( n, nrhs, d, e, b, ldb ) - !> DPTTS2: solves a tridiagonal system of the form - !> A * X = B - !> using the L*D*L**T factorization of A computed by DPTTRF. D is a - !> diagonal matrix specified in the vector D, L is a unit bidiagonal - !> matrix whose subdiagonal is specified in the vector E, and X and B - !> are N by NRHS matrices. + !! DPTTS2: solves a tridiagonal system of the form + !! A * X = B + !! using the L*D*L**T factorization of A computed by DPTTRF. D is a + !! diagonal matrix specified in the vector D, L is a unit bidiagonal + !! matrix whose subdiagonal is specified in the vector E, and X and B + !! are N by NRHS matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60661,9 +60657,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qrscl( n, sa, sx, incx ) - !> DRSCL: multiplies an n-element real vector x by the real scalar 1/a. - !> This is done without overflow or underflow as long as - !> the final result x/a does not overflow or underflow. + !! DRSCL: multiplies an n-element real vector x by the real scalar 1/a. + !! This is done without overflow or underflow as long as + !! the final result x/a does not overflow or underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60715,8 +60711,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, lda, & - !> DSB2ST_KERNELS: is an internal routine used by the DSYTRD_SB2ST - !> subroutine. + !! DSB2ST_KERNELS: is an internal routine used by the DSYTRD_SB2ST + !! subroutine. v, tau, ldvt, work) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60860,8 +60856,8 @@ module stdlib_linalg_lapack_q subroutine stdlib_qsbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,info ) - !> DSBEV: computes all the eigenvalues and, optionally, eigenvectors of - !> a real symmetric band matrix A. + !! DSBEV: computes all the eigenvalues and, optionally, eigenvectors of + !! a real symmetric band matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60962,15 +60958,15 @@ module stdlib_linalg_lapack_q subroutine stdlib_qsbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, iwork, liwork, & - !> DSBEVD: computes all the eigenvalues and, optionally, eigenvectors of - !> a real symmetric 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. + !! DSBEVD: computes all the eigenvalues and, optionally, eigenvectors of + !! a real symmetric 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61094,10 +61090,10 @@ module stdlib_linalg_lapack_q subroutine stdlib_qsbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & - !> DSBEVX: computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric band matrix A. Eigenvalues and eigenvectors can - !> be selected by specifying either a range of values or a range of - !> indices for the desired eigenvalues. + !! DSBEVX: computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric band matrix A. Eigenvalues and eigenvectors can + !! be selected by specifying either a range of values or a range of + !! indices for the desired eigenvalues. m, w, z, ldz, work, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61320,13 +61316,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, info ) - !> DSBGST: reduces a real symmetric-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**T*S by DPBSTF, using a - !> split Cholesky factorization. A is overwritten by C = X**T*A*X, where - !> X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the - !> bandwidth of A. + !! DSBGST: reduces a real symmetric-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**T*S by DPBSTF, using a + !! split Cholesky factorization. A is overwritten by C = X**T*A*X, where + !! X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the + !! bandwidth of A. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62233,10 +62229,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & - !> DSBGV: computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-definite banded eigenproblem, of - !> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric - !> and banded, and B is also positive definite. + !! DSBGV: computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-definite banded eigenproblem, of + !! the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric + !! and banded, and B is also positive definite. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62311,17 +62307,17 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & - !> DSBGVD: computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-definite banded eigenproblem, of the - !> form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric 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. + !! DSBGVD: computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-definite banded eigenproblem, of the + !! form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric 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. lwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62428,12 +62424,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & - !> DSBGVX: computes selected eigenvalues, and optionally, eigenvectors - !> of a real generalized symmetric-definite banded eigenproblem, of - !> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric - !> and banded, and B is also positive definite. Eigenvalues and - !> eigenvectors can be selected by specifying either all eigenvalues, - !> a range of values or a range of indices for the desired eigenvalues. + !! DSBGVX: computes selected eigenvalues, and optionally, eigenvectors + !! of a real generalized symmetric-definite banded eigenproblem, of + !! the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric + !! and banded, and B is also positive definite. Eigenvalues and + !! eigenvectors can be selected by specifying either all eigenvalues, + !! a range of values or a range of indices for the desired eigenvalues. vu, il, iu, abstol, m, w, z,ldz, work, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62613,9 +62609,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) - !> DSBTRD: reduces a real symmetric band matrix A to symmetric - !> tridiagonal form T by an orthogonal similarity transformation: - !> Q**T * A * Q = T. + !! DSBTRD: reduces a real symmetric band matrix A to symmetric + !! tridiagonal form T by an orthogonal similarity transformation: + !! Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62944,14 +62940,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) - !> Level 3 BLAS like routine for C in RFP Format. - !> DSFRK: performs one of the symmetric rank--k operations - !> C := alpha*A*A**T + beta*C, - !> or - !> C := alpha*A**T*A + beta*C, - !> where alpha and beta are real scalars, C is an n--by--n symmetric - !> matrix and A is an n--by--k matrix in the first case and a k--by--n - !> matrix in the second case. + !! Level 3 BLAS like routine for C in RFP Format. + !! DSFRK: performs one of the symmetric rank--k operations + !! C := alpha*A*A**T + beta*C, + !! or + !! C := alpha*A**T*A + beta*C, + !! where alpha and beta are real scalars, C is an n--by--n symmetric + !! matrix and A is an n--by--k matrix in the first case and a k--by--n + !! matrix in the second case. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63200,33 +63196,33 @@ module stdlib_linalg_lapack_q subroutine stdlib_qsgesv( n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work,swork, iter, info ) - !> DSGESV: computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N matrix and X and B are N-by-NRHS matrices. - !> DSGESV first attempts to factorize the matrix in SINGLE PRECISION - !> and use this factorization within an iterative refinement procedure - !> to produce a solution with DOUBLE PRECISION normwise backward error - !> quality (see below). If the approach fails the method switches to a - !> DOUBLE PRECISION factorization and solve. - !> The iterative refinement is not going to be a winning strategy if - !> the ratio SINGLE PRECISION performance over DOUBLE PRECISION - !> performance is too small. A reasonable strategy should take the - !> number of right-hand sides and the size of the matrix into account. - !> This might be done with a call to ILAENV in the future. Up to now, we - !> always try iterative refinement. - !> The iterative refinement process is stopped if - !> ITER > ITERMAX - !> or for all the RHS we have: - !> RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX - !> where - !> o ITER is the number of the current iteration in the iterative - !> refinement process - !> o RNRM is the infinity-norm of the residual - !> o XNRM is the infinity-norm of the solution - !> o ANRM is the infinity-operator-norm of the matrix A - !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') - !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 - !> respectively. + !! DSGESV: computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N matrix and X and B are N-by-NRHS matrices. + !! DSGESV first attempts to factorize the matrix in SINGLE PRECISION + !! and use this factorization within an iterative refinement procedure + !! to produce a solution with DOUBLE PRECISION normwise backward error + !! quality (see below). If the approach fails the method switches to a + !! DOUBLE PRECISION factorization and solve. + !! The iterative refinement is not going to be a winning strategy if + !! the ratio SINGLE PRECISION performance over DOUBLE PRECISION + !! performance is too small. A reasonable strategy should take the + !! number of right-hand sides and the size of the matrix into account. + !! This might be done with a call to ILAENV in the future. Up to now, we + !! always try iterative refinement. + !! The iterative refinement process is stopped if + !! ITER > ITERMAX + !! or for all the RHS we have: + !! RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX + !! where + !! o ITER is the number of the current iteration in the iterative + !! refinement process + !! o RNRM is the infinity-norm of the residual + !! o XNRM is the infinity-norm of the solution + !! o ANRM is the infinity-operator-norm of the matrix A + !! o EPS is the machine epsilon returned by DLAMCH('Epsilon') + !! The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 + !! respectively. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63380,11 +63376,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qspcon( uplo, n, ap, ipiv, anorm, rcond, work, iwork,info ) - !> DSPCON: estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric packed matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by DSPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! DSPCON: estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric packed matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by DSPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63462,8 +63458,8 @@ module stdlib_linalg_lapack_q subroutine stdlib_qspev( jobz, uplo, n, ap, w, z, ldz, work, info ) - !> DSPEV: computes all the eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A in packed storage. + !! DSPEV: computes all the eigenvalues and, optionally, eigenvectors of a + !! real symmetric matrix A in packed storage. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63555,15 +63551,15 @@ module stdlib_linalg_lapack_q subroutine stdlib_qspevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,iwork, liwork, info ) - !> DSPEVD: computes all the eigenvalues and, optionally, eigenvectors - !> of a real symmetric 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. + !! DSPEVD: computes all the eigenvalues and, optionally, eigenvectors + !! of a real symmetric 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63680,10 +63676,10 @@ module stdlib_linalg_lapack_q subroutine stdlib_qspevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> DSPEVX: computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric matrix A in packed storage. Eigenvalues/vectors - !> can be selected by specifying either a range of values or a range of - !> indices for the desired eigenvalues. + !! DSPEVX: computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric matrix A in packed storage. Eigenvalues/vectors + !! can be selected by specifying either a range of values or a range of + !! indices for the desired eigenvalues. work, iwork, ifail,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63893,13 +63889,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qspgst( itype, uplo, n, ap, bp, info ) - !> DSPGST: reduces a real symmetric-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**T)*A*inv(U) or inv(L)*A*inv(L**T) - !> 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**T or L**T*A*L. - !> B must have been previously factorized as U**T*U or L*L**T by DPPTRF. + !! DSPGST: reduces a real symmetric-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**T)*A*inv(U) or inv(L)*A*inv(L**T) + !! 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**T or L**T*A*L. + !! B must have been previously factorized as U**T*U or L*L**T by DPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64015,11 +64011,11 @@ module stdlib_linalg_lapack_q subroutine stdlib_qspgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,info ) - !> DSPGV: computes all the eigenvalues and, optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric, stored in packed format, - !> and B is also positive definite. + !! DSPGV: computes all the eigenvalues and, optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric, stored in packed format, + !! and B is also positive definite. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64099,18 +64095,18 @@ module stdlib_linalg_lapack_q subroutine stdlib_qspgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, iwork, liwork,& - !> DSPGVD: computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric, 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. + !! DSPGVD: computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric, 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64223,13 +64219,13 @@ module stdlib_linalg_lapack_q subroutine stdlib_qspgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & - !> DSPGVX: computes selected eigenvalues, and optionally, eigenvectors - !> of a real generalized symmetric-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 symmetric, stored in packed storage, and B - !> is also positive definite. Eigenvalues and eigenvectors can be - !> selected by specifying either a range of values or a range of indices - !> for the desired eigenvalues. + !! DSPGVX: computes selected eigenvalues, and optionally, eigenvectors + !! of a real generalized symmetric-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 symmetric, stored in packed storage, and B + !! is also positive definite. Eigenvalues and eigenvectors can be + !! selected by specifying either a range of values or a range of indices + !! for the desired eigenvalues. z, ldz, work, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64335,34 +64331,34 @@ module stdlib_linalg_lapack_q subroutine stdlib_qsposv( uplo, n, nrhs, a, lda, b, ldb, x, ldx, work,swork, iter, info ) - !> DSPOSV: computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> DSPOSV first attempts to factorize the matrix in SINGLE PRECISION - !> and use this factorization within an iterative refinement procedure - !> to produce a solution with DOUBLE PRECISION normwise backward error - !> quality (see below). If the approach fails the method switches to a - !> DOUBLE PRECISION factorization and solve. - !> The iterative refinement is not going to be a winning strategy if - !> the ratio SINGLE PRECISION performance over DOUBLE PRECISION - !> performance is too small. A reasonable strategy should take the - !> number of right-hand sides and the size of the matrix into account. - !> This might be done with a call to ILAENV in the future. Up to now, we - !> always try iterative refinement. - !> The iterative refinement process is stopped if - !> ITER > ITERMAX - !> or for all the RHS we have: - !> RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX - !> where - !> o ITER is the number of the current iteration in the iterative - !> refinement process - !> o RNRM is the infinity-norm of the residual - !> o XNRM is the infinity-norm of the solution - !> o ANRM is the infinity-operator-norm of the matrix A - !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') - !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 - !> respectively. + !! DSPOSV: computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! DSPOSV first attempts to factorize the matrix in SINGLE PRECISION + !! and use this factorization within an iterative refinement procedure + !! to produce a solution with DOUBLE PRECISION normwise backward error + !! quality (see below). If the approach fails the method switches to a + !! DOUBLE PRECISION factorization and solve. + !! The iterative refinement is not going to be a winning strategy if + !! the ratio SINGLE PRECISION performance over DOUBLE PRECISION + !! performance is too small. A reasonable strategy should take the + !! number of right-hand sides and the size of the matrix into account. + !! This might be done with a call to ILAENV in the future. Up to now, we + !! always try iterative refinement. + !! The iterative refinement process is stopped if + !! ITER > ITERMAX + !! or for all the RHS we have: + !! RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX + !! where + !! o ITER is the number of the current iteration in the iterative + !! refinement process + !! o RNRM is the infinity-norm of the residual + !! o XNRM is the infinity-norm of the solution + !! o ANRM is the infinity-operator-norm of the matrix A + !! o EPS is the machine epsilon returned by DLAMCH('Epsilon') + !! The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 + !! respectively. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64514,10 +64510,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& - !> DSPRFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite - !> and packed, and provides error bounds and backward error estimates - !> for the solution. + !! DSPRFS: improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric indefinite + !! and packed, and provides error bounds and backward error estimates + !! for the solution. iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64707,17 +64703,17 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> DSPSV: computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric 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**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, D is symmetric 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. + !! DSPSV: computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric 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**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, D is symmetric 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64758,12 +64754,12 @@ module stdlib_linalg_lapack_q subroutine stdlib_qspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & - !> DSPSVX: uses the diagonal pivoting factorization A = U*D*U**T or - !> A = L*D*L**T to compute the solution to a real system of linear - !> equations A * X = B, where A is an N-by-N symmetric matrix stored - !> in packed format and X and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DSPSVX: uses the diagonal pivoting factorization A = U*D*U**T or + !! A = L*D*L**T to compute the solution to a real system of linear + !! equations A * X = B, where A is an N-by-N symmetric matrix stored + !! in packed format and X and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64836,9 +64832,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsptrd( uplo, n, ap, d, e, tau, info ) - !> DSPTRD: reduces a real symmetric matrix A stored in packed form to - !> symmetric tridiagonal form T by an orthogonal similarity - !> transformation: Q**T * A * Q = T. + !! DSPTRD: reduces a real symmetric matrix A stored in packed form to + !! symmetric tridiagonal form T by an orthogonal similarity + !! transformation: Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64933,12 +64929,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsptrf( uplo, n, ap, ipiv, info ) - !> DSPTRF: computes the factorization of a real symmetric matrix A stored - !> in packed format using the Bunch-Kaufman diagonal pivoting method: - !> 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 symmetric and block diagonal with - !> 1-by-1 and 2-by-2 diagonal blocks. + !! DSPTRF: computes the factorization of a real symmetric matrix A stored + !! in packed format using the Bunch-Kaufman diagonal pivoting method: + !! 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 symmetric and block diagonal with + !! 1-by-1 and 2-by-2 diagonal blocks. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65256,9 +65252,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsptri( uplo, n, ap, ipiv, work, info ) - !> DSPTRI: computes the inverse of a real symmetric indefinite matrix - !> A in packed storage using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by DSPTRF. + !! DSPTRI: computes the inverse of a real symmetric indefinite matrix + !! A in packed storage using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by DSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65467,9 +65463,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> DSPTRS: solves a system of linear equations A*X = B with a real - !> symmetric matrix A stored in packed format using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by DSPTRF. + !! DSPTRS: solves a system of linear equations A*X = B with a real + !! symmetric matrix A stored in packed format using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by DSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65687,16 +65683,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qstebz( range, order, n, vl, vu, il, iu, abstol, d, e,m, nsplit, w, & - !> DSTEBZ: computes the eigenvalues of a symmetric tridiagonal - !> matrix T. 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. + !! DSTEBZ: computes the eigenvalues of a symmetric tridiagonal + !! matrix T. 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. iblock, isplit, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66080,17 +66076,17 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qstedc( compz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) - !> DSTEDC: computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric tridiagonal matrix using the divide and conquer method. - !> The eigenvectors of a full or band real symmetric matrix can also be - !> found if DSYTRD or DSPTRD or DSBTRD has been used to reduce this - !> matrix to tridiagonal 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 DLAED3 for details. + !! DSTEDC: computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric tridiagonal matrix using the divide and conquer method. + !! The eigenvectors of a full or band real symmetric matrix can also be + !! found if DSYTRD or DSPTRD or DSBTRD has been used to reduce this + !! matrix to tridiagonal 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 DLAED3 for details. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66306,22 +66302,22 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> DSTEGR: computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has - !> a well defined set of pairwise different real eigenvalues, the corresponding - !> real eigenvectors are pairwise orthogonal. - !> The spectrum may be computed either completely or partially by specifying - !> either an interval (VL,VU] or a range of indices IL:IU for the desired - !> eigenvalues. - !> DSTEGR is a compatibility wrapper around the improved DSTEMR routine. - !> See DSTEMR for further details. - !> One important change is that the ABSTOL parameter no longer provides any - !> benefit and hence is no longer used. - !> Note : DSTEGR and DSTEMR work only on machines which follow - !> IEEE-754 floating-point standard in their handling of infinities and - !> NaNs. Normal execution may create these exceptiona values and hence - !> may abort due to a floating point exception in environments which - !> do not conform to the IEEE-754 standard. + !! DSTEGR: computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Any such unreduced matrix has + !! a well defined set of pairwise different real eigenvalues, the corresponding + !! real eigenvectors are pairwise orthogonal. + !! The spectrum may be computed either completely or partially by specifying + !! either an interval (VL,VU] or a range of indices IL:IU for the desired + !! eigenvalues. + !! DSTEGR is a compatibility wrapper around the improved DSTEMR routine. + !! See DSTEMR for further details. + !! One important change is that the ABSTOL parameter no longer provides any + !! benefit and hence is no longer used. + !! Note : DSTEGR and DSTEMR work only on machines which follow + !! IEEE-754 floating-point standard in their handling of infinities and + !! NaNs. Normal execution may create these exceptiona values and hence + !! may abort due to a floating point exception in environments which + !! do not conform to the IEEE-754 standard. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66348,11 +66344,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & - !> DSTEIN: computes the eigenvectors of a real symmetric tridiagonal - !> matrix T corresponding to specified eigenvalues, using inverse - !> iteration. - !> The maximum number of iterations allowed for each eigenvector is - !> specified by an internal parameter MAXITS (currently set to 5). + !! DSTEIN: computes the eigenvectors of a real symmetric tridiagonal + !! matrix T corresponding to specified eigenvalues, using inverse + !! iteration. + !! The maximum number of iterations allowed for each eigenvector is + !! specified by an internal parameter MAXITS (currently set to 5). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66546,51 +66542,51 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & - !> DSTEMR: computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has - !> a well defined set of pairwise different real eigenvalues, the corresponding - !> real eigenvectors are pairwise orthogonal. - !> The spectrum may be computed either completely or partially by specifying - !> either an interval (VL,VU] or a range of indices IL:IU for the desired - !> eigenvalues. - !> Depending on the number of desired eigenvalues, these are computed either - !> by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are - !> computed by the use of various suitable L D L^T factorizations near clusters - !> of close eigenvalues (referred to as RRRs, Relatively Robust - !> Representations). An informal sketch of the algorithm 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. - !> For more details, see: - !> - 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. - !> Further Details - !> 1.DSTEMR works only on machines which follow IEEE-754 - !> floating-point standard in their handling of infinities and NaNs. - !> This permits the use of efficient inner loops avoiding a check for - !> zero divisors. + !! DSTEMR: computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Any such unreduced matrix has + !! a well defined set of pairwise different real eigenvalues, the corresponding + !! real eigenvectors are pairwise orthogonal. + !! The spectrum may be computed either completely or partially by specifying + !! either an interval (VL,VU] or a range of indices IL:IU for the desired + !! eigenvalues. + !! Depending on the number of desired eigenvalues, these are computed either + !! by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are + !! computed by the use of various suitable L D L^T factorizations near clusters + !! of close eigenvalues (referred to as RRRs, Relatively Robust + !! Representations). An informal sketch of the algorithm 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. + !! For more details, see: + !! - 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. + !! Further Details + !! 1.DSTEMR works only on machines which follow IEEE-754 + !! floating-point standard in their handling of infinities and NaNs. + !! This permits the use of efficient inner loops avoiding a check for + !! zero divisors. isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66966,11 +66962,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsteqr( compz, n, d, e, z, ldz, work, info ) - !> DSTEQR: computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric tridiagonal matrix using the implicit QL or QR method. - !> The eigenvectors of a full or band symmetric matrix can also be found - !> if DSYTRD or DSPTRD or DSBTRD has been used to reduce this matrix to - !> tridiagonal form. + !! DSTEQR: computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric tridiagonal matrix using the implicit QL or QR method. + !! The eigenvectors of a full or band symmetric matrix can also be found + !! if DSYTRD or DSPTRD or DSBTRD has been used to reduce this matrix to + !! tridiagonal form. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67283,8 +67279,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsterf( n, d, e, info ) - !> DSTERF: computes all eigenvalues of a symmetric tridiagonal matrix - !> using the Pal-Walker-Kahan variant of the QL or QR algorithm. + !! DSTERF: computes all eigenvalues of a symmetric tridiagonal matrix + !! using the Pal-Walker-Kahan variant of the QL or QR algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67518,8 +67514,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qstev( jobz, n, d, e, z, ldz, work, info ) - !> DSTEV: computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric tridiagonal matrix A. + !! DSTEV: computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric tridiagonal matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67601,15 +67597,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qstevd( jobz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) - !> DSTEVD: computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric tridiagonal matrix. 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. + !! DSTEVD: computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric tridiagonal matrix. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67706,41 +67702,41 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qstevr( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & - !> DSTEVR: computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Eigenvalues and - !> eigenvectors can be selected by specifying either a range of values - !> or a range of indices for the desired eigenvalues. - !> Whenever possible, DSTEVR calls DSTEMR to compute the - !> eigenspectrum using Relatively Robust Representations. DSTEMR - !> 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 the i-th - !> unreduced block of T, - !> (a) Compute T - sigma_i = L_i D_i L_i^T, such that L_i D_i L_i^T - !> is a relatively robust representation, - !> (b) Compute the eigenvalues, lambda_j, of L_i D_i L_i^T to high - !> relative accuracy by the dqds algorithm, - !> (c) If there is a cluster of close eigenvalues, "choose" sigma_i - !> close to the cluster, and go to step (a), - !> (d) Given the approximate eigenvalue lambda_j of L_i D_i L_i^T, - !> compute the corresponding eigenvector by forming a - !> rank-revealing twisted factorization. - !> The desired accuracy of the output can be specified by the input - !> parameter ABSTOL. - !> For more details, see "A new O(n^2) algorithm for the symmetric - !> tridiagonal eigenvalue/eigenvector problem", by Inderjit Dhillon, - !> Computer Science Division Technical Report No. UCB//CSD-97-971, - !> UC Berkeley, May 1997. - !> Note 1 : DSTEVR calls DSTEMR when the full spectrum is requested - !> on machines which conform to the ieee-754 floating point standard. - !> DSTEVR calls DSTEBZ and DSTEIN on non-ieee machines and - !> when partial spectrum requests are made. - !> Normal execution of DSTEMR 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. + !! DSTEVR: computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Eigenvalues and + !! eigenvectors can be selected by specifying either a range of values + !! or a range of indices for the desired eigenvalues. + !! Whenever possible, DSTEVR calls DSTEMR to compute the + !! eigenspectrum using Relatively Robust Representations. DSTEMR + !! 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 the i-th + !! unreduced block of T, + !! (a) Compute T - sigma_i = L_i D_i L_i^T, such that L_i D_i L_i^T + !! is a relatively robust representation, + !! (b) Compute the eigenvalues, lambda_j, of L_i D_i L_i^T to high + !! relative accuracy by the dqds algorithm, + !! (c) If there is a cluster of close eigenvalues, "choose" sigma_i + !! close to the cluster, and go to step (a), + !! (d) Given the approximate eigenvalue lambda_j of L_i D_i L_i^T, + !! compute the corresponding eigenvector by forming a + !! rank-revealing twisted factorization. + !! The desired accuracy of the output can be specified by the input + !! parameter ABSTOL. + !! For more details, see "A new O(n^2) algorithm for the symmetric + !! tridiagonal eigenvalue/eigenvector problem", by Inderjit Dhillon, + !! Computer Science Division Technical Report No. UCB//CSD-97-971, + !! UC Berkeley, May 1997. + !! Note 1 : DSTEVR calls DSTEMR when the full spectrum is requested + !! on machines which conform to the ieee-754 floating point standard. + !! DSTEVR calls DSTEBZ and DSTEIN on non-ieee machines and + !! when partial spectrum requests are made. + !! Normal execution of DSTEMR 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. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67956,10 +67952,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qstevx( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & - !> DSTEVX: computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix A. Eigenvalues and - !> eigenvectors can be selected by specifying either a range of values - !> or a range of indices for the desired eigenvalues. + !! DSTEVX: computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix A. Eigenvalues and + !! eigenvectors can be selected by specifying either a range of values + !! or a range of indices for the desired eigenvalues. work, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68150,11 +68146,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsycon( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) - !> DSYCON: estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by DSYTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! DSYCON: estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by DSYTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68233,11 +68229,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) - !> DSYCON_ROOK: estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by DSYTRF_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))). + !! DSYCON_ROOK: estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by DSYTRF_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))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68316,9 +68312,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsyconv( uplo, way, n, a, lda, ipiv, e, info ) - !> DSYCONV: convert A given by TRF into L and D and vice-versa. - !> Get Non-diag elements of D (returned in workspace) and - !> apply or reverse permutation done in TRF. + !! DSYCONV: convert A given by TRF into L and D and vice-versa. + !! Get Non-diag elements of D (returned in workspace) and + !! apply or reverse permutation done in TRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -68521,21 +68517,21 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsyconvf( uplo, way, n, a, lda, e, ipiv, info ) - !> If parameter WAY = 'C': - !> DSYCONVF: converts the factorization output format used in - !> DSYTRF provided on entry in parameter A into the factorization - !> output format used in DSYTRF_RK (or DSYTRF_BK) that is stored - !> on exit in parameters A and E. It also converts in place details of - !> the intechanges stored in IPIV from the format used in DSYTRF into - !> the format used in DSYTRF_RK (or DSYTRF_BK). - !> If parameter WAY = 'R': - !> DSYCONVF performs the conversion in reverse direction, i.e. - !> converts the factorization output format used in DSYTRF_RK - !> (or DSYTRF_BK) provided on entry in parameters A and E into - !> the factorization output format used in DSYTRF that is stored - !> on exit in parameter A. It also converts in place details of - !> the intechanges stored in IPIV from the format used in DSYTRF_RK - !> (or DSYTRF_BK) into the format used in DSYTRF. + !! If parameter WAY = 'C': + !! DSYCONVF: converts the factorization output format used in + !! DSYTRF provided on entry in parameter A into the factorization + !! output format used in DSYTRF_RK (or DSYTRF_BK) that is stored + !! on exit in parameters A and E. It also converts in place details of + !! the intechanges stored in IPIV from the format used in DSYTRF into + !! the format used in DSYTRF_RK (or DSYTRF_BK). + !! If parameter WAY = 'R': + !! DSYCONVF performs the conversion in reverse direction, i.e. + !! converts the factorization output format used in DSYTRF_RK + !! (or DSYTRF_BK) provided on entry in parameters A and E into + !! the factorization output format used in DSYTRF that is stored + !! on exit in parameter A. It also converts in place details of + !! the intechanges stored in IPIV from the format used in DSYTRF_RK + !! (or DSYTRF_BK) into the format used in DSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -68776,19 +68772,19 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) - !> If parameter WAY = 'C': - !> DSYCONVF_ROOK: converts the factorization output format used in - !> DSYTRF_ROOK provided on entry in parameter A into the factorization - !> output format used in DSYTRF_RK (or DSYTRF_BK) that is stored - !> on exit in parameters A and E. IPIV format for DSYTRF_ROOK and - !> DSYTRF_RK (or DSYTRF_BK) is the same and is not converted. - !> If parameter WAY = 'R': - !> DSYCONVF_ROOK performs the conversion in reverse direction, i.e. - !> converts the factorization output format used in DSYTRF_RK - !> (or DSYTRF_BK) provided on entry in parameters A and E into - !> the factorization output format used in DSYTRF_ROOK that is stored - !> on exit in parameter A. IPIV format for DSYTRF_ROOK and - !> DSYTRF_RK (or DSYTRF_BK) is the same and is not converted. + !! If parameter WAY = 'C': + !! DSYCONVF_ROOK: converts the factorization output format used in + !! DSYTRF_ROOK provided on entry in parameter A into the factorization + !! output format used in DSYTRF_RK (or DSYTRF_BK) that is stored + !! on exit in parameters A and E. IPIV format for DSYTRF_ROOK and + !! DSYTRF_RK (or DSYTRF_BK) is the same and is not converted. + !! If parameter WAY = 'R': + !! DSYCONVF_ROOK performs the conversion in reverse direction, i.e. + !! converts the factorization output format used in DSYTRF_RK + !! (or DSYTRF_BK) provided on entry in parameters A and E into + !! the factorization output format used in DSYTRF_ROOK that is stored + !! on exit in parameter A. IPIV format for DSYTRF_ROOK and + !! DSYTRF_RK (or DSYTRF_BK) is the same and is not converted. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -69029,13 +69025,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsyequb( uplo, n, a, lda, s, scond, amax, work, info ) - !> DSYEQUB: computes row and column scalings intended to equilibrate a - !> symmetric 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. + !! DSYEQUB: computes row and column scalings intended to equilibrate a + !! symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -69205,8 +69201,8 @@ module stdlib_linalg_lapack_q subroutine stdlib_qsyev( jobz, uplo, n, a, lda, w, work, lwork, info ) - !> DSYEV: computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A. + !! DSYEV: computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -69312,17 +69308,17 @@ module stdlib_linalg_lapack_q subroutine stdlib_qsyevd( jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info ) - !> DSYEVD: computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric 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. - !> Because of large use of BLAS of level 3, DSYEVD needs N**2 more - !> workspace than DSYEVX. + !! DSYEVD: computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric 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. + !! Because of large use of BLAS of level 3, DSYEVD needs N**2 more + !! workspace than DSYEVX. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -69446,56 +69442,56 @@ module stdlib_linalg_lapack_q subroutine stdlib_qsyevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> DSYEVR: computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric matrix A. Eigenvalues and eigenvectors can be - !> selected by specifying either a range of values or a range of - !> indices for the desired eigenvalues. - !> DSYEVR first reduces the matrix A to tridiagonal form T with a call - !> to DSYTRD. Then, whenever possible, DSYEVR calls DSTEMR to compute - !> the eigenspectrum using Relatively Robust Representations. DSTEMR - !> 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 DSTEMR'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 : DSYEVR calls DSTEMR when the full spectrum is requested - !> on machines which conform to the ieee-754 floating point standard. - !> DSYEVR calls DSTEBZ and DSTEIN on non-ieee machines and - !> when partial spectrum requests are made. - !> Normal execution of DSTEMR 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. + !! DSYEVR: computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric matrix A. Eigenvalues and eigenvectors can be + !! selected by specifying either a range of values or a range of + !! indices for the desired eigenvalues. + !! DSYEVR first reduces the matrix A to tridiagonal form T with a call + !! to DSYTRD. Then, whenever possible, DSYEVR calls DSTEMR to compute + !! the eigenspectrum using Relatively Robust Representations. DSTEMR + !! 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 DSTEMR'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 : DSYEVR calls DSTEMR when the full spectrum is requested + !! on machines which conform to the ieee-754 floating point standard. + !! DSYEVR calls DSTEBZ and DSTEIN on non-ieee machines and + !! when partial spectrum requests are made. + !! Normal execution of DSTEMR 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. isuppz, work, lwork,iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69768,10 +69764,10 @@ module stdlib_linalg_lapack_q subroutine stdlib_qsyevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> DSYEVX: computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric matrix A. Eigenvalues and eigenvectors can be - !> selected by specifying either a range of values or a range of indices - !> for the desired eigenvalues. + !! DSYEVX: computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric matrix A. Eigenvalues and eigenvectors can be + !! selected by specifying either a range of values or a range of indices + !! for the desired eigenvalues. work, lwork, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70015,13 +70011,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsygs2( itype, uplo, n, a, lda, b, ldb, info ) - !> DSYGS2: reduces a real symmetric-definite generalized eigenproblem - !> to standard form. - !> If ITYPE = 1, the problem is A*x = lambda*B*x, - !> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) - !> 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**T or L**T *A*L. - !> B must have been previously factorized as U**T *U or L*L**T by DPOTRF. + !! DSYGS2: reduces a real symmetric-definite generalized eigenproblem + !! to standard form. + !! If ITYPE = 1, the problem is A*x = lambda*B*x, + !! and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) + !! 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**T or L**T *A*L. + !! B must have been previously factorized as U**T *U or L*L**T by DPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -70138,13 +70134,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsygst( itype, uplo, n, a, lda, b, ldb, info ) - !> DSYGST: reduces a real symmetric-definite generalized eigenproblem - !> to standard form. - !> If ITYPE = 1, the problem is A*x = lambda*B*x, - !> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) - !> 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**T or L**T*A*L. - !> B must have been previously factorized as U**T*U or L*L**T by DPOTRF. + !! DSYGST: reduces a real symmetric-definite generalized eigenproblem + !! to standard form. + !! If ITYPE = 1, the problem is A*x = lambda*B*x, + !! and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) + !! 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**T or L**T*A*L. + !! B must have been previously factorized as U**T*U or L*L**T by DPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -70277,11 +70273,11 @@ module stdlib_linalg_lapack_q subroutine stdlib_qsygv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, info ) - !> DSYGV: computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric and B is also - !> positive definite. + !! DSYGV: computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric and B is also + !! positive definite. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -70377,17 +70373,17 @@ module stdlib_linalg_lapack_q subroutine stdlib_qsygvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, iwork, liwork,& - !> DSYGVD: computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric 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. + !! DSYGVD: computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70498,12 +70494,12 @@ module stdlib_linalg_lapack_q subroutine stdlib_qsygvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& - !> DSYGVX: computes selected eigenvalues, and optionally, eigenvectors - !> of a real generalized symmetric-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 symmetric and B is also positive definite. - !> Eigenvalues and eigenvectors can be selected by specifying either a - !> range of values or a range of indices for the desired eigenvalues. + !! DSYGVX: computes selected eigenvalues, and optionally, eigenvectors + !! of a real generalized symmetric-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 symmetric and B is also positive definite. + !! Eigenvalues and eigenvectors can be selected by specifying either a + !! range of values or a range of indices for the desired eigenvalues. m, w, z, ldz, work,lwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70626,9 +70622,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & - !> DSYRFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite, and - !> provides error bounds and backward error estimates for the solution. + !! DSYRFS: improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric indefinite, and + !! provides error bounds and backward error estimates for the solution. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70815,17 +70811,17 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> DSYSV: computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> The 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 symmetric 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. + !! DSYSV: computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! The 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 symmetric 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -70893,16 +70889,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> DSYSV computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> Aasen's algorithm is used to factor A as - !> A = U**T * T * U, if UPLO = 'U', or - !> A = L * T * L**T, if UPLO = 'L', - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and T is symmetric tridiagonal. The factored - !> form of A is then used to solve the system of equations A * X = B. + !! DSYSV computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! Aasen's algorithm is used to factor A as + !! A = U**T * T * U, if UPLO = 'U', or + !! A = L * T * L**T, if UPLO = 'L', + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and T is symmetric tridiagonal. The factored + !! form of A is then used to solve the system of equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70965,20 +70961,20 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,work, lwork, info ) - !> DSYSV_RK: computes the solution to a real system of linear - !> equations A * X = B, where A is an N-by-N symmetric 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**T)*(P**T), if UPLO = 'U', or - !> A = P*L*D*(L**T)*(P**T), if UPLO = 'L', - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric and block - !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. - !> DSYTRF_RK is called to compute the factorization of a real - !> symmetric matrix. The factored form of A is then used to solve - !> the system of equations A * X = B by calling BLAS3 routine DSYTRS_3. + !! DSYSV_RK: computes the solution to a real system of linear + !! equations A * X = B, where A is an N-by-N symmetric 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**T)*(P**T), if UPLO = 'U', or + !! A = P*L*D*(L**T)*(P**T), if UPLO = 'L', + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric and block + !! diagonal with 1-by-1 and 2-by-2 diagonal blocks. + !! DSYTRF_RK is called to compute the factorization of a real + !! symmetric matrix. The factored form of A is then used to solve + !! the system of equations A * X = B by calling BLAS3 routine DSYTRS_3. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71042,22 +71038,22 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> DSYSV_ROOK: computes the solution to a real system of linear - !> equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> The 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 symmetric and block diagonal with - !> 1-by-1 and 2-by-2 diagonal blocks. - !> DSYTRF_ROOK is called to compute the factorization of a real - !> symmetric 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 DSYTRS_ROOK. + !! DSYSV_ROOK: computes the solution to a real system of linear + !! equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! The 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 symmetric and block diagonal with + !! 1-by-1 and 2-by-2 diagonal blocks. + !! DSYTRF_ROOK is called to compute the factorization of a real + !! symmetric 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 DSYTRS_ROOK. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71121,12 +71117,12 @@ module stdlib_linalg_lapack_q subroutine stdlib_qsysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & - !> DSYSVX: uses the diagonal pivoting factorization to compute the - !> solution to a real system of linear equations A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! DSYSVX: uses the diagonal pivoting factorization to compute the + !! solution to a real system of linear equations A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ferr, berr, work, lwork,iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71218,8 +71214,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsyswapr( uplo, n, a, lda, i1, i2) - !> DSYSWAPR: applies an elementary permutation on the rows and the columns of - !> a symmetric matrix. + !! DSYSWAPR: applies an elementary permutation on the rows and the columns of + !! a symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -71286,8 +71282,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytd2( uplo, n, a, lda, d, e, tau, info ) - !> DSYTD2: reduces a real symmetric matrix A to symmetric tridiagonal - !> form T by an orthogonal similarity transformation: Q**T * A * Q = T. + !! DSYTD2: reduces a real symmetric matrix A to symmetric tridiagonal + !! form T by an orthogonal similarity transformation: Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -71380,13 +71376,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytf2( uplo, n, a, lda, ipiv, info ) - !> DSYTF2: computes the factorization of a real symmetric matrix A using - !> the Bunch-Kaufman diagonal pivoting method: - !> 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, U**T is the transpose of U, and D is symmetric 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. + !! DSYTF2: computes the factorization of a real symmetric matrix A using + !! the Bunch-Kaufman diagonal pivoting method: + !! 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, U**T is the transpose of U, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -71665,15 +71661,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytf2_rk( uplo, n, a, lda, e, ipiv, info ) - !> DSYTF2_RK: computes the factorization of a real symmetric matrix A - !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric 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. + !! DSYTF2_RK: computes the factorization of a real symmetric matrix A + !! using the bounded Bunch-Kaufman (rook) diagonal pivoting method: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72117,13 +72113,13 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytf2_rook( uplo, n, a, lda, ipiv, info ) - !> DSYTF2_ROOK: computes the factorization of a real symmetric matrix A - !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: - !> 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, U**T is the transpose of U, and D is symmetric 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. + !! DSYTF2_ROOK: computes the factorization of a real symmetric matrix A + !! using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: + !! 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, U**T is the transpose of U, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72528,9 +72524,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) - !> DSYTRD: reduces a real symmetric matrix A to real symmetric - !> tridiagonal form T by an orthogonal similarity transformation: - !> Q**T * A * Q = T. + !! DSYTRD: reduces a real symmetric matrix A to real symmetric + !! tridiagonal form T by an orthogonal similarity transformation: + !! Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72654,9 +72650,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & - !> DSYTRD_SB2ST: reduces a real symmetric band matrix A to real symmetric - !> tridiagonal form T by a orthogonal similarity transformation: - !> Q**T * A * Q = T. + !! DSYTRD_SB2ST: reduces a real symmetric band matrix A to real symmetric + !! tridiagonal form T by a orthogonal similarity transformation: + !! Q**T * A * Q = T. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72900,9 +72896,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) - !> DSYTRD_SY2SB: reduces a real symmetric matrix A to real symmetric - !> band-diagonal form AB by a orthogonal similarity transformation: - !> Q**T * A * Q = AB. + !! DSYTRD_SY2SB: reduces a real symmetric matrix A to real symmetric + !! band-diagonal form AB by a orthogonal similarity transformation: + !! Q**T * A * Q = AB. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73076,14 +73072,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytrf( uplo, n, a, lda, ipiv, work, lwork, info ) - !> DSYTRF: computes the factorization of a real symmetric matrix A using - !> the Bunch-Kaufman diagonal pivoting method. The form of the - !> factorization is - !> A = U**T*D*U or A = L*D*L**T - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and D is symmetric 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. + !! DSYTRF: computes the factorization of a real symmetric matrix A using + !! the Bunch-Kaufman diagonal pivoting method. The form of the + !! factorization is + !! A = U**T*D*U or A = L*D*L**T + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73202,12 +73198,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) - !> DSYTRF_AA: computes the factorization of a real symmetric matrix A - !> using the Aasen's algorithm. The form of the factorization is - !> A = U**T*T*U or A = L*T*L**T - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and T is a symmetric tridiagonal matrix. - !> This is the blocked version of the algorithm, calling Level 3 BLAS. + !! DSYTRF_AA: computes the factorization of a real symmetric matrix A + !! using the Aasen's algorithm. The form of the factorization is + !! A = U**T*T*U or A = L*T*L**T + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and T is a symmetric tridiagonal matrix. + !! This is the blocked version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73426,15 +73422,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) - !> DSYTRF_RK: computes the factorization of a real symmetric matrix A - !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric 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. + !! DSYTRF_RK: computes the factorization of a real symmetric matrix A + !! using the bounded Bunch-Kaufman (rook) diagonal pivoting method: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73592,14 +73588,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) - !> DSYTRF_ROOK: computes the factorization of a real symmetric 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 symmetric 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. + !! DSYTRF_ROOK: computes the factorization of a real symmetric 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 symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73720,9 +73716,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytri( uplo, n, a, lda, ipiv, work, info ) - !> DSYTRI: computes the inverse of a real symmetric indefinite matrix - !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by - !> DSYTRF. + !! DSYTRI: computes the inverse of a real symmetric indefinite matrix + !! A using the factorization A = U*D*U**T or A = L*D*L**T computed by + !! DSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73908,9 +73904,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytri_rook( uplo, n, a, lda, ipiv, work, info ) - !> DSYTRI_ROOK: computes the inverse of a real symmetric - !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T - !> computed by DSYTRF_ROOK. + !! DSYTRI_ROOK: computes the inverse of a real symmetric + !! matrix A using the factorization A = U*D*U**T or A = L*D*L**T + !! computed by DSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -74136,9 +74132,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) - !> DSYTRS: solves a system of linear equations A*X = B with a real - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by DSYTRF. + !! DSYTRS: solves a system of linear equations A*X = B with a real + !! symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by DSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -74346,9 +74342,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) - !> DSYTRS2: solves a system of linear equations A*X = B with a real - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by DSYTRF and converted by DSYCONV. + !! DSYTRS2: solves a system of linear equations A*X = B with a real + !! symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by DSYTRF and converted by DSYCONV. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -74524,15 +74520,15 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) - !> DSYTRS_3: solves a system of linear equations A * X = B with a real - !> symmetric matrix A using the factorization computed - !> by DSYTRF_RK or DSYTRF_BK: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric and block - !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. - !> This algorithm is using Level 3 BLAS. + !! DSYTRS_3: solves a system of linear equations A * X = B with a real + !! symmetric matrix A using the factorization computed + !! by DSYTRF_RK or DSYTRF_BK: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric and block + !! diagonal with 1-by-1 and 2-by-2 diagonal blocks. + !! This algorithm is using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -74681,9 +74677,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) - !> DSYTRS_AA: solves a system of linear equations A*X = B with a real - !> symmetric matrix A using the factorization A = U**T*T*U or - !> A = L*T*L**T computed by DSYTRF_AA. + !! DSYTRS_AA: solves a system of linear equations A*X = B with a real + !! symmetric matrix A using the factorization A = U**T*T*U or + !! A = L*T*L**T computed by DSYTRF_AA. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74800,9 +74796,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qsytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) - !> DSYTRS_ROOK: solves a system of linear equations A*X = B with - !> a real symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by DSYTRF_ROOK. + !! DSYTRS_ROOK: solves a system of linear equations A*X = B with + !! a real symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by DSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -75022,12 +75018,12 @@ module stdlib_linalg_lapack_q subroutine stdlib_qtbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,iwork, info ) - !> DTBCON: estimates the reciprocal of the condition number of a - !> triangular band matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! DTBCON: estimates the reciprocal of the condition number of a + !! triangular band matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75126,12 +75122,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& - !> DTBRFS: provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular band - !> coefficient matrix. - !> The solution matrix X must be computed by DTBTRS or some other - !> means before entering this routine. DTBRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! DTBRFS: provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular band + !! coefficient matrix. + !! The solution matrix X must be computed by DTBTRS or some other + !! means before entering this routine. DTBRFS does not do iterative + !! refinement because doing so cannot improve the backward error. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75364,10 +75360,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) - !> DTBTRS: solves a triangular system of the form - !> A * X = B or A**T * X = B, - !> where A is a triangular band matrix of order N, and B is an - !> N-by NRHS matrix. A check is made to verify that A is nonsingular. + !! DTBTRS: solves a triangular system of the form + !! A * X = B or A**T * X = B, + !! where A is a triangular band matrix of order N, and B is an + !! N-by NRHS matrix. A check is made to verify that A is nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75437,14 +75433,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) - !> Level 3 BLAS like routine for A in RFP Format. - !> DTFSM: solves the matrix equation - !> op( A )*X = alpha*B or X*op( A ) = alpha*B - !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T. - !> A is in Rectangular Full Packed (RFP) Format. - !> The matrix X is overwritten on B. + !! Level 3 BLAS like routine for A in RFP Format. + !! DTFSM: solves the matrix equation + !! op( A )*X = alpha*B or X*op( A ) = alpha*B + !! where alpha is a scalar, X and B are m by n matrices, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T. + !! A is in Rectangular Full Packed (RFP) Format. + !! The matrix X is overwritten on B. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75939,9 +75935,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtftri( transr, uplo, diag, n, a, info ) - !> DTFTRI: computes the inverse of a triangular matrix A stored in RFP - !> format. - !> This is a Level 3 BLAS version of the algorithm. + !! DTFTRI: computes the inverse of a triangular matrix A stored in RFP + !! format. + !! This is a Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -76122,8 +76118,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtfttp( transr, uplo, n, arf, ap, info ) - !> DTFTTP: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard packed format (TP). + !! DTFTTP: copies a triangular matrix A from rectangular full packed + !! format (TF) to standard packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -76378,8 +76374,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtfttr( transr, uplo, n, arf, a, lda, info ) - !> DTFTTR: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard full format (TR). + !! DTFTTR: copies a triangular matrix A from rectangular full packed + !! format (TF) to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -76607,24 +76603,24 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & - !> DTGEVC: computes some or all of the right and/or left eigenvectors of - !> a pair of real matrices (S,P), where S is a quasi-triangular matrix - !> and P is upper triangular. Matrix pairs of this type are produced by - !> the generalized Schur factorization of a matrix pair (A,B): - !> A = Q*S*Z**T, B = Q*P*Z**T - !> as computed by DGGHRD + DHGEQZ. - !> The right eigenvector x and the left eigenvector y of (S,P) - !> corresponding to an eigenvalue w are defined by: - !> S*x = w*P*x, (y**H)*S = w*(y**H)*P, - !> where y**H denotes the conjugate tranpose of y. - !> The eigenvalues are not input to this routine, but are computed - !> directly from the diagonal blocks of S and P. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of (S,P), or the products Z*X and/or Q*Y, - !> where Z and Q are input matrices. - !> If Q and Z are the orthogonal factors from the generalized Schur - !> factorization of a matrix pair (A,B), then Z*X and Q*Y - !> are the matrices of right and left eigenvectors of (A,B). + !! DTGEVC: computes some or all of the right and/or left eigenvectors of + !! a pair of real matrices (S,P), where S is a quasi-triangular matrix + !! and P is upper triangular. Matrix pairs of this type are produced by + !! the generalized Schur factorization of a matrix pair (A,B): + !! A = Q*S*Z**T, B = Q*P*Z**T + !! as computed by DGGHRD + DHGEQZ. + !! The right eigenvector x and the left eigenvector y of (S,P) + !! corresponding to an eigenvalue w are defined by: + !! S*x = w*P*x, (y**H)*S = w*(y**H)*P, + !! where y**H denotes the conjugate tranpose of y. + !! The eigenvalues are not input to this routine, but are computed + !! directly from the diagonal blocks of S and P. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of (S,P), or the products Z*X and/or Q*Y, + !! where Z and Q are input matrices. + !! If Q and Z are the orthogonal factors from the generalized Schur + !! factorization of a matrix pair (A,B), then Z*X and Q*Y + !! are the matrices of right and left eigenvectors of (A,B). mm, m, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77337,16 +77333,16 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, n1, n2, & - !> DTGEX2: swaps adjacent diagonal blocks (A11, B11) and (A22, B22) - !> of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair - !> (A, B) by an orthogonal equivalence transformation. - !> (A, B) must be in generalized real Schur canonical form (as returned - !> by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2 - !> diagonal blocks. B is upper triangular. - !> Optionally, the matrices Q and Z of generalized Schur vectors are - !> updated. - !> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T - !> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T + !! DTGEX2: swaps adjacent diagonal blocks (A11, B11) and (A22, B22) + !! of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair + !! (A, B) by an orthogonal equivalence transformation. + !! (A, B) must be in generalized real Schur canonical form (as returned + !! by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2 + !! diagonal blocks. B is upper triangular. + !! Optionally, the matrices Q and Z of generalized Schur vectors are + !! updated. + !! Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T + !! Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T work, lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77702,18 +77698,18 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & - !> DTGEXC: reorders the generalized real Schur decomposition of a real - !> matrix pair (A,B) using an orthogonal equivalence transformation - !> (A, B) = Q * (A, B) * Z**T, - !> so that the diagonal block of (A, B) with row index IFST is moved - !> to row ILST. - !> (A, B) must be in generalized real Schur canonical form (as returned - !> by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2 - !> diagonal blocks. B is upper triangular. - !> Optionally, the matrices Q and Z of generalized Schur vectors are - !> updated. - !> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T - !> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T + !! DTGEXC: reorders the generalized real Schur decomposition of a real + !! matrix pair (A,B) using an orthogonal equivalence transformation + !! (A, B) = Q * (A, B) * Z**T, + !! so that the diagonal block of (A, B) with row index IFST is moved + !! to row ILST. + !! (A, B) must be in generalized real Schur canonical form (as returned + !! by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2 + !! diagonal blocks. B is upper triangular. + !! Optionally, the matrices Q and Z of generalized Schur vectors are + !! updated. + !! Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T + !! Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77951,26 +77947,26 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alphar, alphai, & - !> DTGSEN: reorders the generalized real Schur decomposition of a real - !> matrix pair (A, B) (in terms of an orthonormal equivalence trans- - !> formation Q**T * (A, B) * Z), so that a selected cluster of eigenvalues - !> appears in the leading diagonal blocks of the upper quasi-triangular - !> matrix A and the upper triangular B. The leading columns of Q and - !> Z form orthonormal bases of the corresponding left and right eigen- - !> spaces (deflating subspaces). (A, B) must be in generalized real - !> Schur canonical form (as returned by DGGES), i.e. A is block upper - !> triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper - !> triangular. - !> DTGSEN also computes the generalized eigenvalues - !> w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j) - !> of the reordered matrix pair (A, B). - !> Optionally, DTGSEN computes the estimates of reciprocal condition - !> numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11), - !> (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s) - !> between the matrix pairs (A11, B11) and (A22,B22) that correspond to - !> the selected cluster and the eigenvalues outside the cluster, resp., - !> and norms of "projections" onto left and right eigenspaces w.r.t. - !> the selected cluster in the (1,1)-block. + !! DTGSEN: reorders the generalized real Schur decomposition of a real + !! matrix pair (A, B) (in terms of an orthonormal equivalence trans- + !! formation Q**T * (A, B) * Z), so that a selected cluster of eigenvalues + !! appears in the leading diagonal blocks of the upper quasi-triangular + !! matrix A and the upper triangular B. The leading columns of Q and + !! Z form orthonormal bases of the corresponding left and right eigen- + !! spaces (deflating subspaces). (A, B) must be in generalized real + !! Schur canonical form (as returned by DGGES), i.e. A is block upper + !! triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper + !! triangular. + !! DTGSEN also computes the generalized eigenvalues + !! w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j) + !! of the reordered matrix pair (A, B). + !! Optionally, DTGSEN computes the estimates of reciprocal condition + !! numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11), + !! (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s) + !! between the matrix pairs (A11, B11) and (A22,B22) that correspond to + !! the selected cluster and the eigenvalues outside the cluster, resp., + !! and norms of "projections" onto left and right eigenspaces w.r.t. + !! the selected cluster in the (1,1)-block. beta, q, ldq, z, ldz, m, pl,pr, dif, work, lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78277,67 +78273,67 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & - !> DTGSJA: computes the generalized singular value decomposition (GSVD) - !> of two real upper triangular (or trapezoidal) matrices A and B. - !> On entry, it is assumed that matrices A and B have the following - !> forms, which may be obtained by the preprocessing subroutine DGGSVP - !> from a general M-by-N matrix A and P-by-N matrix B: - !> N-K-L K L - !> A = K ( 0 A12 A13 ) if M-K-L >= 0; - !> L ( 0 0 A23 ) - !> M-K-L ( 0 0 0 ) - !> N-K-L K L - !> A = K ( 0 A12 A13 ) if M-K-L < 0; - !> M-K ( 0 0 A23 ) - !> N-K-L K L - !> B = L ( 0 0 B13 ) - !> P-L ( 0 0 0 ) - !> where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular - !> upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, - !> otherwise A23 is (M-K)-by-L upper trapezoidal. - !> On exit, - !> U**T *A*Q = D1*( 0 R ), V**T *B*Q = D2*( 0 R ), - !> where U, V and Q are orthogonal matrices. - !> R is a nonsingular upper triangular matrix, and D1 and D2 are - !> ``diagonal'' matrices, which are of the following structures: - !> If M-K-L >= 0, - !> K L - !> D1 = K ( I 0 ) - !> L ( 0 C ) - !> M-K-L ( 0 0 ) - !> K L - !> D2 = L ( 0 S ) - !> P-L ( 0 0 ) - !> N-K-L K L - !> ( 0 R ) = K ( 0 R11 R12 ) K - !> L ( 0 0 R22 ) L - !> where - !> C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), - !> S = diag( BETA(K+1), ... , BETA(K+L) ), - !> C**2 + S**2 = I. - !> R is stored in A(1:K+L,N-K-L+1:N) on exit. - !> If M-K-L < 0, - !> K M-K K+L-M - !> D1 = K ( I 0 0 ) - !> M-K ( 0 C 0 ) - !> K M-K K+L-M - !> D2 = M-K ( 0 S 0 ) - !> K+L-M ( 0 0 I ) - !> P-L ( 0 0 0 ) - !> N-K-L K M-K K+L-M - !> ( 0 R ) = K ( 0 R11 R12 R13 ) - !> M-K ( 0 0 R22 R23 ) - !> K+L-M ( 0 0 0 R33 ) - !> where - !> C = diag( ALPHA(K+1), ... , ALPHA(M) ), - !> S = diag( BETA(K+1), ... , BETA(M) ), - !> C**2 + S**2 = I. - !> R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored - !> ( 0 R22 R23 ) - !> in B(M-K+1:L,N+M-K-L+1:N) on exit. - !> The computation of the orthogonal transformation matrices U, V or Q - !> is optional. These matrices may either be formed explicitly, or they - !> may be postmultiplied into input matrices U1, V1, or Q1. + !! DTGSJA: computes the generalized singular value decomposition (GSVD) + !! of two real upper triangular (or trapezoidal) matrices A and B. + !! On entry, it is assumed that matrices A and B have the following + !! forms, which may be obtained by the preprocessing subroutine DGGSVP + !! from a general M-by-N matrix A and P-by-N matrix B: + !! N-K-L K L + !! A = K ( 0 A12 A13 ) if M-K-L >= 0; + !! L ( 0 0 A23 ) + !! M-K-L ( 0 0 0 ) + !! N-K-L K L + !! A = K ( 0 A12 A13 ) if M-K-L < 0; + !! M-K ( 0 0 A23 ) + !! N-K-L K L + !! B = L ( 0 0 B13 ) + !! P-L ( 0 0 0 ) + !! where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular + !! upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, + !! otherwise A23 is (M-K)-by-L upper trapezoidal. + !! On exit, + !! U**T *A*Q = D1*( 0 R ), V**T *B*Q = D2*( 0 R ), + !! where U, V and Q are orthogonal matrices. + !! R is a nonsingular upper triangular matrix, and D1 and D2 are + !! ``diagonal'' matrices, which are of the following structures: + !! If M-K-L >= 0, + !! K L + !! D1 = K ( I 0 ) + !! L ( 0 C ) + !! M-K-L ( 0 0 ) + !! K L + !! D2 = L ( 0 S ) + !! P-L ( 0 0 ) + !! N-K-L K L + !! ( 0 R ) = K ( 0 R11 R12 ) K + !! L ( 0 0 R22 ) L + !! where + !! C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), + !! S = diag( BETA(K+1), ... , BETA(K+L) ), + !! C**2 + S**2 = I. + !! R is stored in A(1:K+L,N-K-L+1:N) on exit. + !! If M-K-L < 0, + !! K M-K K+L-M + !! D1 = K ( I 0 0 ) + !! M-K ( 0 C 0 ) + !! K M-K K+L-M + !! D2 = M-K ( 0 S 0 ) + !! K+L-M ( 0 0 I ) + !! P-L ( 0 0 0 ) + !! N-K-L K M-K K+L-M + !! ( 0 R ) = K ( 0 R11 R12 R13 ) + !! M-K ( 0 0 R22 R23 ) + !! K+L-M ( 0 0 0 R33 ) + !! where + !! C = diag( ALPHA(K+1), ... , ALPHA(M) ), + !! S = diag( BETA(K+1), ... , BETA(M) ), + !! C**2 + S**2 = I. + !! R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored + !! ( 0 R22 R23 ) + !! in B(M-K+1:L,N+M-K-L+1:N) on exit. + !! The computation of the orthogonal transformation matrices U, V or Q + !! is optional. These matrices may either be formed explicitly, or they + !! may be postmultiplied into input matrices U1, V1, or Q1. alpha, beta, u, ldu, v, ldv,q, ldq, work, ncycle, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78518,14 +78514,14 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & - !> DTGSNA: estimates reciprocal condition numbers for specified - !> eigenvalues and/or eigenvectors of a matrix pair (A, B) in - !> generalized real Schur canonical form (or of any matrix pair - !> (Q*A*Z**T, Q*B*Z**T) with orthogonal matrices Q and Z, where - !> Z**T denotes the transpose of Z. - !> (A, B) must be in generalized real Schur form (as returned by DGGES), - !> i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal - !> blocks. B is upper triangular. + !! DTGSNA: estimates reciprocal condition numbers for specified + !! eigenvalues and/or eigenvectors of a matrix pair (A, B) in + !! generalized real Schur canonical form (or of any matrix pair + !! (Q*A*Z**T, Q*B*Z**T) with orthogonal matrices Q and Z, where + !! Z**T denotes the transpose of Z. + !! (A, B) must be in generalized real Schur form (as returned by DGGES), + !! i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal + !! blocks. B is upper triangular. dif, mm, m, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78766,34 +78762,34 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & - !> DTGSY2: solves the generalized Sylvester equation: - !> A * R - L * B = scale * C (1) - !> D * R - L * E = scale * F, - !> using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices, - !> (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M, - !> N-by-N and M-by-N, respectively, with real entries. (A, D) and (B, E) - !> must be in generalized Schur canonical form, i.e. A, B are upper - !> quasi triangular and D, E are upper triangular. The solution (R, L) - !> overwrites (C, F). 0 <= SCALE <= 1 is an output scaling factor - !> chosen to avoid overflow. - !> In matrix notation solving equation (1) corresponds to solve - !> Z*x = scale*b, where Z is defined as - !> Z = [ kron(In, A) -kron(B**T, Im) ] (2) - !> [ kron(In, D) -kron(E**T, Im) ], - !> Ik is the identity matrix of size k and X**T is the transpose of X. - !> kron(X, Y) is the Kronecker product between the matrices X and Y. - !> In the process of solving (1), we solve a number of such systems - !> where Dim(In), Dim(In) = 1 or 2. - !> If TRANS = 'T', solve the transposed system Z**T*y = scale*b for y, - !> which is equivalent to solve for R and L in - !> A**T * R + D**T * L = scale * C (3) - !> R * B**T + L * E**T = scale * -F - !> This case is used to compute an estimate of Dif[(A, D), (B, E)] = - !> sigma_min(Z) using reverse communication with DLACON. - !> DTGSY2 also (IJOB >= 1) contributes to the computation in DTGSYL - !> of an upper bound on the separation between to matrix pairs. Then - !> the input (A, D), (B, E) are sub-pencils of the matrix pair in - !> DTGSYL. See DTGSYL for details. + !! DTGSY2: solves the generalized Sylvester equation: + !! A * R - L * B = scale * C (1) + !! D * R - L * E = scale * F, + !! using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices, + !! (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M, + !! N-by-N and M-by-N, respectively, with real entries. (A, D) and (B, E) + !! must be in generalized Schur canonical form, i.e. A, B are upper + !! quasi triangular and D, E are upper triangular. The solution (R, L) + !! overwrites (C, F). 0 <= SCALE <= 1 is an output scaling factor + !! chosen to avoid overflow. + !! In matrix notation solving equation (1) corresponds to solve + !! Z*x = scale*b, where Z is defined as + !! Z = [ kron(In, A) -kron(B**T, Im) ] (2) + !! [ kron(In, D) -kron(E**T, Im) ], + !! Ik is the identity matrix of size k and X**T is the transpose of X. + !! kron(X, Y) is the Kronecker product between the matrices X and Y. + !! In the process of solving (1), we solve a number of such systems + !! where Dim(In), Dim(In) = 1 or 2. + !! If TRANS = 'T', solve the transposed system Z**T*y = scale*b for y, + !! which is equivalent to solve for R and L in + !! A**T * R + D**T * L = scale * C (3) + !! R * B**T + L * E**T = scale * -F + !! This case is used to compute an estimate of Dif[(A, D), (B, E)] = + !! sigma_min(Z) using reverse communication with DLACON. + !! DTGSY2 also (IJOB >= 1) contributes to the computation in DTGSYL + !! of an upper bound on the separation between to matrix pairs. Then + !! the input (A, D), (B, E) are sub-pencils of the matrix pair in + !! DTGSYL. See DTGSYL for details. ldf, scale, rdsum, rdscal,iwork, pq, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79406,34 +79402,34 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & - !> DTGSYL: solves the generalized Sylvester equation: - !> A * R - L * B = scale * C (1) - !> D * R - L * E = scale * F - !> where R and L are unknown m-by-n matrices, (A, D), (B, E) and - !> (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n, - !> respectively, with real entries. (A, D) and (B, E) must be in - !> generalized (real) Schur canonical form, i.e. A, B are upper quasi - !> triangular and D, E are upper triangular. - !> The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output - !> scaling factor chosen to avoid overflow. - !> In matrix notation (1) is equivalent to solve Zx = scale b, where - !> Z is defined as - !> Z = [ kron(In, A) -kron(B**T, Im) ] (2) - !> [ kron(In, D) -kron(E**T, Im) ]. - !> Here Ik is the identity matrix of size k and X**T is the transpose of - !> X. kron(X, Y) is the Kronecker product between the matrices X and Y. - !> If TRANS = 'T', DTGSYL solves the transposed system Z**T*y = scale*b, - !> which is equivalent to solve for R and L in - !> A**T * R + D**T * L = scale * C (3) - !> R * B**T + L * E**T = scale * -F - !> This case (TRANS = 'T') is used to compute an one-norm-based estimate - !> of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D) - !> and (B,E), using DLACON. - !> If IJOB >= 1, DTGSYL computes a Frobenius norm-based estimate - !> of Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the - !> reciprocal of the smallest singular value of Z. See [1-2] for more - !> information. - !> This is a level 3 BLAS algorithm. + !! DTGSYL: solves the generalized Sylvester equation: + !! A * R - L * B = scale * C (1) + !! D * R - L * E = scale * F + !! where R and L are unknown m-by-n matrices, (A, D), (B, E) and + !! (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n, + !! respectively, with real entries. (A, D) and (B, E) must be in + !! generalized (real) Schur canonical form, i.e. A, B are upper quasi + !! triangular and D, E are upper triangular. + !! The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output + !! scaling factor chosen to avoid overflow. + !! In matrix notation (1) is equivalent to solve Zx = scale b, where + !! Z is defined as + !! Z = [ kron(In, A) -kron(B**T, Im) ] (2) + !! [ kron(In, D) -kron(E**T, Im) ]. + !! Here Ik is the identity matrix of size k and X**T is the transpose of + !! X. kron(X, Y) is the Kronecker product between the matrices X and Y. + !! If TRANS = 'T', DTGSYL solves the transposed system Z**T*y = scale*b, + !! which is equivalent to solve for R and L in + !! A**T * R + D**T * L = scale * C (3) + !! R * B**T + L * E**T = scale * -F + !! This case (TRANS = 'T') is used to compute an one-norm-based estimate + !! of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D) + !! and (B,E), using DLACON. + !! If IJOB >= 1, DTGSYL computes a Frobenius norm-based estimate + !! of Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the + !! reciprocal of the smallest singular value of Z. See [1-2] for more + !! information. + !! This is a level 3 BLAS algorithm. ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79735,12 +79731,12 @@ module stdlib_linalg_lapack_q subroutine stdlib_qtpcon( norm, uplo, diag, n, ap, rcond, work, iwork,info ) - !> DTPCON: estimates the reciprocal of the condition number of a packed - !> triangular matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! DTPCON: estimates the reciprocal of the condition number of a packed + !! triangular matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79834,10 +79830,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) - !> DTPLQT: computes a blocked LQ factorization of a real - !> "triangular-pentagonal" matrix C, which is composed of a - !> triangular block A and pentagonal block B, using the compact - !> WY representation for Q. + !! DTPLQT: computes a blocked LQ factorization of a real + !! "triangular-pentagonal" matrix C, which is composed of a + !! triangular block A and pentagonal block B, using the compact + !! WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79896,9 +79892,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) - !> DTPLQT2: computes a LQ a factorization of a real "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. + !! DTPLQT2: computes a LQ a factorization of a real "triangular-pentagonal" + !! matrix C, which is composed of a triangular block A and pentagonal block B, + !! using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79993,9 +79989,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, ldb, & - !> DTPMQRT applies a real orthogonal matrix Q obtained from a - !> "triangular-pentagonal" real block reflector H to a general - !> real matrix C, which consists of two blocks A and B. + !! DTPMQRT applies a real orthogonal matrix Q obtained from a + !! "triangular-pentagonal" real block reflector H to a general + !! real matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80111,9 +80107,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, ldb, & - !> DTPMQRT: applies a real orthogonal matrix Q obtained from a - !> "triangular-pentagonal" real block reflector H to a general - !> real matrix C, which consists of two blocks A and B. + !! DTPMQRT: applies a real orthogonal matrix Q obtained from a + !! "triangular-pentagonal" real block reflector H to a general + !! real matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80231,10 +80227,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) - !> DTPQRT: computes a blocked QR factorization of a real - !> "triangular-pentagonal" matrix C, which is composed of a - !> triangular block A and pentagonal block B, using the compact - !> WY representation for Q. + !! DTPQRT: computes a blocked QR factorization of a real + !! "triangular-pentagonal" matrix C, which is composed of a + !! triangular block A and pentagonal block B, using the compact + !! WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -80293,9 +80289,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) - !> DTPQRT2: computes a QR factorization of a real "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. + !! DTPQRT2: computes a QR factorization of a real "triangular-pentagonal" + !! matrix C, which is composed of a triangular block A and pentagonal block B, + !! using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -80384,9 +80380,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & - !> DTPRFB: applies a real "triangular-pentagonal" block reflector H or its - !> transpose H**T to a real matrix C, which is composed of two - !> blocks A and B, either from the left or right. + !! DTPRFB: applies a real "triangular-pentagonal" block reflector H or its + !! transpose H**T to a real matrix C, which is composed of two + !! blocks A and B, either from the left or right. lda, b, ldb, work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80802,12 +80798,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & - !> DTPRFS: provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular packed - !> coefficient matrix. - !> The solution matrix X must be computed by DTPTRS or some other - !> means before entering this routine. DTPRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! DTPRFS: provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular packed + !! coefficient matrix. + !! The solution matrix X must be computed by DTPTRS or some other + !! means before entering this routine. DTPRFS does not do iterative + !! refinement because doing so cannot improve the backward error. work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -81047,8 +81043,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtptri( uplo, diag, n, ap, info ) - !> DTPTRI: computes the inverse of a real upper or lower triangular - !> matrix A stored in packed format. + !! DTPTRI: computes the inverse of a real upper or lower triangular + !! matrix A stored in packed format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -81137,11 +81133,11 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) - !> DTPTRS: solves a triangular system of the form - !> A * X = B or A**T * X = B, - !> where A is a triangular matrix of order N stored in packed format, - !> and B is an N-by-NRHS matrix. A check is made to verify that A is - !> nonsingular. + !! DTPTRS: solves a triangular system of the form + !! A * X = B or A**T * X = B, + !! where A is a triangular matrix of order N stored in packed format, + !! and B is an N-by-NRHS matrix. A check is made to verify that A is + !! nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -81210,8 +81206,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtpttf( transr, uplo, n, ap, arf, info ) - !> DTPTTF: copies a triangular matrix A from standard packed format (TP) - !> to rectangular full packed format (TF). + !! DTPTTF: copies a triangular matrix A from standard packed format (TP) + !! to rectangular full packed format (TF). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -81452,8 +81448,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtpttr( uplo, n, ap, a, lda, info ) - !> DTPTTR: copies a triangular matrix A from standard packed format (TP) - !> to standard full format (TR). + !! DTPTTR: copies a triangular matrix A from standard packed format (TP) + !! to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -81506,12 +81502,12 @@ module stdlib_linalg_lapack_q subroutine stdlib_qtrcon( norm, uplo, diag, n, a, lda, rcond, work,iwork, info ) - !> DTRCON: estimates the reciprocal of the condition number of a - !> triangular matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! DTRCON: estimates the reciprocal of the condition number of a + !! triangular matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -81607,21 +81603,21 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & - !> DTREVC: computes some or all of the right and/or left eigenvectors of - !> a real upper quasi-triangular matrix T. - !> Matrices of this type are produced by the Schur factorization of - !> a real general matrix: A = Q*T*Q**T, as computed by DHSEQR. - !> The right eigenvector x and the left eigenvector y of T corresponding - !> to an eigenvalue w are defined by: - !> T*x = w*x, (y**H)*T = w*(y**H) - !> where y**H denotes the conjugate transpose of y. - !> The eigenvalues are not input to this routine, but are read directly - !> from the diagonal blocks of T. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an - !> input matrix. If Q is the orthogonal factor that reduces a matrix - !> A to Schur form T, then Q*X and Q*Y are the matrices of right and - !> left eigenvectors of A. + !! DTREVC: computes some or all of the right and/or left eigenvectors of + !! a real upper quasi-triangular matrix T. + !! Matrices of this type are produced by the Schur factorization of + !! a real general matrix: A = Q*T*Q**T, as computed by DHSEQR. + !! The right eigenvector x and the left eigenvector y of T corresponding + !! to an eigenvalue w are defined by: + !! T*x = w*x, (y**H)*T = w*(y**H) + !! where y**H denotes the conjugate transpose of y. + !! The eigenvalues are not input to this routine, but are read directly + !! from the diagonal blocks of T. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an + !! input matrix. If Q is the orthogonal factor that reduces a matrix + !! A to Schur form T, then Q*X and Q*Y are the matrices of right and + !! left eigenvectors of A. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82220,22 +82216,22 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtrevc3( side, howmny, select, n, t, ldt, vl, ldvl,vr, ldvr, mm, m, & - !> DTREVC3: computes some or all of the right and/or left eigenvectors of - !> a real upper quasi-triangular matrix T. - !> Matrices of this type are produced by the Schur factorization of - !> a real general matrix: A = Q*T*Q**T, as computed by DHSEQR. - !> The right eigenvector x and the left eigenvector y of T corresponding - !> to an eigenvalue w are defined by: - !> T*x = w*x, (y**T)*T = w*(y**T) - !> where y**T denotes the transpose of the vector y. - !> The eigenvalues are not input to this routine, but are read directly - !> from the diagonal blocks of T. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an - !> input matrix. If Q is the orthogonal factor that reduces a matrix - !> A to Schur form T, then Q*X and Q*Y are the matrices of right and - !> left eigenvectors of A. - !> This uses a Level 3 BLAS version of the back transformation. + !! DTREVC3: computes some or all of the right and/or left eigenvectors of + !! a real upper quasi-triangular matrix T. + !! Matrices of this type are produced by the Schur factorization of + !! a real general matrix: A = Q*T*Q**T, as computed by DHSEQR. + !! The right eigenvector x and the left eigenvector y of T corresponding + !! to an eigenvalue w are defined by: + !! T*x = w*x, (y**T)*T = w*(y**T) + !! where y**T denotes the transpose of the vector y. + !! The eigenvalues are not input to this routine, but are read directly + !! from the diagonal blocks of T. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an + !! input matrix. If Q is the orthogonal factor that reduces a matrix + !! A to Schur form T, then Q*X and Q*Y are the matrices of right and + !! left eigenvectors of A. + !! This uses a Level 3 BLAS version of the back transformation. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83042,16 +83038,16 @@ module stdlib_linalg_lapack_q subroutine stdlib_qtrexc( compq, n, t, ldt, q, ldq, ifst, ilst, work,info ) - !> DTREXC: reorders the real Schur factorization of a real matrix - !> A = Q*T*Q**T, so that the diagonal block of T with row index IFST is - !> moved to row ILST. - !> The real Schur form T is reordered by an orthogonal similarity - !> transformation Z**T*T*Z, and optionally the matrix Q of Schur vectors - !> is updated by postmultiplying it with Z. - !> T must be in Schur canonical form (as returned by DHSEQR), 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. + !! DTREXC: reorders the real Schur factorization of a real matrix + !! A = Q*T*Q**T, so that the diagonal block of T with row index IFST is + !! moved to row ILST. + !! The real Schur form T is reordered by an orthogonal similarity + !! transformation Z**T*T*Z, and optionally the matrix Q of Schur vectors + !! is updated by postmultiplying it with Z. + !! T must be in Schur canonical form (as returned by DHSEQR), 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83246,12 +83242,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& - !> DTRRFS: provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular - !> coefficient matrix. - !> The solution matrix X must be computed by DTRTRS or some other - !> means before entering this routine. DTRRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! DTRRFS: provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular + !! coefficient matrix. + !! The solution matrix X must be computed by DTRTRS or some other + !! means before entering this routine. DTRRFS does not do iterative + !! refinement because doing so cannot improve the backward error. work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83481,17 +83477,17 @@ module stdlib_linalg_lapack_q subroutine stdlib_qtrsen( job, compq, select, n, t, ldt, q, ldq, wr, wi,m, s, sep, work, & - !> DTRSEN: reorders the real Schur factorization of a real matrix - !> A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in - !> the leading diagonal blocks of the upper quasi-triangular matrix T, - !> and the leading columns of Q form an orthonormal basis of the - !> corresponding right invariant subspace. - !> Optionally the routine computes the reciprocal condition numbers of - !> the cluster of eigenvalues and/or the invariant subspace. - !> T must be in Schur canonical form (as returned by DHSEQR), 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. + !! DTRSEN: reorders the real Schur factorization of a real matrix + !! A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in + !! the leading diagonal blocks of the upper quasi-triangular matrix T, + !! and the leading columns of Q form an orthonormal basis of the + !! corresponding right invariant subspace. + !! Optionally the routine computes the reciprocal condition numbers of + !! the cluster of eigenvalues and/or the invariant subspace. + !! T must be in Schur canonical form (as returned by DHSEQR), 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. lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83676,14 +83672,14 @@ module stdlib_linalg_lapack_q subroutine stdlib_qtrsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm, m, & - !> DTRSNA: estimates reciprocal condition numbers for specified - !> eigenvalues and/or right eigenvectors of a real upper - !> quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q - !> orthogonal). - !> T must be in Schur canonical form (as returned by DHSEQR), 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. + !! DTRSNA: estimates reciprocal condition numbers for specified + !! eigenvalues and/or right eigenvectors of a real upper + !! quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q + !! orthogonal). + !! T must be in Schur canonical form (as returned by DHSEQR), 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. work, ldwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83921,17 +83917,17 @@ module stdlib_linalg_lapack_q subroutine stdlib_qtrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) - !> DTRSYL: solves the real Sylvester matrix equation: - !> op(A)*X + X*op(B) = scale*C or - !> op(A)*X - X*op(B) = scale*C, - !> where op(A) = A or A**T, and A and B are both upper quasi- - !> triangular. A is M-by-M and B is N-by-N; the right hand side C and - !> the solution X are M-by-N; and scale is an output scale factor, set - !> <= 1 to avoid overflow in X. - !> A and B must be in Schur canonical form (as returned by DHSEQR), 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. + !! DTRSYL: solves the real Sylvester matrix equation: + !! op(A)*X + X*op(B) = scale*C or + !! op(A)*X - X*op(B) = scale*C, + !! where op(A) = A or A**T, and A and B are both upper quasi- + !! triangular. A is M-by-M and B is N-by-N; the right hand side C and + !! the solution X are M-by-N; and scale is an output scale factor, set + !! <= 1 to avoid overflow in X. + !! A and B must be in Schur canonical form (as returned by DHSEQR), 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84582,9 +84578,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtrti2( uplo, diag, n, a, lda, info ) - !> DTRTI2: computes the inverse of a real upper or lower triangular - !> matrix. - !> This is the Level 2 BLAS version of the algorithm. + !! DTRTI2: computes the inverse of a real upper or lower triangular + !! matrix. + !! This is the Level 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -84656,9 +84652,9 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtrtri( uplo, diag, n, a, lda, info ) - !> DTRTRI: computes the inverse of a real upper or lower triangular - !> matrix A. - !> This is the Level 3 BLAS version of the algorithm. + !! DTRTRI: computes the inverse of a real upper or lower triangular + !! matrix A. + !! This is the Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -84743,10 +84739,10 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) - !> DTRTRS: solves a triangular system of the form - !> A * X = B or A**T * X = B, - !> where A is a triangular matrix of order N, and B is an N-by-NRHS - !> matrix. A check is made to verify that A is nonsingular. + !! DTRTRS: solves a triangular system of the form + !! A * X = B or A**T * X = B, + !! where A is a triangular matrix of order N, and B is an N-by-NRHS + !! matrix. A check is made to verify that A is nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -84803,8 +84799,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtrttf( transr, uplo, n, a, lda, arf, info ) - !> DTRTTF: copies a triangular matrix A from standard full format (TR) - !> to rectangular full packed format (TF) . + !! DTRTTF: copies a triangular matrix A from standard full format (TR) + !! to rectangular full packed format (TF) . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -85031,8 +85027,8 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtrttp( uplo, n, a, lda, ap, info ) - !> DTRTTP: copies a triangular matrix A from full format (TR) to standard - !> packed format (TP). + !! DTRTTP: copies a triangular matrix A from full format (TR) to standard + !! packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -85085,12 +85081,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qtzrzf( m, n, a, lda, tau, work, lwork, info ) - !> DTZRZF: reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A - !> to upper triangular form by means of orthogonal transformations. - !> The upper trapezoidal matrix A is factored as - !> A = ( R 0 ) * Z, - !> where Z is an N-by-N orthogonal matrix and R is an M-by-M upper - !> triangular matrix. + !! DTZRZF: reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A + !! to upper triangular form by means of orthogonal transformations. + !! The upper trapezoidal matrix A is factored as + !! A = ( R 0 ) * Z, + !! where Z is an N-by-N orthogonal matrix and R is an M-by-M upper + !! triangular matrix. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -85201,10 +85197,10 @@ module stdlib_linalg_lapack_q pure real(qp) function stdlib_qzsum1( n, cx, incx ) - !> DZSUM1: takes the sum of the absolute values of a complex - !> vector and returns a quad precision result. - !> Based on DZASUM from the Level 1 BLAS. - !> The change is to use the 'genuine' absolute value. + !! DZSUM1: takes the sum of the absolute values of a complex + !! vector and returns a quad precision result. + !! Based on DZASUM from the Level 1 BLAS. + !! The change is to use the 'genuine' absolute value. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -85243,12 +85239,12 @@ module stdlib_linalg_lapack_q pure subroutine stdlib_qlag2q( m, n, sa, ldsa, a, lda, info ) - !> DLAG2Q: converts a SINGLE PRECISION matrix, SA, to a DOUBLE - !> PRECISION matrix, A. - !> Note that while it is possible to overflow while converting - !> from double to single, it is not possible to overflow when - !> converting from single to double. - !> This is an auxiliary routine so there is no argument checking. + !! DLAG2Q: converts a SINGLE PRECISION matrix, SA, to a DOUBLE + !! PRECISION matrix, A. + !! Note that while it is possible to overflow while converting + !! from double to single, it is not possible to overflow when + !! converting from single to double. + !! This is an auxiliary routine so there is no argument checking. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_lapack_s.fypp b/src/stdlib_linalg_lapack_s.fypp index a01a33639..fffe5f62b 100644 --- a/src/stdlib_linalg_lapack_s.fypp +++ b/src/stdlib_linalg_lapack_s.fypp @@ -516,10 +516,10 @@ module stdlib_linalg_lapack_s pure real(sp) function stdlib_scsum1( n, cx, incx ) - !> SCSUM1 takes the sum of the absolute values of a complex - !> vector and returns a single precision result. - !> Based on SCASUM from the Level 1 BLAS. - !> The change is to use the 'genuine' absolute value. + !! SCSUM1 takes the sum of the absolute values of a complex + !! vector and returns a single precision result. + !! Based on SCASUM from the Level 1 BLAS. + !! The change is to use the 'genuine' absolute value. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -558,9 +558,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgbtf2( m, n, kl, ku, ab, ldab, ipiv, info ) - !> SGBTF2 computes an LU factorization of a real m-by-n band matrix A - !> using partial pivoting with row interchanges. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! SGBTF2 computes an LU factorization of a real m-by-n band matrix A + !! using partial pivoting with row interchanges. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -644,10 +644,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) - !> SGBTRS solves a system of linear equations - !> A * X = B or A**T * X = B - !> with a general band matrix A using the LU factorization computed - !> by SGBTRF. + !! SGBTRS solves a system of linear equations + !! A * X = B or A**T * X = B + !! with a general band matrix A using the LU factorization computed + !! by SGBTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -738,9 +738,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) - !> SGEBAK forms the right or left eigenvectors of a real general matrix - !> by backward transformation on the computed eigenvectors of the - !> balanced matrix output by SGEBAL. + !! SGEBAK forms the right or left eigenvectors of a real general matrix + !! by backward transformation on the computed eigenvectors of the + !! balanced matrix output by SGEBAL. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -835,10 +835,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) - !> SGGBAK forms the right or left eigenvectors of a real generalized - !> eigenvalue problem A*x = lambda*B*x, by backward transformation on - !> the computed eigenvectors of the balanced pair of matrices output by - !> SGGBAL. + !! SGGBAK forms the right or left eigenvectors of a real generalized + !! eigenvalue problem A*x = lambda*B*x, by backward transformation on + !! the computed eigenvectors of the balanced pair of matrices output by + !! SGGBAL. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -948,12 +948,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgtsv( n, nrhs, dl, d, du, b, ldb, info ) - !> SGTSV 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. + !! SGTSV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1127,13 +1127,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgttrf( n, dl, d, du, du2, ipiv, info ) - !> SGTTRF computes an LU factorization of a real 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. + !! SGTTRF computes an LU factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1219,10 +1219,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) - !> SGTTS2 solves one of the systems of equations - !> A*X = B or A**T*X = B, - !> with a tridiagonal matrix A using the LU factorization computed - !> by SGTTRF. + !! SGTTS2 solves one of the systems of equations + !! A*X = B or A**T*X = B, + !! with a tridiagonal matrix A using the LU factorization computed + !! by SGTTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1332,12 +1332,12 @@ module stdlib_linalg_lapack_s pure real(sp) function stdlib_sla_gbrpvgrw( n, kl, ku, ncols, ab, ldab, afb,ldafb ) - !> SLA_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. + !! SLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1372,12 +1372,12 @@ module stdlib_linalg_lapack_s pure real(sp) function stdlib_sla_gerpvgrw( n, ncols, a, lda, af, ldaf ) - !> SLA_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. + !! SLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1411,9 +1411,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sla_wwaddw( n, x, y, w ) - !> SLA_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. + !! SLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1438,14 +1438,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slabad( small, large ) - !> SLABAD takes as input the values computed by SLAMCH 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 SLAMCH. This subroutine is needed because - !> SLAMCH does not compensate for poor arithmetic in the upper half of - !> the exponent range, as is found on a Cray. + !! SLABAD takes as input the values computed by SLAMCH 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 SLAMCH. This subroutine is needed because + !! SLAMCH does not compensate for poor arithmetic in the upper half of + !! the exponent range, as is found on a Cray. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1466,8 +1466,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slacn2( n, v, x, isgn, est, kase, isave ) - !> SLACN2 estimates the 1-norm of a square, real matrix A. - !> Reverse communication is used for evaluating matrix-vector products. + !! SLACN2 estimates the 1-norm of a square, real matrix A. + !! Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1599,8 +1599,8 @@ module stdlib_linalg_lapack_s subroutine stdlib_slacon( n, v, x, isgn, est, kase ) - !> SLACON estimates the 1-norm of a square, real matrix A. - !> Reverse communication is used for evaluating matrix-vector products. + !! SLACON estimates the 1-norm of a square, real matrix A. + !! Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1720,8 +1720,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slacpy( uplo, m, n, a, lda, b, ldb ) - !> SLACPY copies all or part of a two-dimensional matrix A to another - !> matrix B. + !! SLACPY copies all or part of a two-dimensional matrix A to another + !! matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1786,11 +1786,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slae2( a, b, c, rt1, rt2 ) - !> SLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix - !> [ A B ] - !> [ B C ]. - !> On return, RT1 is the eigenvalue of larger absolute value, and RT2 - !> is the eigenvalue of smaller absolute value. + !! SLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix + !! [ A B ] + !! [ B C ]. + !! On return, RT1 is the eigenvalue of larger absolute value, and RT2 + !! is the eigenvalue of smaller absolute value. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1850,37 +1850,37 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaebz( ijob, nitmax, n, mmax, minp, nbmin, abstol,reltol, pivmin, d, & - !> SLAEBZ 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. + !! SLAEBZ 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. e, e2, nval, ab, c, mout,nab, work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2121,13 +2121,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaed5( i, d, z, delta, rho, dlam ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2192,9 +2192,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaeda( n, tlvls, curlvl, curpbm, prmptr, perm, givptr,givcol, givnum,& - !> SLAEDA computes the Z vector corresponding to the merge step in the - !> CURLVLth step of the merge process with TLVLS steps for the CURPBMth - !> problem. + !! SLAEDA computes the Z vector corresponding to the merge step in the + !! CURLVLth step of the merge process with TLVLS steps for the CURPBMth + !! problem. q, qptr, z, ztemp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2297,14 +2297,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaev2( a, b, c, rt1, rt2, cs1, sn1 ) - !> SLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix - !> [ A B ] - !> [ B C ]. - !> On return, RT1 is the eigenvalue of larger absolute value, RT2 is the - !> eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right - !> eigenvector for RT1, giving the decomposition - !> [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ] - !> [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ]. + !! SLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix + !! [ A B ] + !! [ B C ]. + !! On return, RT1 is the eigenvalue of larger absolute value, RT2 is the + !! eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right + !! eigenvector for RT1, giving the decomposition + !! [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ] + !! [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ]. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2396,12 +2396,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slag2( a, lda, b, ldb, safmin, scale1, scale2, wr1,wr2, wi ) - !> SLAG2 computes the eigenvalues of a 2 x 2 generalized eigenvalue - !> problem A - w B, with scaling as necessary to avoid over-/underflow. - !> The scaling factor "s" results in a modified eigenvalue equation - !> s A - w B - !> where s is a non-negative scaling factor chosen so that w, w B, - !> and s A do not overflow and, if possible, do not underflow, either. + !! SLAG2 computes the eigenvalues of a 2 x 2 generalized eigenvalue + !! problem A - w B, with scaling as necessary to avoid over-/underflow. + !! The scaling factor "s" results in a modified eigenvalue equation + !! s A - w B + !! where s is a non-negative scaling factor chosen so that w, w B, + !! and s A do not overflow and, if possible, do not underflow, either. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2580,12 +2580,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slag2d( m, n, sa, ldsa, a, lda, info ) - !> SLAG2D converts a SINGLE PRECISION matrix, SA, to a DOUBLE - !> PRECISION matrix, A. - !> Note that while it is possible to overflow while converting - !> from double to single, it is not possible to overflow when - !> converting from single to double. - !> This is an auxiliary routine so there is no argument checking. + !! SLAG2D converts a SINGLE PRECISION matrix, SA, to a DOUBLE + !! PRECISION matrix, A. + !! Note that while it is possible to overflow while converting + !! from double to single, it is not possible to overflow when + !! converting from single to double. + !! This is an auxiliary routine so there is no argument checking. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2610,11 +2610,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) - !> SLAGTM 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. + !! SLAGTM 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2712,17 +2712,17 @@ module stdlib_linalg_lapack_s pure logical(lk) function stdlib_slaisnan( sin1, sin2 ) - !> This routine is not for general use. It exists solely to avoid - !> over-optimization in SISNAN. - !> SLAISNAN 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. + !! This routine is not for general use. It exists solely to avoid + !! over-optimization in SISNAN. + !! SLAISNAN 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2736,7 +2736,7 @@ module stdlib_linalg_lapack_s pure real(sp) function stdlib_slamch( cmach ) - !> SLAMCH determines single precision machine parameters. + !! SLAMCH determines single precision machine parameters. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2804,9 +2804,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slamrg( n1, n2, a, strd1, strd2, index ) - !> SLAMRG 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. + !! SLAMRG 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2868,54 +2868,54 @@ module stdlib_linalg_lapack_s pure recursive subroutine stdlib_slaorhr_col_getrfnp2( m, n, a, lda, d, info ) - !> SLAORHR_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 SORHR_COL. In SORHR_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]. - !> SLAORHR_COL_GETRFNP2 is called to factorize a block by the blocked - !> routine SLAORHR_COL_GETRFNP, which uses blocked code calling - !> Level 3 BLAS to update the submatrix. However, SLAORHR_COL_GETRFNP2 - !> is self-sufficient and can be used without SLAORHR_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. + !! SLAORHR_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 SORHR_COL. In SORHR_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]. + !! SLAORHR_COL_GETRFNP2 is called to factorize a block by the blocked + !! routine SLAORHR_COL_GETRFNP, which uses blocked code calling + !! Level 3 BLAS to update the submatrix. However, SLAORHR_COL_GETRFNP2 + !! is self-sufficient and can be used without SLAORHR_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2998,12 +2998,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slapmr( forwrd, m, n, x, ldx, k ) - !> SLAPMR 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. + !! SLAPMR 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3066,12 +3066,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slapmt( forwrd, m, n, x, ldx, k ) - !> SLAPMT 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. + !! SLAPMT 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3134,8 +3134,8 @@ module stdlib_linalg_lapack_s pure real(sp) function stdlib_slapy3( x, y, z ) - !> SLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause - !> unnecessary overflow and unnecessary underflow. + !! SLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause + !! unnecessary overflow and unnecessary underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3166,9 +3166,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) - !> SLAQGB 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. + !! SLAQGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -3236,8 +3236,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed ) - !> SLAQGE equilibrates a general M by N matrix A using the row and - !> column scaling factors in the vectors R and C. + !! SLAQGE equilibrates a general M by N matrix A using the row and + !! column scaling factors in the vectors R and C. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3302,16 +3302,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaqr1( n, h, ldh, sr1, si1, sr2, si2, v ) - !> Given a 2-by-2 or 3-by-3 matrix H, SLAQR1: sets v to a - !> scalar multiple of the first column of the product - !> (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I) - !> scaling to avoid overflows and most underflows. It - !> is assumed that either - !> 1) sr1 = sr2 and si1 = -si2 - !> or - !> 2) si1 = si2 = 0. - !> This is useful for starting double implicit shift bulges - !> in the QR algorithm. + !! Given a 2-by-2 or 3-by-3 matrix H, SLAQR1: sets v to a + !! scalar multiple of the first column of the product + !! (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I) + !! scaling to avoid overflows and most underflows. It + !! is assumed that either + !! 1) sr1 = sr2 and si1 = -si2 + !! or + !! 2) si1 = si2 = 0. + !! This is useful for starting double implicit shift bulges + !! in the QR algorithm. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3362,8 +3362,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) - !> SLAQSB equilibrates a symmetric band matrix A using the scaling - !> factors in the vector S. + !! SLAQSB equilibrates a symmetric band matrix A using the scaling + !! factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3422,8 +3422,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaqsp( uplo, n, ap, s, scond, amax, equed ) - !> SLAQSP equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. + !! SLAQSP equilibrates a symmetric matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3484,8 +3484,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaqsy( uplo, n, a, lda, s, scond, amax, equed ) - !> SLAQSY equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. + !! SLAQSY equilibrates a symmetric matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3542,11 +3542,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slar2v( n, x, y, z, incx, c, s, incc ) - !> SLAR2V applies a vector of real plane rotations from both sides to - !> a sequence of 2-by-2 real symmetric matrices, defined by the elements - !> of the vectors x, y and z. For i = 1,2,...,n - !> ( x(i) z(i) ) := ( c(i) s(i) ) ( x(i) z(i) ) ( c(i) -s(i) ) - !> ( z(i) y(i) ) ( -s(i) c(i) ) ( z(i) y(i) ) ( s(i) c(i) ) + !! SLAR2V applies a vector of real plane rotations from both sides to + !! a sequence of 2-by-2 real symmetric matrices, defined by the elements + !! of the vectors x, y and z. For i = 1,2,...,n + !! ( x(i) z(i) ) := ( c(i) s(i) ) ( x(i) z(i) ) ( c(i) -s(i) ) + !! ( z(i) y(i) ) ( -s(i) c(i) ) ( z(i) y(i) ) ( s(i) c(i) ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3585,11 +3585,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarf( side, m, n, v, incv, tau, c, ldc, work ) - !> SLARF applies a real elementary reflector H to a real m by n matrix - !> C, from either the left or the right. H is represented in the form - !> H = I - tau * v * v**T - !> where tau is a real scalar and v is a real vector. - !> If tau = 0, then H is taken to be the unit matrix. + !! SLARF applies a real elementary reflector H to a real m by n matrix + !! C, from either the left or the right. H is represented in the form + !! H = I - tau * v * v**T + !! where tau is a real scalar and v is a real vector. + !! If tau = 0, then H is taken to be the unit matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3662,8 +3662,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, ldc, & - !> SLARFB applies a real block reflector H or its transpose H**T to a - !> real m by n matrix C, from either the left or the right. + !! SLARFB applies a real block reflector H or its transpose H**T to a + !! real m by n matrix C, from either the left or the right. work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -3984,13 +3984,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) - !> SLARFB_GETT applies a real Householder block reflector H from the - !> left to a real (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. + !! SLARFB_GETT applies a real Householder block reflector H from the + !! left to a real (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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4121,16 +4121,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarft( direct, storev, n, k, v, ldv, tau, t, ldt ) - !> SLARFT forms the triangular factor T of a real 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**T - !> 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**T * T * V + !! SLARFT forms the triangular factor T of a real 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**T + !! 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**T * T * V ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4248,13 +4248,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarfx( side, m, n, v, tau, c, ldc, work ) - !> SLARFX applies a real elementary reflector H to a real m by n - !> matrix C, from either the left or the right. H is represented in the - !> form - !> H = I - tau * v * v**T - !> where tau is a real scalar and v is a real vector. - !> If tau = 0, then H is taken to be the unit matrix - !> This version uses inline code if H has order < 11. + !! SLARFX applies a real elementary reflector H to a real m by n + !! matrix C, from either the left or the right. H is represented in the + !! form + !! H = I - tau * v * v**T + !! where tau is a real scalar and v is a real vector. + !! If tau = 0, then H is taken to be the unit matrix + !! This version uses inline code if H has order < 11. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4750,12 +4750,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarfy( uplo, n, v, incv, tau, c, ldc, work ) - !> SLARFY applies an elementary reflector, or Householder matrix, H, - !> to an n x n symmetric 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. + !! SLARFY applies an elementary reflector, or Householder matrix, H, + !! to an n x n symmetric 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. ! -- lapack test routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4784,10 +4784,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slargv( n, x, incx, y, incy, c, incc ) - !> SLARGV generates a vector of real plane rotations, determined by - !> elements of the real vectors x and y. For i = 1,2,...,n - !> ( c(i) s(i) ) ( x(i) ) = ( a(i) ) - !> ( -s(i) c(i) ) ( y(i) ) = ( 0 ) + !! SLARGV generates a vector of real plane rotations, determined by + !! elements of the real vectors x and y. For i = 1,2,...,n + !! ( c(i) s(i) ) ( x(i) ) = ( a(i) ) + !! ( -s(i) c(i) ) ( y(i) ) = ( 0 ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4838,8 +4838,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarra( n, d, e, e2, spltol, tnrm,nsplit, isplit, info ) - !> Compute the splitting points with threshold SPLTOL. - !> SLARRA sets any "small" off-diagonal elements to zero. + !! Compute the splitting points with threshold SPLTOL. + !! SLARRA sets any "small" off-diagonal elements to zero. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4896,9 +4896,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarrc( jobt, n, vl, vu, d, e, pivmin,eigcnt, lcnt, rcnt, info ) - !> 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'. + !! 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'. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4989,18 +4989,18 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarrd( range, order, n, vl, vu, il, iu, gers,reltol, d, e, e2, & - !> SLARRD computes the eigenvalues of a symmetric tridiagonal - !> matrix T to suitable accuracy. This is an auxiliary code to be - !> called from SSTEMR. - !> 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. + !! SLARRD computes the eigenvalues of a symmetric tridiagonal + !! matrix T to suitable accuracy. This is an auxiliary code to be + !! called from SSTEMR. + !! 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. pivmin, nsplit, isplit,m, w, werr, wl, wu, iblock, indexw,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5460,13 +5460,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarrj( n, d, e2, ifirst, ilast,rtol, offset, w, werr, work, iwork,& - !> Given the initial eigenvalue approximations of T, SLARRJ: - !> 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. + !! Given the initial eigenvalue approximations of T, SLARRJ: + !! 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. pivmin, spdiam, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5638,15 +5638,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarrk( n, iw, gl, gu,d, e2, pivmin, reltol, w, werr, info) - !> SLARRK computes one eigenvalue of a symmetric tridiagonal - !> matrix T to suitable accuracy. This is an auxiliary code to be - !> called from SSTEMR. - !> 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. + !! SLARRK computes one eigenvalue of a symmetric tridiagonal + !! matrix T to suitable accuracy. This is an auxiliary code to be + !! called from SSTEMR. + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5718,9 +5718,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarrr( n, d, e, info ) - !> Perform tests to decide whether the symmetric tridiagonal matrix T - !> warrants expensive computations which guarantee high relative accuracy - !> in the eigenvalues. + !! Perform tests to decide whether the symmetric tridiagonal matrix T + !! warrants expensive computations which guarantee high relative accuracy + !! in the eigenvalues. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5800,30 +5800,28 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slartg( f, g, c, s, r ) - !> ! - !> - !> SLARTG generates a plane rotation so that - !> [ C S ] . [ F ] = [ R ] - !> [ -S C ] [ G ] [ 0 ] - !> where C**2 + S**2 = 1. - !> The mathematical formulas used for C and S are - !> R = sign(F) * sqrt(F**2 + G**2) - !> C = F / R - !> S = G / R - !> Hence C >= 0. 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 version is discontinuous in R at F = 0 but it returns the same - !> C and S as SLARTG for complex inputs (F,0) and (G,0). - !> This is a more accurate version of the BLAS1 routine SROTG, - !> with the following other differences: - !> F and G are unchanged on return. - !> If G=0, then C=1 and S=0. - !> If F=0 and (G .ne. 0), then C=0 and S=sign(1,G) without doing any - !> floating point operations (saves work in SBDSQR when - !> there are zeros on the diagonal). - !> If F exceeds G in magnitude, C will be positive. - !> Below, wp=>sp stands for single precision from LA_CONSTANTS module. + !! SLARTG generates a plane rotation so that + !! [ C S ] . [ F ] = [ R ] + !! [ -S C ] [ G ] [ 0 ] + !! where C**2 + S**2 = 1. + !! The mathematical formulas used for C and S are + !! R = sign(F) * sqrt(F**2 + G**2) + !! C = F / R + !! S = G / R + !! Hence C >= 0. 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 version is discontinuous in R at F = 0 but it returns the same + !! C and S as SLARTG for complex inputs (F,0) and (G,0). + !! This is a more accurate version of the BLAS1 routine SROTG, + !! with the following other differences: + !! F and G are unchanged on return. + !! If G=0, then C=1 and S=0. + !! If F=0 and (G .ne. 0), then C=0 and S=sign(1,G) without doing any + !! floating point operations (saves work in SBDSQR when + !! there are zeros on the diagonal). + !! If F exceeds G in magnitude, C will be positive. + !! Below, wp=>sp stands for single precision from LA_CONSTANTS module. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5869,15 +5867,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slartgp( f, g, cs, sn, r ) - !> SLARTGP 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 SROTG, - !> 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. + !! SLARTGP 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 SROTG, + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5963,14 +5961,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slartgs( x, y, sigma, cs, sn ) - !> SLARTGS 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. + !! SLARTGS 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6019,10 +6017,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slartv( n, x, incx, y, incy, c, s, incc ) - !> SLARTV applies a vector of real plane rotations to elements of the - !> real vectors x and y. For i = 1,2,...,n - !> ( x(i) ) := ( c(i) s(i) ) ( x(i) ) - !> ( y(i) ) ( -s(i) c(i) ) ( y(i) ) + !! SLARTV applies a vector of real plane rotations to elements of the + !! real vectors x and y. For i = 1,2,...,n + !! ( x(i) ) := ( c(i) s(i) ) ( x(i) ) + !! ( y(i) ) ( -s(i) c(i) ) ( y(i) ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6053,9 +6051,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaruv( iseed, n, x ) - !> SLARUV returns a vector of n random real numbers from a uniform (0,1) - !> distribution (n <= 128). - !> This is an auxiliary routine called by SLARNV and CLARNV. + !! SLARUV returns a vector of n random real numbers from a uniform (0,1) + !! distribution (n <= 128). + !! This is an auxiliary routine called by SLARNV and CLARNV. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6256,13 +6254,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarz( side, m, n, l, v, incv, tau, c, ldc, work ) - !> SLARZ applies a real elementary reflector H to a real M-by-N - !> matrix C, from either the left or the right. H is represented in the - !> form - !> H = I - tau * v * v**T - !> where tau is a real scalar and v is a real vector. - !> If tau = 0, then H is taken to be the unit matrix. - !> H is a product of k elementary reflectors as returned by STZRZF. + !! SLARZ applies a real elementary reflector H to a real M-by-N + !! matrix C, from either the left or the right. H is represented in the + !! form + !! H = I - tau * v * v**T + !! where tau is a real scalar and v is a real vector. + !! If tau = 0, then H is taken to be the unit matrix. + !! H is a product of k elementary reflectors as returned by STZRZF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6311,9 +6309,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & - !> SLARZB applies a real block reflector H or its transpose H**T to - !> a real distributed M-by-N C from the left or the right. - !> Currently, only STOREV = 'R' and DIRECT = 'B' are supported. + !! SLARZB applies a real block reflector H or its transpose H**T to + !! a real distributed M-by-N C from the left or the right. + !! Currently, only STOREV = 'R' and DIRECT = 'B' are supported. ldc, work, ldwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -6400,18 +6398,18 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) - !> SLARZT forms the triangular factor T of a real 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**T - !> 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**T * T * V - !> Currently, only STOREV = 'R' and DIRECT = 'B' are supported. + !! SLARZT forms the triangular factor T of a real 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**T + !! 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**T * T * V + !! Currently, only STOREV = 'R' and DIRECT = 'B' are supported. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6462,11 +6460,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slas2( f, g, h, ssmin, ssmax ) - !> SLAS2 computes the singular values of the 2-by-2 matrix - !> [ F G ] - !> [ 0 H ]. - !> On return, SSMIN is the smaller singular value and SSMAX is the - !> larger singular value. + !! SLAS2 computes the singular values of the 2-by-2 matrix + !! [ F G ] + !! [ 0 H ]. + !! On return, SSMIN is the smaller singular value and SSMAX is the + !! larger singular value. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6526,14 +6524,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasd5( i, d, z, delta, rho, dsigma, work ) - !> 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. + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6621,8 +6619,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasdt( n, lvl, nd, inode, ndiml, ndimr, msub ) - !> SLASDT creates a tree of subproblems for bidiagonal divide and - !> conquer. + !! SLASDT creates a tree of subproblems for bidiagonal divide and + !! conquer. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6672,8 +6670,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaset( uplo, m, n, alpha, beta, a, lda ) - !> SLASET initializes an m-by-n matrix A to BETA on the diagonal and - !> ALPHA on the offdiagonals. + !! SLASET initializes an m-by-n matrix A to BETA on the diagonal and + !! ALPHA on the offdiagonals. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6722,8 +6720,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasq4( i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn,dn1, dn2, tau, & - !> SLASQ4 computes an approximation TAU to the smallest eigenvalue - !> using values of d from the previous transform. + !! SLASQ4 computes an approximation TAU to the smallest eigenvalue + !! using values of d from the previous transform. ttype, g ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -6930,8 +6928,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasq5( i0, n0, z, pp, tau, sigma, dmin, dmin1, dmin2,dn, dnm1, dnm2, & - !> SLASQ5 computes one dqds transform in ping-pong form, one - !> version for IEEE machines another for non IEEE machines. + !! SLASQ5 computes one dqds transform in ping-pong form, one + !! version for IEEE machines another for non IEEE machines. ieee, eps ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7158,8 +7156,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasq6( i0, n0, z, pp, dmin, dmin1, dmin2, dn,dnm1, dnm2 ) - !> SLASQ6 computes one dqd (shift equal to zero) transform in - !> ping-pong form, with protection against underflow and overflow. + !! SLASQ6 computes one dqd (shift equal to zero) transform in + !! ping-pong form, with protection against underflow and overflow. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7268,57 +7266,57 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasr( side, pivot, direct, m, n, c, s, a, lda ) - !> SLASR applies a sequence of plane rotations to a real 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. + !! SLASR applies a sequence of plane rotations to a real 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7527,10 +7525,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasrt( id, n, d, info ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7701,26 +7699,24 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slassq( n, x, incx, scl, sumsq ) - !> ! - !> - !> SLASSQ 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. + !! SLASSQ 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7818,15 +7814,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasv2( f, g, h, ssmin, ssmax, snr, csr, snl, csl ) - !> SLASV2 computes the singular value decomposition of a 2-by-2 - !> triangular matrix - !> [ F G ] - !> [ 0 H ]. - !> On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the - !> smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and - !> right singular vectors for abs(SSMAX), giving the decomposition - !> [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ] - !> [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ]. + !! SLASV2 computes the singular value decomposition of a 2-by-2 + !! triangular matrix + !! [ F G ] + !! [ 0 H ]. + !! On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the + !! smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and + !! right singular vectors for abs(SSMAX), giving the decomposition + !! [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ] + !! [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ]. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7963,8 +7959,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaswp( n, a, lda, k1, k2, ipiv, incx ) - !> SLASWP performs a series of row interchanges on the matrix A. - !> One row interchange is initiated for each of rows K1 through K2 of A. + !! SLASWP performs a series of row interchanges on the matrix A. + !! One row interchange is initiated for each of rows K1 through K2 of A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8030,10 +8026,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasy2( ltranl, ltranr, isgn, n1, n2, tl, ldtl, tr,ldtr, b, ldb, & - !> SLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in - !> op(TL)*X + ISGN*X*op(TR) = SCALE*B, - !> where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or - !> -1. op(T) = T or T**T, where T**T denotes the transpose of T. + !! SLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in + !! op(TL)*X + ISGN*X*op(TR) = SCALE*B, + !! where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or + !! -1. op(T) = T or T**T, where T**T denotes the transpose of T. scale, x, ldx, xnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8290,18 +8286,18 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) - !> SLASYF computes a partial factorization of a real 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. - !> SLASYF is an auxiliary routine called by SSYTRF. It uses blocked code - !> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or - !> A22 (if UPLO = 'L'). + !! SLASYF computes a partial factorization of a real 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. + !! SLASYF is an auxiliary routine called by SSYTRF. It uses blocked code + !! (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or + !! A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8727,18 +8723,18 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) - !> SLASYF_RK computes a partial factorization of a real 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. - !> SLASYF_RK is an auxiliary routine called by SSYTRF_RK. It uses - !> blocked code (calling Level 3 BLAS) to update the submatrix - !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). + !! SLASYF_RK computes a partial factorization of a real 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. + !! SLASYF_RK is an auxiliary routine called by SSYTRF_RK. It uses + !! blocked code (calling Level 3 BLAS) to update the submatrix + !! A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9168,18 +9164,18 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) - !> SLASYF_ROOK computes a partial factorization of a real 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. - !> SLASYF_ROOK is an auxiliary routine called by SSYTRF_ROOK. It uses - !> blocked code (calling Level 3 BLAS) to update the submatrix - !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). + !! SLASYF_ROOK computes a partial factorization of a real 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. + !! SLASYF_ROOK is an auxiliary routine called by SSYTRF_ROOK. It uses + !! blocked code (calling Level 3 BLAS) to update the submatrix + !! A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9629,16 +9625,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & - !> SLATBS solves one of the triangular systems - !> A *x = s*b or A**T*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 STBSV 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. + !! SLATBS solves one of the triangular systems + !! A *x = s*b or A**T*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 STBSV 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. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10049,16 +10045,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) - !> SLATPS solves one of the triangular systems - !> A *x = s*b or A**T*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, 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 - !> STPSV 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. + !! SLATPS solves one of the triangular systems + !! A *x = s*b or A**T*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, 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 + !! STPSV 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10467,16 +10463,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) - !> SLATRS solves one of the triangular systems - !> A *x = s*b or A**T*x = s*b - !> with scaling to prevent overflow. Here A is an upper or lower - !> triangular matrix, 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 STRSV 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. + !! SLATRS solves one of the triangular systems + !! A *x = s*b or A**T*x = s*b + !! with scaling to prevent overflow. Here A is an upper or lower + !! triangular matrix, 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 STRSV 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10868,14 +10864,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slauu2( uplo, n, a, lda, info ) - !> SLAUU2 computes the product U * U**T or L**T * L, where the triangular - !> factor U or L is stored in the upper or lower triangular part of - !> the array A. - !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, - !> overwriting the factor U in A. - !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, - !> overwriting the factor L in A. - !> This is the unblocked form of the algorithm, calling Level 2 BLAS. + !! SLAUU2 computes the product U * U**T or L**T * L, where the triangular + !! factor U or L is stored in the upper or lower triangular part of + !! the array A. + !! If UPLO = 'U' or 'u' then the upper triangle of the result is stored, + !! overwriting the factor U in A. + !! If UPLO = 'L' or 'l' then the lower triangle of the result is stored, + !! overwriting the factor L in A. + !! This is the unblocked form of the algorithm, calling Level 2 BLAS. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10940,14 +10936,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slauum( uplo, n, a, lda, info ) - !> SLAUUM computes the product U * U**T or L**T * L, where the triangular - !> factor U or L is stored in the upper or lower triangular part of - !> the array A. - !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, - !> overwriting the factor U in A. - !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, - !> overwriting the factor L in A. - !> This is the blocked form of the algorithm, calling Level 3 BLAS. + !! SLAUUM computes the product U * U**T or L**T * L, where the triangular + !! factor U or L is stored in the upper or lower triangular part of + !! the array A. + !! If UPLO = 'U' or 'u' then the upper triangle of the result is stored, + !! overwriting the factor U in A. + !! If UPLO = 'L' or 'l' then the lower triangle of the result is stored, + !! overwriting the factor L in A. + !! This is the blocked form of the algorithm, calling Level 3 BLAS. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11023,15 +11019,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & - !> SORBDB6 orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then the zero vector is returned. + !! SORBDB6 orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then the zero vector is returned. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -11151,11 +11147,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorg2l( m, n, k, a, lda, tau, work, info ) - !> SORG2L generates an m by n real matrix Q with orthonormal columns, - !> which is defined as the last n columns of a product of k elementary - !> reflectors of order m - !> Q = H(k) . . . H(2) H(1) - !> as returned by SGEQLF. + !! SORG2L generates an m by n real matrix Q with orthonormal columns, + !! which is defined as the last n columns of a product of k elementary + !! reflectors of order m + !! Q = H(k) . . . H(2) H(1) + !! as returned by SGEQLF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11215,11 +11211,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorg2r( m, n, k, a, lda, tau, work, info ) - !> SORG2R generates an m by n real matrix Q with orthonormal columns, - !> which is defined as the first n columns of a product of k elementary - !> reflectors of order m - !> Q = H(1) H(2) . . . H(k) - !> as returned by SGEQRF. + !! SORG2R generates an m by n real matrix Q with orthonormal columns, + !! which is defined as the first n columns of a product of k elementary + !! reflectors of order m + !! Q = H(1) H(2) . . . H(k) + !! as returned by SGEQRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11280,11 +11276,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorgl2( m, n, k, a, lda, tau, work, info ) - !> SORGL2 generates an m by n real matrix Q with orthonormal rows, - !> which is defined as the first m rows of a product of k elementary - !> reflectors of order n - !> Q = H(k) . . . H(2) H(1) - !> as returned by SGELQF. + !! SORGL2 generates an m by n real matrix Q with orthonormal rows, + !! which is defined as the first m rows of a product of k elementary + !! reflectors of order n + !! Q = H(k) . . . H(2) H(1) + !! as returned by SGELQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11349,11 +11345,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorglq( m, n, k, a, lda, tau, work, lwork, info ) - !> SORGLQ generates an M-by-N real matrix Q with orthonormal rows, - !> which is defined as the first M rows of a product of K elementary - !> reflectors of order N - !> Q = H(k) . . . H(2) H(1) - !> as returned by SGELQF. + !! SORGLQ generates an M-by-N real matrix Q with orthonormal rows, + !! which is defined as the first M rows of a product of K elementary + !! reflectors of order N + !! Q = H(k) . . . H(2) H(1) + !! as returned by SGELQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11465,11 +11461,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorgql( m, n, k, a, lda, tau, work, lwork, info ) - !> SORGQL generates an M-by-N real matrix Q with orthonormal columns, - !> which is defined as the last N columns of a product of K elementary - !> reflectors of order M - !> Q = H(k) . . . H(2) H(1) - !> as returned by SGEQLF. + !! SORGQL generates an M-by-N real matrix Q with orthonormal columns, + !! which is defined as the last N columns of a product of K elementary + !! reflectors of order M + !! Q = H(k) . . . H(2) H(1) + !! as returned by SGEQLF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11586,11 +11582,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorgqr( m, n, k, a, lda, tau, work, lwork, info ) - !> SORGQR generates an M-by-N real matrix Q with orthonormal columns, - !> which is defined as the first N columns of a product of K elementary - !> reflectors of order M - !> Q = H(1) H(2) . . . H(k) - !> as returned by SGEQRF. + !! SORGQR generates an M-by-N real matrix Q with orthonormal columns, + !! which is defined as the first N columns of a product of K elementary + !! reflectors of order M + !! Q = H(1) H(2) . . . H(k) + !! as returned by SGEQRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11702,11 +11698,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorgr2( m, n, k, a, lda, tau, work, info ) - !> SORGR2 generates an m by n real matrix Q with orthonormal rows, - !> which is defined as the last m rows of a product of k elementary - !> reflectors of order n - !> Q = H(1) H(2) . . . H(k) - !> as returned by SGERQF. + !! SORGR2 generates an m by n real matrix Q with orthonormal rows, + !! which is defined as the last m rows of a product of k elementary + !! reflectors of order n + !! Q = H(1) H(2) . . . H(k) + !! as returned by SGERQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11768,11 +11764,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorgrq( m, n, k, a, lda, tau, work, lwork, info ) - !> SORGRQ generates an M-by-N real matrix Q with orthonormal rows, - !> which is defined as the last M rows of a product of K elementary - !> reflectors of order N - !> Q = H(1) H(2) . . . H(k) - !> as returned by SGERQF. + !! SORGRQ generates an M-by-N real matrix Q with orthonormal rows, + !! which is defined as the last M rows of a product of K elementary + !! reflectors of order N + !! Q = H(1) H(2) . . . H(k) + !! as returned by SGERQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11889,21 +11885,21 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorgtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) - !> SORGTSQR_ROW generates an M-by-N real matrix Q_out with - !> orthonormal columns from the output of SLATSQR. These N orthonormal - !> columns are the first N columns of a product of complex unitary - !> matrices Q(k)_in of order M, which are returned by SLATSQR in - !> a special format. - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> The input matrices Q(k)_in are stored in row and column blocks in A. - !> See the documentation of SLATSQR for more details on the format of - !> Q(k)_in, where each Q(k)_in is represented by block Householder - !> transformations. This routine calls an auxiliary routine SLARFB_GETT, - !> where the computation is performed on each individual block. The - !> algorithm first sweeps NB-sized column blocks from the right to left - !> starting in the bottom row block and continues to the top row block - !> (hence _ROW in the routine name). This sweep is in reverse order of - !> the order in which SLATSQR generates the output blocks. + !! SORGTSQR_ROW generates an M-by-N real matrix Q_out with + !! orthonormal columns from the output of SLATSQR. These N orthonormal + !! columns are the first N columns of a product of complex unitary + !! matrices Q(k)_in of order M, which are returned by SLATSQR in + !! a special format. + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! The input matrices Q(k)_in are stored in row and column blocks in A. + !! See the documentation of SLATSQR for more details on the format of + !! Q(k)_in, where each Q(k)_in is represented by block Householder + !! transformations. This routine calls an auxiliary routine SLARFB_GETT, + !! where the computation is performed on each individual block. The + !! algorithm first sweeps NB-sized column blocks from the right to left + !! starting in the bottom row block and continues to the top row block + !! (hence _ROW in the routine name). This sweep is in reverse order of + !! the order in which SLATSQR generates the output blocks. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12214,16 +12210,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> SORM2L overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T * C if SIDE = 'L' and TRANS = 'T', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'T', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by SGEQLF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! SORM2L overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T * C if SIDE = 'L' and TRANS = 'T', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'T', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by SGEQLF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12308,16 +12304,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> SORM2R overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T* C if SIDE = 'L' and TRANS = 'T', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'T', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by SGEQRF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! SORM2R overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T* C if SIDE = 'L' and TRANS = 'T', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'T', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by SGEQRF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12407,16 +12403,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> SORML2 overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T* C if SIDE = 'L' and TRANS = 'T', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'T', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by SGELQF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! SORML2 overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T* C if SIDE = 'L' and TRANS = 'T', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'T', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by SGELQF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12506,15 +12502,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sormlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> SORMLQ overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by SGELQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! SORMLQ overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by SGELQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12649,15 +12645,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sormql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> SORMQL overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by SGEQLF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! SORMQL overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by SGEQLF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12786,15 +12782,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sormqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> SORMQR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by SGEQRF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! SORMQR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by SGEQRF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12923,16 +12919,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sormr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> SORMR2 overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T* C if SIDE = 'L' and TRANS = 'T', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'T', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by SGERQF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! SORMR2 overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T* C if SIDE = 'L' and TRANS = 'T', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'T', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by SGERQF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13017,16 +13013,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sormr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) - !> SORMR3 overwrites the general real m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**T* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**T if SIDE = 'R' and TRANS = 'C', - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by STZRZF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! SORMR3 overwrites the general real m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**T* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**T if SIDE = 'R' and TRANS = 'C', + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by STZRZF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13116,15 +13112,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sormrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> SORMRQ overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by SGERQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! SORMRQ overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by SGERQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13259,15 +13255,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sormrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & - !> SORMRZ overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by STZRZF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! SORMRZ overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by STZRZF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13411,14 +13407,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) - !> SPBEQU computes row and column scalings intended to equilibrate a - !> symmetric positive definite band matrix A and reduce its condition - !> number (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. + !! SPBEQU computes row and column scalings intended to equilibrate a + !! symmetric positive definite band matrix A and reduce its condition + !! number (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13498,15 +13494,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spbstf( uplo, n, kd, ab, ldab, info ) - !> SPBSTF computes a split Cholesky factorization of a real - !> symmetric positive definite band matrix A. - !> This routine is designed to be used in conjunction with SSBGST. - !> The factorization has the form A = S**T*S where S is a band matrix - !> of the same bandwidth as A and the following structure: - !> S = ( U ) - !> ( M L ) - !> where U is upper triangular of order m = (n+kd)/2, and L is lower - !> triangular of order n-m. + !! SPBSTF computes a split Cholesky factorization of a real + !! symmetric positive definite band matrix A. + !! This routine is designed to be used in conjunction with SSBGST. + !! The factorization has the form A = S**T*S where S is a band matrix + !! of the same bandwidth as A and the following structure: + !! S = ( U ) + !! ( M L ) + !! where U is upper triangular of order m = (n+kd)/2, and L is lower + !! triangular of order n-m. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13616,14 +13612,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spbtf2( uplo, n, kd, ab, ldab, info ) - !> SPBTF2 computes the Cholesky factorization of a real symmetric - !> positive definite band matrix A. - !> The factorization has the form - !> A = U**T * U , if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix, U**T is the transpose of U, and - !> L is lower triangular. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! SPBTF2 computes the Cholesky factorization of a real symmetric + !! positive definite band matrix A. + !! The factorization has the form + !! A = U**T * U , if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix, U**T is the transpose of U, and + !! L is lower triangular. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13703,9 +13699,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) - !> SPBTRS solves a system of linear equations A*X = B with a symmetric - !> positive definite band matrix A using the Cholesky factorization - !> A = U**T*U or A = L*L**T computed by SPBTRF. + !! SPBTRS solves a system of linear equations A*X = B with a symmetric + !! positive definite band matrix A using the Cholesky factorization + !! A = U**T*U or A = L*L**T computed by SPBTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13771,14 +13767,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spoequ( n, a, lda, s, scond, amax, info ) - !> SPOEQU computes row and column scalings intended to equilibrate a - !> symmetric positive definite matrix A and reduce its condition number - !> (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. + !! SPOEQU computes row and column scalings intended to equilibrate a + !! symmetric positive definite matrix A and reduce its condition number + !! (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13845,19 +13841,19 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spoequb( n, a, lda, s, scond, amax, info ) - !> SPOEQUB computes row and column scalings intended to equilibrate a - !> symmetric positive definite matrix A and reduce its condition number - !> (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. - !> This routine differs from SPOEQU 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 diagonal entries are no longer approximately 1 but lie - !> between sqrt(radix) and 1/sqrt(radix). + !! SPOEQUB computes row and column scalings intended to equilibrate a + !! symmetric positive definite matrix A and reduce its condition number + !! (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. + !! This routine differs from SPOEQU 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 diagonal entries are no longer approximately 1 but lie + !! between sqrt(radix) and 1/sqrt(radix). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13927,9 +13923,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spotrs( uplo, n, nrhs, a, lda, b, ldb, info ) - !> SPOTRS solves a system of linear equations A*X = B with a symmetric - !> positive definite matrix A using the Cholesky factorization - !> A = U**T*U or A = L*L**T computed by SPOTRF. + !! SPOTRS solves a system of linear equations A*X = B with a symmetric + !! positive definite matrix A using the Cholesky factorization + !! A = U**T*U or A = L*L**T computed by SPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13989,14 +13985,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sppequ( uplo, n, ap, s, scond, amax, info ) - !> SPPEQU computes row and column scalings intended to equilibrate a - !> symmetric positive definite matrix A in packed storage and reduce - !> its condition number (with respect to the two-norm). S contains the - !> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix - !> B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal. - !> This choice of S puts the condition number of B within a factor N of - !> the smallest possible condition number over all possible diagonal - !> scalings. + !! SPPEQU computes row and column scalings intended to equilibrate a + !! symmetric positive definite matrix A in packed storage and reduce + !! its condition number (with respect to the two-norm). S contains the + !! scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix + !! B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal. + !! This choice of S puts the condition number of B within a factor N of + !! the smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14082,12 +14078,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spptrf( uplo, n, ap, info ) - !> SPPTRF computes the Cholesky factorization of a real symmetric - !> positive definite matrix A stored in packed format. - !> The factorization has the form - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. + !! SPPTRF computes the Cholesky factorization of a real symmetric + !! positive definite matrix A stored in packed format. + !! The factorization has the form + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14167,9 +14163,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spptrs( uplo, n, nrhs, ap, b, ldb, info ) - !> SPPTRS solves a system of linear equations A*X = B with a symmetric - !> positive definite matrix A in packed storage using the Cholesky - !> factorization A = U**T*U or A = L*L**T computed by SPPTRF. + !! SPPTRS solves a system of linear equations A*X = B with a symmetric + !! positive definite matrix A in packed storage using the Cholesky + !! factorization A = U**T*U or A = L*L**T computed by SPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14229,13 +14225,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sptcon( n, d, e, anorm, rcond, work, info ) - !> SPTCON computes the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric positive definite tridiagonal matrix - !> using the factorization A = L*D*L**T or A = U**T*D*U computed by - !> SPTTRF. - !> Norm(inv(A)) is computed by a direct method, and the reciprocal of - !> the condition number is computed as - !> RCOND = 1 / (ANORM * norm(inv(A))). + !! SPTCON computes the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric positive definite tridiagonal matrix + !! using the factorization A = L*D*L**T or A = U**T*D*U computed by + !! SPTTRF. + !! Norm(inv(A)) is computed by a direct method, and the reciprocal of + !! the condition number is computed as + !! RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14302,9 +14298,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spttrf( n, d, e, info ) - !> SPTTRF computes the L*D*L**T factorization of a real symmetric - !> positive definite tridiagonal matrix A. The factorization may also - !> be regarded as having the form A = U**T*D*U. + !! SPTTRF computes the L*D*L**T factorization of a real symmetric + !! positive definite tridiagonal matrix A. The factorization may also + !! be regarded as having the form A = U**T*D*U. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14385,12 +14381,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sptts2( n, nrhs, d, e, b, ldb ) - !> SPTTS2 solves a tridiagonal system of the form - !> A * X = B - !> using the L*D*L**T factorization of A computed by SPTTRF. D is a - !> diagonal matrix specified in the vector D, L is a unit bidiagonal - !> matrix whose subdiagonal is specified in the vector E, and X and B - !> are N by NRHS matrices. + !! SPTTS2 solves a tridiagonal system of the form + !! A * X = B + !! using the L*D*L**T factorization of A computed by SPTTRF. D is a + !! diagonal matrix specified in the vector D, L is a unit bidiagonal + !! matrix whose subdiagonal is specified in the vector E, and X and B + !! are N by NRHS matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14426,9 +14422,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_srscl( n, sa, sx, incx ) - !> SRSCL multiplies an n-element real vector x by the real scalar 1/a. - !> This is done without overflow or underflow as long as - !> the final result x/a does not overflow or underflow. + !! SRSCL multiplies an n-element real vector x by the real scalar 1/a. + !! This is done without overflow or underflow as long as + !! the final result x/a does not overflow or underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14480,13 +14476,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, info ) - !> SSBGST reduces a real symmetric-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**T*S by SPBSTF, using a - !> split Cholesky factorization. A is overwritten by C = X**T*A*X, where - !> X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the - !> bandwidth of A. + !! SSBGST reduces a real symmetric-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**T*S by SPBSTF, using a + !! split Cholesky factorization. A is overwritten by C = X**T*A*X, where + !! X = S**(-1)*Q and Q is an orthogonal matrix chosen to preserve the + !! bandwidth of A. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15393,9 +15389,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) - !> SSBTRD reduces a real symmetric band matrix A to symmetric - !> tridiagonal form T by an orthogonal similarity transformation: - !> Q**T * A * Q = T. + !! SSBTRD reduces a real symmetric band matrix A to symmetric + !! tridiagonal form T by an orthogonal similarity transformation: + !! Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15724,14 +15720,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) - !> Level 3 BLAS like routine for C in RFP Format. - !> SSFRK performs one of the symmetric rank--k operations - !> C := alpha*A*A**T + beta*C, - !> or - !> C := alpha*A**T*A + beta*C, - !> where alpha and beta are real scalars, C is an n--by--n symmetric - !> matrix and A is an n--by--k matrix in the first case and a k--by--n - !> matrix in the second case. + !! Level 3 BLAS like routine for C in RFP Format. + !! SSFRK performs one of the symmetric rank--k operations + !! C := alpha*A*A**T + beta*C, + !! or + !! C := alpha*A**T*A + beta*C, + !! where alpha and beta are real scalars, C is an n--by--n symmetric + !! matrix and A is an n--by--k matrix in the first case and a k--by--n + !! matrix in the second case. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15980,13 +15976,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sspgst( itype, uplo, n, ap, bp, info ) - !> SSPGST reduces a real symmetric-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**T)*A*inv(U) or inv(L)*A*inv(L**T) - !> 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**T or L**T*A*L. - !> B must have been previously factorized as U**T*U or L*L**T by SPPTRF. + !! SSPGST reduces a real symmetric-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**T)*A*inv(U) or inv(L)*A*inv(L**T) + !! 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**T or L**T*A*L. + !! B must have been previously factorized as U**T*U or L*L**T by SPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16102,12 +16098,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssptrf( uplo, n, ap, ipiv, info ) - !> SSPTRF computes the factorization of a real symmetric matrix A stored - !> in packed format using the Bunch-Kaufman diagonal pivoting method: - !> 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 symmetric and block diagonal with - !> 1-by-1 and 2-by-2 diagonal blocks. + !! SSPTRF computes the factorization of a real symmetric matrix A stored + !! in packed format using the Bunch-Kaufman diagonal pivoting method: + !! 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 symmetric and block diagonal with + !! 1-by-1 and 2-by-2 diagonal blocks. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16425,9 +16421,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssptri( uplo, n, ap, ipiv, work, info ) - !> SSPTRI computes the inverse of a real symmetric indefinite matrix - !> A in packed storage using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by SSPTRF. + !! SSPTRI computes the inverse of a real symmetric indefinite matrix + !! A in packed storage using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by SSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16636,9 +16632,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> SSPTRS solves a system of linear equations A*X = B with a real - !> symmetric matrix A stored in packed format using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by SSPTRF. + !! SSPTRS solves a system of linear equations A*X = B with a real + !! symmetric matrix A stored in packed format using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by SSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16856,16 +16852,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sstebz( range, order, n, vl, vu, il, iu, abstol, d, e,m, nsplit, w, & - !> SSTEBZ computes the eigenvalues of a symmetric tridiagonal - !> matrix T. 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. + !! SSTEBZ computes the eigenvalues of a symmetric tridiagonal + !! matrix T. 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. iblock, isplit, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17249,9 +17245,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssyconv( uplo, way, n, a, lda, ipiv, e, info ) - !> SSYCONV convert A given by TRF into L and D and vice-versa. - !> Get Non-diag elements of D (returned in workspace) and - !> apply or reverse permutation done in TRF. + !! SSYCONV convert A given by TRF into L and D and vice-versa. + !! Get Non-diag elements of D (returned in workspace) and + !! apply or reverse permutation done in TRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17454,21 +17450,21 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssyconvf( uplo, way, n, a, lda, e, ipiv, info ) - !> If parameter WAY = 'C': - !> SSYCONVF converts the factorization output format used in - !> SSYTRF provided on entry in parameter A into the factorization - !> output format used in SSYTRF_RK (or SSYTRF_BK) that is stored - !> on exit in parameters A and E. It also converts in place details of - !> the intechanges stored in IPIV from the format used in SSYTRF into - !> the format used in SSYTRF_RK (or SSYTRF_BK). - !> If parameter WAY = 'R': - !> SSYCONVF performs the conversion in reverse direction, i.e. - !> converts the factorization output format used in SSYTRF_RK - !> (or SSYTRF_BK) provided on entry in parameters A and E into - !> the factorization output format used in SSYTRF that is stored - !> on exit in parameter A. It also converts in place details of - !> the intechanges stored in IPIV from the format used in SSYTRF_RK - !> (or SSYTRF_BK) into the format used in SSYTRF. + !! If parameter WAY = 'C': + !! SSYCONVF converts the factorization output format used in + !! SSYTRF provided on entry in parameter A into the factorization + !! output format used in SSYTRF_RK (or SSYTRF_BK) that is stored + !! on exit in parameters A and E. It also converts in place details of + !! the intechanges stored in IPIV from the format used in SSYTRF into + !! the format used in SSYTRF_RK (or SSYTRF_BK). + !! If parameter WAY = 'R': + !! SSYCONVF performs the conversion in reverse direction, i.e. + !! converts the factorization output format used in SSYTRF_RK + !! (or SSYTRF_BK) provided on entry in parameters A and E into + !! the factorization output format used in SSYTRF that is stored + !! on exit in parameter A. It also converts in place details of + !! the intechanges stored in IPIV from the format used in SSYTRF_RK + !! (or SSYTRF_BK) into the format used in SSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17709,19 +17705,19 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) - !> If parameter WAY = 'C': - !> SSYCONVF_ROOK converts the factorization output format used in - !> SSYTRF_ROOK provided on entry in parameter A into the factorization - !> output format used in SSYTRF_RK (or SSYTRF_BK) that is stored - !> on exit in parameters A and E. IPIV format for SSYTRF_ROOK and - !> SSYTRF_RK (or SSYTRF_BK) is the same and is not converted. - !> If parameter WAY = 'R': - !> SSYCONVF_ROOK performs the conversion in reverse direction, i.e. - !> converts the factorization output format used in SSYTRF_RK - !> (or SSYTRF_BK) provided on entry in parameters A and E into - !> the factorization output format used in SSYTRF_ROOK that is stored - !> on exit in parameter A. IPIV format for SSYTRF_ROOK and - !> SSYTRF_RK (or SSYTRF_BK) is the same and is not converted. + !! If parameter WAY = 'C': + !! SSYCONVF_ROOK converts the factorization output format used in + !! SSYTRF_ROOK provided on entry in parameter A into the factorization + !! output format used in SSYTRF_RK (or SSYTRF_BK) that is stored + !! on exit in parameters A and E. IPIV format for SSYTRF_ROOK and + !! SSYTRF_RK (or SSYTRF_BK) is the same and is not converted. + !! If parameter WAY = 'R': + !! SSYCONVF_ROOK performs the conversion in reverse direction, i.e. + !! converts the factorization output format used in SSYTRF_RK + !! (or SSYTRF_BK) provided on entry in parameters A and E into + !! the factorization output format used in SSYTRF_ROOK that is stored + !! on exit in parameter A. IPIV format for SSYTRF_ROOK and + !! SSYTRF_RK (or SSYTRF_BK) is the same and is not converted. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17962,13 +17958,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssyequb( uplo, n, a, lda, s, scond, amax, work, info ) - !> SSYEQUB computes row and column scalings intended to equilibrate a - !> symmetric 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. + !! SSYEQUB computes row and column scalings intended to equilibrate a + !! symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18138,13 +18134,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssygs2( itype, uplo, n, a, lda, b, ldb, info ) - !> SSYGS2 reduces a real symmetric-definite generalized eigenproblem - !> to standard form. - !> If ITYPE = 1, the problem is A*x = lambda*B*x, - !> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) - !> 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**T or L**T *A*L. - !> B must have been previously factorized as U**T *U or L*L**T by SPOTRF. + !! SSYGS2 reduces a real symmetric-definite generalized eigenproblem + !! to standard form. + !! If ITYPE = 1, the problem is A*x = lambda*B*x, + !! and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) + !! 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**T or L**T *A*L. + !! B must have been previously factorized as U**T *U or L*L**T by SPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18261,13 +18257,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssygst( itype, uplo, n, a, lda, b, ldb, info ) - !> SSYGST reduces a real symmetric-definite generalized eigenproblem - !> to standard form. - !> If ITYPE = 1, the problem is A*x = lambda*B*x, - !> and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) - !> 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**T or L**T*A*L. - !> B must have been previously factorized as U**T*U or L*L**T by SPOTRF. + !! SSYGST reduces a real symmetric-definite generalized eigenproblem + !! to standard form. + !! If ITYPE = 1, the problem is A*x = lambda*B*x, + !! and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T) + !! 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**T or L**T*A*L. + !! B must have been previously factorized as U**T*U or L*L**T by SPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18400,8 +18396,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssyswapr( uplo, n, a, lda, i1, i2) - !> SSYSWAPR applies an elementary permutation on the rows and the columns of - !> a symmetric matrix. + !! SSYSWAPR applies an elementary permutation on the rows and the columns of + !! a symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18468,15 +18464,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytf2_rk( uplo, n, a, lda, e, ipiv, info ) - !> SSYTF2_RK computes the factorization of a real symmetric matrix A - !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric 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. + !! SSYTF2_RK computes the factorization of a real symmetric matrix A + !! using the bounded Bunch-Kaufman (rook) diagonal pivoting method: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18920,13 +18916,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytf2_rook( uplo, n, a, lda, ipiv, info ) - !> SSYTF2_ROOK computes the factorization of a real symmetric matrix A - !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: - !> 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, U**T is the transpose of U, and D is symmetric 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. + !! SSYTF2_ROOK computes the factorization of a real symmetric matrix A + !! using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: + !! 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, U**T is the transpose of U, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19331,15 +19327,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) - !> SSYTRF_RK computes the factorization of a real symmetric matrix A - !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric 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. + !! SSYTRF_RK computes the factorization of a real symmetric matrix A + !! using the bounded Bunch-Kaufman (rook) diagonal pivoting method: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19497,14 +19493,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) - !> SSYTRF_ROOK computes the factorization of a real symmetric 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 symmetric 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. + !! SSYTRF_ROOK computes the factorization of a real symmetric 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 symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19625,9 +19621,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytri( uplo, n, a, lda, ipiv, work, info ) - !> SSYTRI computes the inverse of a real symmetric indefinite matrix - !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by - !> SSYTRF. + !! SSYTRI computes the inverse of a real symmetric indefinite matrix + !! A using the factorization A = U*D*U**T or A = L*D*L**T computed by + !! SSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19813,9 +19809,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytri_rook( uplo, n, a, lda, ipiv, work, info ) - !> SSYTRI_ROOK computes the inverse of a real symmetric - !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T - !> computed by SSYTRF_ROOK. + !! SSYTRI_ROOK computes the inverse of a real symmetric + !! matrix A using the factorization A = U*D*U**T or A = L*D*L**T + !! computed by SSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20041,9 +20037,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) - !> SSYTRS solves a system of linear equations A*X = B with a real - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by SSYTRF. + !! SSYTRS solves a system of linear equations A*X = B with a real + !! symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by SSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20251,9 +20247,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) - !> SSYTRS2 solves a system of linear equations A*X = B with a real - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by SSYTRF and converted by SSYCONV. + !! SSYTRS2 solves a system of linear equations A*X = B with a real + !! symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by SSYTRF and converted by SSYCONV. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20429,15 +20425,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) - !> SSYTRS_3 solves a system of linear equations A * X = B with a real - !> symmetric matrix A using the factorization computed - !> by SSYTRF_RK or SSYTRF_BK: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric and block - !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. - !> This algorithm is using Level 3 BLAS. + !! SSYTRS_3 solves a system of linear equations A * X = B with a real + !! symmetric matrix A using the factorization computed + !! by SSYTRF_RK or SSYTRF_BK: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric and block + !! diagonal with 1-by-1 and 2-by-2 diagonal blocks. + !! This algorithm is using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20586,9 +20582,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) - !> SSYTRS_AA solves a system of linear equations A*X = B with a real - !> symmetric matrix A using the factorization A = U**T*T*U or - !> A = L*T*L**T computed by SSYTRF_AA. + !! SSYTRS_AA solves a system of linear equations A*X = B with a real + !! symmetric matrix A using the factorization A = U**T*T*U or + !! A = L*T*L**T computed by SSYTRF_AA. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20713,9 +20709,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) - !> SSYTRS_ROOK solves a system of linear equations A*X = B with - !> a real symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by SSYTRF_ROOK. + !! SSYTRS_ROOK solves a system of linear equations A*X = B with + !! a real symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by SSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20935,12 +20931,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& - !> STBRFS provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular band - !> coefficient matrix. - !> The solution matrix X must be computed by STBTRS or some other - !> means before entering this routine. STBRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! STBRFS provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular band + !! coefficient matrix. + !! The solution matrix X must be computed by STBTRS or some other + !! means before entering this routine. STBRFS does not do iterative + !! refinement because doing so cannot improve the backward error. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21173,10 +21169,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) - !> STBTRS solves a triangular system of the form - !> A * X = B or A**T * X = B, - !> where A is a triangular band matrix of order N, and B is an - !> N-by NRHS matrix. A check is made to verify that A is nonsingular. + !! STBTRS solves a triangular system of the form + !! A * X = B or A**T * X = B, + !! where A is a triangular band matrix of order N, and B is an + !! N-by NRHS matrix. A check is made to verify that A is nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21246,14 +21242,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) - !> Level 3 BLAS like routine for A in RFP Format. - !> STFSM solves the matrix equation - !> op( A )*X = alpha*B or X*op( A ) = alpha*B - !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**T. - !> A is in Rectangular Full Packed (RFP) Format. - !> The matrix X is overwritten on B. + !! Level 3 BLAS like routine for A in RFP Format. + !! STFSM solves the matrix equation + !! op( A )*X = alpha*B or X*op( A ) = alpha*B + !! where alpha is a scalar, X and B are m by n matrices, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**T. + !! A is in Rectangular Full Packed (RFP) Format. + !! The matrix X is overwritten on B. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21748,8 +21744,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stfttp( transr, uplo, n, arf, ap, info ) - !> STFTTP copies a triangular matrix A from rectangular full packed - !> format (TF) to standard packed format (TP). + !! STFTTP copies a triangular matrix A from rectangular full packed + !! format (TF) to standard packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22004,8 +22000,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stfttr( transr, uplo, n, arf, a, lda, info ) - !> STFTTR copies a triangular matrix A from rectangular full packed - !> format (TF) to standard full format (TR). + !! STFTTR copies a triangular matrix A from rectangular full packed + !! format (TF) to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22233,9 +22229,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & - !> STPRFB applies a real "triangular-pentagonal" block reflector H or its - !> conjugate transpose H^H to a real matrix C, which is composed of two - !> blocks A and B, either from the left or right. + !! STPRFB applies a real "triangular-pentagonal" block reflector H or its + !! conjugate transpose H^H to a real matrix C, which is composed of two + !! blocks A and B, either from the left or right. lda, b, ldb, work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22651,12 +22647,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & - !> STPRFS provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular packed - !> coefficient matrix. - !> The solution matrix X must be computed by STPTRS or some other - !> means before entering this routine. STPRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! STPRFS provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular packed + !! coefficient matrix. + !! The solution matrix X must be computed by STPTRS or some other + !! means before entering this routine. STPRFS does not do iterative + !! refinement because doing so cannot improve the backward error. work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22896,8 +22892,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stptri( uplo, diag, n, ap, info ) - !> STPTRI computes the inverse of a real upper or lower triangular - !> matrix A stored in packed format. + !! STPTRI computes the inverse of a real upper or lower triangular + !! matrix A stored in packed format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22986,11 +22982,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) - !> STPTRS solves a triangular system of the form - !> A * X = B or A**T * X = B, - !> where A is a triangular matrix of order N stored in packed format, - !> and B is an N-by-NRHS matrix. A check is made to verify that A is - !> nonsingular. + !! STPTRS solves a triangular system of the form + !! A * X = B or A**T * X = B, + !! where A is a triangular matrix of order N stored in packed format, + !! and B is an N-by-NRHS matrix. A check is made to verify that A is + !! nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23059,8 +23055,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stpttf( transr, uplo, n, ap, arf, info ) - !> STPTTF copies a triangular matrix A from standard packed format (TP) - !> to rectangular full packed format (TF). + !! STPTTF copies a triangular matrix A from standard packed format (TP) + !! to rectangular full packed format (TF). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23301,8 +23297,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stpttr( uplo, n, ap, a, lda, info ) - !> STPTTR copies a triangular matrix A from standard packed format (TP) - !> to standard full format (TR). + !! STPTTR copies a triangular matrix A from standard packed format (TP) + !! to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23355,12 +23351,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_strrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& - !> STRRFS provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular - !> coefficient matrix. - !> The solution matrix X must be computed by STRTRS or some other - !> means before entering this routine. STRRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! STRRFS provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular + !! coefficient matrix. + !! The solution matrix X must be computed by STRTRS or some other + !! means before entering this routine. STRRFS does not do iterative + !! refinement because doing so cannot improve the backward error. work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23590,9 +23586,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_strti2( uplo, diag, n, a, lda, info ) - !> STRTI2 computes the inverse of a real upper or lower triangular - !> matrix. - !> This is the Level 2 BLAS version of the algorithm. + !! STRTI2 computes the inverse of a real upper or lower triangular + !! matrix. + !! This is the Level 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23664,9 +23660,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_strtri( uplo, diag, n, a, lda, info ) - !> STRTRI computes the inverse of a real upper or lower triangular - !> matrix A. - !> This is the Level 3 BLAS version of the algorithm. + !! STRTRI computes the inverse of a real upper or lower triangular + !! matrix A. + !! This is the Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23751,10 +23747,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_strtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) - !> STRTRS solves a triangular system of the form - !> A * X = B or A**T * X = B, - !> where A is a triangular matrix of order N, and B is an N-by-NRHS - !> matrix. A check is made to verify that A is nonsingular. + !! STRTRS solves a triangular system of the form + !! A * X = B or A**T * X = B, + !! where A is a triangular matrix of order N, and B is an N-by-NRHS + !! matrix. A check is made to verify that A is nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23811,8 +23807,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_strttf( transr, uplo, n, a, lda, arf, info ) - !> STRTTF copies a triangular matrix A from standard full format (TR) - !> to rectangular full packed format (TF) . + !! STRTTF copies a triangular matrix A from standard full format (TR) + !! to rectangular full packed format (TF) . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24039,8 +24035,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_strttp( uplo, n, a, lda, ap, info ) - !> STRTTP copies a triangular matrix A from full format (TR) to standard - !> packed format (TP). + !! STRTTP copies a triangular matrix A from full format (TR) to standard + !! packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24093,27 +24089,27 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sbbcsd( jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q,theta, phi, u1, & - !> SBBCSD computes the CS decomposition of an orthogonal 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 | ]**T - !> = [---------] [---------------] [---------] . - !> [ | 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 SORCSD for details.) - !> The bidiagonal matrices B11, B12, B21, and B22 are represented - !> implicitly by angles THETA(1:Q) and PHI(1:Q-1). - !> The orthogonal matrices U1, U2, V1T, and V2T are input/output. - !> The input matrices are pre- or post-multiplied by the appropriate - !> singular vector matrices. + !! SBBCSD computes the CS decomposition of an orthogonal 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 | ]**T + !! = [---------] [---------------] [---------] . + !! [ | 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 SORCSD for details.) + !! The bidiagonal matrices B11, B12, B21, and B22 are represented + !! implicitly by angles THETA(1:Q) and PHI(1:Q-1). + !! The orthogonal matrices U1, U2, V1T, and V2T are input/output. + !! The input matrices are pre- or post-multiplied by the appropriate + !! singular vector matrices. ldu1, u2, ldu2, v1t, ldv1t,v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e,b22d, b22e, work, & lwork, info ) ! -- lapack computational routine -- @@ -24701,19 +24697,19 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sdisna( job, m, n, d, sep, info ) - !> SDISNA 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 - !> SLAMCH( 'E' ) * ( ANORM / SEP( I ) ) - !> where ANORM = 2-norm(A) = max( abs( D(j) ) ). SEP(I) is not allowed - !> to be smaller than SLAMCH( 'E' )*ANORM in order to limit the size of - !> the error bound. - !> SDISNA may also be used to compute error bounds for eigenvectors of - !> the generalized symmetric definite eigenproblem. + !! SDISNA 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 + !! SLAMCH( 'E' ) * ( ANORM / SEP( I ) ) + !! where ANORM = 2-norm(A) = max( abs( D(j) ) ). SEP(I) is not allowed + !! to be smaller than SLAMCH( 'E' )*ANORM in order to limit the size of + !! the error bound. + !! SDISNA may also be used to compute error bounds for eigenvectors of + !! the generalized symmetric definite eigenproblem. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24806,10 +24802,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & - !> SGBBRD reduces a real general m-by-n band matrix A to upper - !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. - !> The routine computes B, and optionally forms Q or P**T, or computes - !> Q**T*C for a given matrix C. + !! SGBBRD reduces a real general m-by-n band matrix A to upper + !! bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. + !! The routine computes B, and optionally forms Q or P**T, or computes + !! Q**T*C for a given matrix C. ldc, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25063,12 +25059,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, iwork, & - !> SGBCON estimates the reciprocal of the condition number of a real - !> general band matrix A, in either the 1-norm or the infinity-norm, - !> using the LU factorization computed by SGBTRF. - !> 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)) ). + !! SGBCON estimates the reciprocal of the condition number of a real + !! general band matrix A, in either the 1-norm or the infinity-norm, + !! using the LU factorization computed by SGBTRF. + !! 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)) ). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25192,15 +25188,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) - !> SGBEQU 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. + !! SGBEQU 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25322,21 +25318,21 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) - !> SGBEQUB 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 SGEEQU 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). + !! SGBEQUB 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 SGEEQU 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). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25467,9 +25463,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, x, & - !> SGBRFS 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. + !! SGBRFS 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. ldx, ferr, berr, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25668,9 +25664,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) - !> SGBTRF computes an LU factorization of a real m-by-n band matrix A - !> using partial pivoting with row interchanges. - !> This is the blocked version of the algorithm, calling Level 3 BLAS. + !! SGBTRF computes an LU factorization of a real m-by-n band matrix A + !! using partial pivoting with row interchanges. + !! This is the blocked version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25918,12 +25914,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgecon( norm, n, a, lda, anorm, rcond, work, iwork,info ) - !> SGECON estimates the reciprocal of the condition number of a general - !> real matrix A, in either the 1-norm or the infinity-norm, using - !> the LU factorization computed by SGETRF. - !> 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)) ). + !! SGECON estimates the reciprocal of the condition number of a general + !! real matrix A, in either the 1-norm or the infinity-norm, using + !! the LU factorization computed by SGETRF. + !! 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)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26019,15 +26015,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) - !> SGEEQU 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. + !! SGEEQU 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26142,21 +26138,21 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) - !> SGEEQUB 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 SGEEQU 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). + !! SGEEQUB 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 SGEEQU 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). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26281,15 +26277,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) - !> DGEMLQT overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q C C Q - !> TRANS = 'T': Q**T C C Q**T - !> where Q is a real orthogonal matrix defined as the product of K - !> elementary reflectors: - !> Q = H(1) H(2) . . . H(K) = I - V T V**T - !> generated using the compact WY representation as returned by SGELQT. - !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. + !! DGEMLQT overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q C C Q + !! TRANS = 'T': Q**T C C Q**T + !! where Q is a real orthogonal matrix defined as the product of K + !! elementary reflectors: + !! Q = H(1) H(2) . . . H(K) = I - V T V**T + !! generated using the compact WY representation as returned by SGELQT. + !! Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26379,15 +26375,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) - !> SGEMQRT overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q C C Q - !> TRANS = 'T': Q**T C C Q**T - !> where Q is a real orthogonal matrix defined as the product of K - !> elementary reflectors: - !> Q = H(1) H(2) . . . H(K) = I - V T V**T - !> generated using the compact WY representation as returned by SGEQRT. - !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. + !! SGEMQRT overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q C C Q + !! TRANS = 'T': Q**T C C Q**T + !! where Q is a real orthogonal matrix defined as the product of K + !! elementary reflectors: + !! Q = H(1) H(2) . . . H(K) = I - V T V**T + !! generated using the compact WY representation as returned by SGEQRT. + !! Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26477,10 +26473,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) - !> SGESC2 solves a system of linear equations - !> A * X = scale* RHS - !> with a general N-by-N matrix A using the LU factorization with - !> complete pivoting computed by SGETC2. + !! SGESC2 solves a system of linear equations + !! A * X = scale* RHS + !! with a general N-by-N matrix A using the LU factorization with + !! complete pivoting computed by SGETC2. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26535,11 +26531,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgetc2( n, a, lda, ipiv, jpiv, info ) - !> SGETC2 computes an LU factorization with complete pivoting of the - !> n-by-n matrix A. The factorization has the form A = P * L * U * Q, - !> where P and Q are permutation matrices, L is lower triangular with - !> unit diagonal elements and U is upper triangular. - !> This is the Level 2 BLAS algorithm. + !! SGETC2 computes an LU factorization with complete pivoting of the + !! n-by-n matrix A. The factorization has the form A = P * L * U * Q, + !! where P and Q are permutation matrices, L is lower triangular with + !! unit diagonal elements and U is upper triangular. + !! This is the Level 2 BLAS algorithm. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26619,14 +26615,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgetf2( m, n, a, lda, ipiv, info ) - !> SGETF2 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 2 BLAS version of the algorithm. + !! SGETF2 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 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26692,25 +26688,25 @@ module stdlib_linalg_lapack_s pure recursive subroutine stdlib_sgetrf2( m, n, a, lda, ipiv, info ) - !> SGETRF2 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. + !! SGETRF2 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26807,10 +26803,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgetri( n, a, lda, ipiv, work, lwork, info ) - !> SGETRI computes the inverse of a matrix using the LU factorization - !> computed by SGETRF. - !> This method inverts U and then computes inv(A) by solving the system - !> inv(A)*L = inv(U) for inv(A). + !! SGETRI computes the inverse of a matrix using the LU factorization + !! computed by SGETRF. + !! This method inverts U and then computes inv(A) by solving the system + !! inv(A)*L = inv(U) for inv(A). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26909,10 +26905,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) - !> SGETRS solves a system of linear equations - !> A * X = B or A**T * X = B - !> with a general N-by-N matrix A using the LU factorization computed - !> by SGETRF. + !! SGETRS solves a system of linear equations + !! A * X = B or A**T * X = B + !! with a general N-by-N matrix A using the LU factorization computed + !! by SGETRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26978,15 +26974,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) - !> SGGBAL balances a pair of general real 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. + !! SGGBAL balances a pair of general real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27272,29 +27268,29 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & - !> SGGHRD reduces a pair of real matrices (A,B) to generalized upper - !> Hessenberg form using orthogonal 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 orthogonal matrix Q to the left side - !> of the equation. - !> This subroutine simultaneously reduces A to a Hessenberg matrix H: - !> Q**T*A*Z = H - !> and transforms B to another upper triangular matrix T: - !> Q**T*B*Z = T - !> in order to reduce the problem to its standard form - !> H*y = lambda*T*y - !> where y = Z**T*x. - !> The orthogonal 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**T = (Q1*Q) * H * (Z1*Z)**T - !> Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T - !> If Q1 is the orthogonal matrix from the QR factorization of B in the - !> original equation A*x = lambda*B*x, then SGGHRD reduces the original - !> problem to generalized Hessenberg form. + !! SGGHRD reduces a pair of real matrices (A,B) to generalized upper + !! Hessenberg form using orthogonal 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 orthogonal matrix Q to the left side + !! of the equation. + !! This subroutine simultaneously reduces A to a Hessenberg matrix H: + !! Q**T*A*Z = H + !! and transforms B to another upper triangular matrix T: + !! Q**T*B*Z = T + !! in order to reduce the problem to its standard form + !! H*y = lambda*T*y + !! where y = Z**T*x. + !! The orthogonal 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**T = (Q1*Q) * H * (Z1*Z)**T + !! Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T + !! If Q1 is the orthogonal matrix from the QR factorization of B in the + !! original equation A*x = lambda*B*x, then SGGHRD reduces the original + !! problem to generalized Hessenberg form. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27402,10 +27398,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) - !> SGTTRS solves one of the systems of equations - !> A*X = B or A**T*X = B, - !> with a tridiagonal matrix A using the LU factorization computed - !> by SGTTRF. + !! SGTTRS solves one of the systems of equations + !! A*X = B or A**T*X = B, + !! with a tridiagonal matrix A using the LU factorization computed + !! by SGTTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27466,9 +27462,9 @@ module stdlib_linalg_lapack_s pure logical(lk) function stdlib_sisnan( sin ) - !> SISNAN returns .TRUE. if its argument is NaN, and .FALSE. - !> otherwise. To be replaced by the Fortran 2003 intrinsic in the - !> future. + !! SISNAN returns .TRUE. if its argument is NaN, and .FALSE. + !! otherwise. To be replaced by the Fortran 2003 intrinsic in the + !! future. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27482,19 +27478,19 @@ module stdlib_linalg_lapack_s subroutine stdlib_sla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) - !> SLA_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. + !! SLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27668,15 +27664,15 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_sla_gbrcond( trans, n, kl, ku, ab, ldab, afb, ldafb,ipiv, cmode, c, & - !> SLA_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. + !! SLA_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. info, work, iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27826,19 +27822,19 @@ module stdlib_linalg_lapack_s subroutine stdlib_sla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) - !> SLA_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. + !! SLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28005,15 +28001,15 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_sla_gercond( trans, n, a, lda, af, ldaf, ipiv,cmode, c, info, work, & - !> SLA_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. + !! SLA_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. iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28155,11 +28151,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sla_lin_berr( n, nz, nrhs, res, ayb, berr ) - !> SLA_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. + !! SLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28196,15 +28192,15 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_sla_porcond( uplo, n, a, lda, af, ldaf, cmode, c,info, work, iwork ) - !> SLA_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. + !! SLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28355,18 +28351,18 @@ module stdlib_linalg_lapack_s subroutine stdlib_sla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) - !> SLA_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. + !! SLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28544,15 +28540,15 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_sla_syrcond( uplo, n, a, lda, af, ldaf, ipiv, cmode,c, info, work, & - !> SLA_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. + !! SLA_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. iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28711,12 +28707,12 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_sla_syrpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,work ) - !> SLA_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. + !! SLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28917,17 +28913,17 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaed6( kniter, orgati, rho, d, z, finit, tau, info ) - !> SLAED6 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 SLAED4 when necessary. In most cases, - !> the root sought is the smallest in magnitude, though it might not be - !> in some extremely rare situations. + !! SLAED6 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 SLAED4 when necessary. In most cases, + !! the root sought is the smallest in magnitude, though it might not be + !! in some extremely rare situations. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29143,23 +29139,23 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) - !> SLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such - !> that if ( UPPER ) then - !> U**T *A*Q = U**T *( A1 A2 )*Q = ( x 0 ) - !> ( 0 A3 ) ( x x ) - !> and - !> V**T*B*Q = V**T *( B1 B2 )*Q = ( x 0 ) - !> ( 0 B3 ) ( x x ) - !> or if ( .NOT.UPPER ) then - !> U**T *A*Q = U**T *( A1 0 )*Q = ( x x ) - !> ( A2 A3 ) ( 0 x ) - !> and - !> V**T*B*Q = V**T*( B1 0 )*Q = ( x x ) - !> ( B2 B3 ) ( 0 x ) - !> The rows of the transformed A and B are parallel, where - !> U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ ) - !> ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ ) - !> Z**T denotes the transpose of Z. + !! SLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such + !! that if ( UPPER ) then + !! U**T *A*Q = U**T *( A1 A2 )*Q = ( x 0 ) + !! ( 0 A3 ) ( x x ) + !! and + !! V**T*B*Q = V**T *( B1 B2 )*Q = ( x 0 ) + !! ( 0 B3 ) ( x x ) + !! or if ( .NOT.UPPER ) then + !! U**T *A*Q = U**T *( A1 0 )*Q = ( x x ) + !! ( A2 A3 ) ( 0 x ) + !! and + !! V**T*B*Q = V**T*( B1 0 )*Q = ( x x ) + !! ( B2 B3 ) ( 0 x ) + !! The rows of the transformed A and B are parallel, where + !! U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ ) + !! ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ ) + !! Z**T denotes the transpose of Z. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29303,18 +29299,18 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slagtf( n, a, lambda, b, c, tol, d, in, info ) - !> SLAGTF 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 SLAGTF may - !> be used, in conjunction with SLAGTS, to obtain eigenvectors of T by - !> inverse iteration. + !! SLAGTF 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 SLAGTF may + !! be used, in conjunction with SLAGTS, to obtain eigenvectors of T by + !! inverse iteration. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29394,15 +29390,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slagts( job, n, a, b, c, d, in, y, tol, info ) - !> SLAGTS 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 SLAGTF. 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. + !! SLAGTS 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 SLAGTF. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29591,26 +29587,26 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaic1( job, j, x, sest, w, gamma, sestpr, s, c ) - !> SLAIC1 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 SLAIC1 computes sestpr, s, c such that - !> the vector - !> [ s*x ] - !> xhat = [ c ] - !> is an approximate singular vector of - !> [ L 0 ] - !> Lhat = [ w**T 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]**T and sestpr**2 is an eigenpair of the system - !> diag(sest*sest, 0) + [alpha gamma] * [ alpha ] - !> [ gamma ] - !> where alpha = x**T*w. + !! SLAIC1 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 SLAIC1 computes sestpr, s, c such that + !! the vector + !! [ s*x ] + !! xhat = [ c ] + !! is an approximate singular vector of + !! [ L 0 ] + !! Lhat = [ w**T 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]**T and sestpr**2 is an eigenpair of the system + !! diag(sest*sest, 0) + [alpha gamma] * [ alpha ] + !! [ gamma ] + !! where alpha = x**T*w. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29803,21 +29799,21 @@ module stdlib_linalg_lapack_s pure integer(ilp) function stdlib_slaneg( n, d, lld, sigma, pivmin, r ) - !> SLANEG 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 SLARRB. - !> 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.) + !! SLANEG 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 SLARRB. + !! 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.) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29908,9 +29904,9 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_slangb( norm, n, kl, ku, ab, ldab,work ) - !> SLANGB 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. + !! SLANGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29983,9 +29979,9 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_slange( norm, m, n, a, lda, work ) - !> SLANGE 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 matrix A. + !! SLANGE 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 matrix A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30055,9 +30051,9 @@ module stdlib_linalg_lapack_s pure real(sp) function stdlib_slangt( norm, n, dl, d, du ) - !> SLANGT 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 tridiagonal matrix A. + !! SLANGT 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 tridiagonal matrix A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30131,9 +30127,9 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_slanhs( norm, n, a, lda, work ) - !> SLANHS 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. + !! SLANHS 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30203,9 +30199,9 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_slansb( norm, uplo, n, k, ab, ldab,work ) - !> SLANSB 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. + !! SLANSB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30308,9 +30304,9 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_slansf( norm, transr, uplo, n, a, work ) - !> SLANSF 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. + !! SLANSF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31012,9 +31008,9 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_slansp( norm, uplo, n, ap, work ) - !> SLANSP 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, supplied in packed form. + !! SLANSP 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, supplied in packed form. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31136,9 +31132,9 @@ module stdlib_linalg_lapack_s pure real(sp) function stdlib_slanst( norm, n, d, e ) - !> SLANST 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. + !! SLANST 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31198,9 +31194,9 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_slansy( norm, uplo, n, a, lda, work ) - !> SLANSY 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. + !! SLANSY 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31294,9 +31290,9 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_slantb( norm, uplo, diag, n, k, ab,ldab, work ) - !> SLANTB 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. + !! SLANTB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31487,9 +31483,9 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_slantp( norm, uplo, diag, n, ap, work ) - !> SLANTP 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. + !! SLANTP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31693,9 +31689,9 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_slantr( norm, uplo, diag, m, n, a, lda,work ) - !> SLANTR 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. + !! SLANTR 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31879,39 +31875,39 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaorhr_col_getrfnp( m, n, a, lda, d, info ) - !> SLAORHR_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 SORHR_COL. In SORHR_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 SLAORHR_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. + !! SLAORHR_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 SORHR_COL. In SORHR_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 SLAORHR_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31973,8 +31969,8 @@ module stdlib_linalg_lapack_s pure real(sp) function stdlib_slapy2( x, y ) - !> SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary - !> overflow and unnecessary underflow. + !! SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary + !! overflow and unnecessary underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32010,15 +32006,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaqz1( a, lda, b, ldb, sr1, sr2, si, beta1, beta2,v ) - !> Given a 3-by-3 matrix pencil (A,B), SLAQZ1: sets v to a - !> scalar multiple of the first column of the product - !> (*) K = (A - (beta2*sr2 - i*si)*B)*B^(-1)*(beta1*A - (sr2 + i*si2)*B)*B^(-1). - !> It is assumed that either - !> 1) sr1 = sr2 - !> or - !> 2) si = 0. - !> This is useful for starting double implicit shift bulges - !> in the QZ algorithm. + !! Given a 3-by-3 matrix pencil (A,B), SLAQZ1: sets v to a + !! scalar multiple of the first column of the product + !! (*) K = (A - (beta2*sr2 - i*si)*B)*B^(-1)*(beta1*A - (sr2 + i*si2)*B)*B^(-1). + !! It is assumed that either + !! 1) sr1 = sr2 + !! or + !! 2) si = 0. + !! This is useful for starting double implicit shift bulges + !! in the QZ algorithm. ! arguments integer(ilp), intent( in ) :: lda, ldb real(sp), intent( in ) :: a( lda, * ), b( ldb, * ), sr1, sr2, si,beta1, beta2 @@ -32065,7 +32061,7 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaqz2( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, qstart, & - !> SLAQZ2 chases a 2x2 shift bulge in a matrix pencil down a single position + !! SLAQZ2 chases a 2x2 shift bulge in a matrix pencil down a single position q, ldq, nz, zstart, z, ldz ) ! arguments logical(lk), intent( in ) :: ilq, ilz @@ -32176,7 +32172,7 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaqz4( ilschur, ilq, ilz, n, ilo, ihi, nshifts,nblock_desired, sr, & - !> SLAQZ4 Executes a single multishift QZ sweep + !! SLAQZ4 Executes a single multishift QZ sweep si, ss, a, lda, b, ldb, q,ldq, z, ldz, qc, ldqc, zc, ldzc, work, lwork,info ) ! function arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -32433,21 +32429,21 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & - !> SLAR1V 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. + !! SLAR1V 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. negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32655,19 +32651,19 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarfg( n, alpha, x, incx, tau ) - !> SLARFG generates a real elementary reflector H of order n, such - !> that - !> H * ( alpha ) = ( beta ), H**T * H = I. - !> ( x ) ( 0 ) - !> where alpha and beta are scalars, and x is an (n-1)-element real - !> vector. H is represented in the form - !> H = I - tau * ( 1 ) * ( 1 v**T ) , - !> ( v ) - !> where tau is a real scalar and v is a real (n-1)-element - !> vector. - !> If the elements of x are all zero, then tau = 0 and H is taken to be - !> the unit matrix. - !> Otherwise 1 <= tau <= 2. + !! SLARFG generates a real elementary reflector H of order n, such + !! that + !! H * ( alpha ) = ( beta ), H**T * H = I. + !! ( x ) ( 0 ) + !! where alpha and beta are scalars, and x is an (n-1)-element real + !! vector. H is represented in the form + !! H = I - tau * ( 1 ) * ( 1 v**T ) , + !! ( v ) + !! where tau is a real scalar and v is a real (n-1)-element + !! vector. + !! If the elements of x are all zero, then tau = 0 and H is taken to be + !! the unit matrix. + !! Otherwise 1 <= tau <= 2. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32724,18 +32720,18 @@ module stdlib_linalg_lapack_s subroutine stdlib_slarfgp( n, alpha, x, incx, tau ) - !> SLARFGP generates a real elementary reflector H of order n, such - !> that - !> H * ( alpha ) = ( beta ), H**T * H = I. - !> ( x ) ( 0 ) - !> where alpha and beta are scalars, beta is non-negative, and x is - !> an (n-1)-element real vector. H is represented in the form - !> H = I - tau * ( 1 ) * ( 1 v**T ) , - !> ( v ) - !> where tau is a real scalar and v is a real (n-1)-element - !> vector. - !> If the elements of x are all zero, then tau = 0 and H is taken to be - !> the unit matrix. + !! SLARFGP generates a real elementary reflector H of order n, such + !! that + !! H * ( alpha ) = ( beta ), H**T * H = I. + !! ( x ) ( 0 ) + !! where alpha and beta are scalars, beta is non-negative, and x is + !! an (n-1)-element real vector. H is represented in the form + !! H = I - tau * ( 1 ) * ( 1 v**T ) , + !! ( v ) + !! where tau is a real scalar and v is a real (n-1)-element + !! vector. + !! If the elements of x are all zero, then tau = 0 and H is taken to be + !! the unit matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32832,8 +32828,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarnv( idist, iseed, n, x ) - !> SLARNV returns a vector of n random real numbers from a uniform or - !> normal distribution. + !! SLARNV returns a vector of n random real numbers from a uniform or + !! normal distribution. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32888,14 +32884,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarrb( n, d, lld, ifirst, ilast, rtol1,rtol2, offset, w, wgap, werr, & - !> Given the relatively robust representation(RRR) L D L^T, SLARRB: - !> 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. + !! Given the relatively robust representation(RRR) L D L^T, SLARRB: + !! 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. work, iwork,pivmin, spdiam, twist, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33061,11 +33057,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarrf( n, d, l, ld, clstrt, clend,w, wgap, werr,spdiam, clgapl, & - !> 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 ), SLARRF: 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. + !! 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 ), SLARRF: 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. clgapr, pivmin, sigma,dplus, lplus, work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33320,9 +33316,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, & - !> SLARRV 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. + !! SLARRV 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. rtol2, w, werr, wgap,iblock, indexw, gers, z, ldz, isuppz,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33951,11 +33947,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) - !> SLASCL multiplies the M by N real 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. + !! SLASCL multiplies the M by N real 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34121,17 +34117,17 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasd4( n, i, d, z, delta, rho, sigma, work, info ) - !> 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. + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34849,13 +34845,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasd7( icompq, nl, nr, sqre, k, d, z, zw, vf, vfw, vl,vlw, alpha, & - !> SLASD7 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. - !> SLASD7 is called from SLASD6. + !! SLASD7 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. + !! SLASD7 is called from SLASD6. beta, dsigma, idx, idxp, idxq,perm, givptr, givcol, ldgcol, givnum, ldgnum,c, s, info ) ! -- lapack auxiliary routine -- @@ -35088,13 +35084,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasd8( icompq, k, d, z, vf, vl, difl, difr, lddifr,dsigma, work, & - !> SLASD8 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 SLASD4, 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. - !> SLASD8 is called from SLASD6. + !! SLASD8 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 SLASD4, 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. + !! SLASD8 is called from SLASD6. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35224,9 +35220,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasq3( i0, n0, z, pp, dmin, sigma, desig, qmax, nfail,iter, ndiv, & - !> SLASQ3 checks for deflation, computes a shift (TAU) and calls dqds. - !> In case of failure it changes shifts, and tries again until output - !> is positive. + !! SLASQ3 checks for deflation, computes a shift (TAU) and calls dqds. + !! In case of failure it changes shifts, and tries again until output + !! is positive. ieee, ttype, dmin1, dmin2, dn, dn1,dn2, g, tau ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35394,14 +35390,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) - !> SLATDF uses the LU factorization of the n-by-n matrix Z computed by - !> SGETC2 and computes a contribution to the reciprocal Dif-estimate - !> by solving Z * x = b for x, and choosing the r.h.s. b such that - !> the norm of x is as large as possible. On entry RHS = b holds the - !> contribution from earlier solved sub-systems, and on return RHS = x. - !> The factorization of Z returned by SGETC2 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. + !! SLATDF uses the LU factorization of the n-by-n matrix Z computed by + !! SGETC2 and computes a contribution to the reciprocal Dif-estimate + !! by solving Z * x = b for x, and choosing the r.h.s. b such that + !! the norm of x is as large as possible. On entry RHS = b holds the + !! contribution from earlier solved sub-systems, and on return RHS = x. + !! The factorization of Z returned by SGETC2 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35504,15 +35500,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) - !> SLATRD reduces NB rows and columns of a real symmetric matrix A to - !> symmetric tridiagonal form by an orthogonal similarity - !> transformation Q**T * A * Q, and returns the matrices V and W which are - !> needed to apply the transformation to the unreduced part of A. - !> If UPLO = 'U', SLATRD reduces the last NB rows and columns of a - !> matrix, of which the upper triangle is supplied; - !> if UPLO = 'L', SLATRD reduces the first NB rows and columns of a - !> matrix, of which the lower triangle is supplied. - !> This is an auxiliary routine called by SSYTRD. + !! SLATRD reduces NB rows and columns of a real symmetric matrix A to + !! symmetric tridiagonal form by an orthogonal similarity + !! transformation Q**T * A * Q, and returns the matrices V and W which are + !! needed to apply the transformation to the unreduced part of A. + !! If UPLO = 'U', SLATRD reduces the last NB rows and columns of a + !! matrix, of which the upper triangle is supplied; + !! if UPLO = 'L', SLATRD reduces the first NB rows and columns of a + !! matrix, of which the lower triangle is supplied. + !! This is an auxiliary routine called by SSYTRD. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35606,10 +35602,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slatrz( m, n, l, a, lda, tau, work ) - !> SLATRZ factors the M-by-(M+L) real upper trapezoidal matrix - !> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z, by means - !> of orthogonal transformations. Z is an (M+L)-by-(M+L) orthogonal - !> matrix and, R and A1 are M-by-M upper triangular matrices. + !! SLATRZ factors the M-by-(M+L) real upper trapezoidal matrix + !! [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z, by means + !! of orthogonal transformations. Z is an (M+L)-by-(M+L) orthogonal + !! matrix and, R and A1 are M-by-M upper triangular matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35646,22 +35642,22 @@ module stdlib_linalg_lapack_s subroutine stdlib_sorbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & - !> SORBDB simultaneously bidiagonalizes the blocks of an M-by-M - !> partitioned orthogonal matrix X: - !> [ B11 | B12 0 0 ] - !> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**T - !> X = [-----------] = [---------] [----------------] [---------] . - !> [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] - !> [ 0 | 0 0 I ] - !> X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is - !> not the case, then X must be transposed and/or permuted. This can be - !> done in constant time using the TRANS and SIGNS options. See SORCSD - !> for details.) - !> The orthogonal matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- - !> (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are - !> represented implicitly by Householder vectors. - !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! SORBDB simultaneously bidiagonalizes the blocks of an M-by-M + !! partitioned orthogonal matrix X: + !! [ B11 | B12 0 0 ] + !! [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**T + !! X = [-----------] = [---------] [----------------] [---------] . + !! [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] + !! [ 0 | 0 0 I ] + !! X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is + !! not the case, then X must be transposed and/or permuted. This can be + !! done in constant time using the TRANS and SIGNS options. See SORCSD + !! for details.) + !! The orthogonal matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- + !! (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are + !! represented implicitly by Householder vectors. + !! B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented + !! implicitly by angles THETA, PHI. ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35975,17 +35971,17 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & - !> SORBDB5 orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then some other vector from the orthogonal complement - !> is returned. This vector is chosen in an arbitrary but deterministic - !> way. + !! SORBDB5 orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then some other vector from the orthogonal complement + !! is returned. This vector is chosen in an arbitrary but deterministic + !! way. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36074,19 +36070,19 @@ module stdlib_linalg_lapack_s recursive subroutine stdlib_sorcsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & - !> SORCSD computes the CS decomposition of an M-by-M partitioned - !> orthogonal matrix X: - !> [ I 0 0 | 0 0 0 ] - !> [ 0 C 0 | 0 -S 0 ] - !> [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**T - !> X = [-----------] = [---------] [---------------------] [---------] . - !> [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] - !> [ 0 S 0 | 0 C 0 ] - !> [ 0 0 I | 0 0 0 ] - !> X11 is P-by-Q. The orthogonal matrices U1, U2, V1, and V2 are P-by-P, - !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are - !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in - !> which R = MIN(P,M-P,Q,M-Q). + !! SORCSD computes the CS decomposition of an M-by-M partitioned + !! orthogonal matrix X: + !! [ I 0 0 | 0 0 0 ] + !! [ 0 C 0 | 0 -S 0 ] + !! [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**T + !! X = [-----------] = [---------] [---------------------] [---------] . + !! [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] + !! [ 0 S 0 | 0 C 0 ] + !! [ 0 0 I | 0 0 0 ] + !! X11 is P-by-Q. The orthogonal matrices U1, U2, V1, and V2 are P-by-P, + !! (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are + !! R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in + !! which R = MIN(P,M-P,Q,M-Q). ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, ldv1t, v2t,ldv2t, & work, lwork, iwork, info ) ! -- lapack computational routine -- @@ -36349,10 +36345,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) - !> SORGHR generates a real orthogonal matrix Q which is defined as the - !> product of IHI-ILO elementary reflectors of order N, as returned by - !> SGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! SORGHR generates a real orthogonal matrix Q which is defined as the + !! product of IHI-ILO elementary reflectors of order N, as returned by + !! SGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36439,15 +36435,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorhr_col( m, n, nb, a, lda, t, ldt, d, info ) - !> SORHR_COL takes an M-by-N real matrix Q_in with orthonormal columns - !> as input, stored in A, and performs Householder Reconstruction (HR), - !> i.e. reconstructs Householder vectors V(i) implicitly representing - !> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, - !> where S is an N-by-N diagonal matrix with diagonal entries - !> equal to +1 or -1. The Householder vectors (columns V(i) of V) are - !> stored in A on output, and the diagonal entries of S are stored in D. - !> Block reflectors are also returned in T - !> (same output format as SGEQRT). + !! SORHR_COL takes an M-by-N real matrix Q_in with orthonormal columns + !! as input, stored in A, and performs Householder Reconstruction (HR), + !! i.e. reconstructs Householder vectors V(i) implicitly representing + !! another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, + !! where S is an N-by-N diagonal matrix with diagonal entries + !! equal to +1 or -1. The Householder vectors (columns V(i) of V) are + !! stored in A on output, and the diagonal entries of S are stored in D. + !! Block reflectors are also returned in T + !! (same output format as SGEQRT). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36576,14 +36572,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sormhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & - !> SORMHR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> IHI-ILO elementary reflectors, as returned by SGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! SORMHR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! IHI-ILO elementary reflectors, as returned by SGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36675,11 +36671,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,iwork, info ) - !> SPBCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric positive definite band matrix using the - !> Cholesky factorization A = U**T*U or A = L*L**T computed by SPBTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! SPBCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric positive definite band matrix using the + !! Cholesky factorization A = U**T*U or A = L*L**T computed by SPBTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36773,10 +36769,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & - !> SPBRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric positive definite - !> and banded, and provides error bounds and backward error estimates - !> for the solution. + !! SPBRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric positive definite + !! and banded, and provides error bounds and backward error estimates + !! for the solution. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36967,9 +36963,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spftrs( transr, uplo, n, nrhs, a, b, ldb, info ) - !> SPFTRS solves a system of linear equations A*X = B with a symmetric - !> positive definite matrix A using the Cholesky factorization - !> A = U**T*U or A = L*L**T computed by SPFTRF. + !! SPFTRS solves a system of linear equations A*X = B with a symmetric + !! positive definite matrix A using the Cholesky factorization + !! A = U**T*U or A = L*L**T computed by SPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37021,11 +37017,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spocon( uplo, n, a, lda, anorm, rcond, work, iwork,info ) - !> SPOCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric positive definite matrix using the - !> Cholesky factorization A = U**T*U or A = L*L**T computed by SPOTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! SPOCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric positive definite matrix using the + !! Cholesky factorization A = U**T*U or A = L*L**T computed by SPOTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37116,10 +37112,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & - !> SPORFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric positive definite, - !> and provides error bounds and backward error estimates for the - !> solution. + !! SPORFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric positive definite, + !! and provides error bounds and backward error estimates for the + !! solution. work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37305,13 +37301,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spotf2( uplo, n, a, lda, info ) - !> SPOTF2 computes the Cholesky factorization of a real symmetric - !> positive definite matrix A. - !> The factorization has the form - !> A = U**T * U , if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! SPOTF2 computes the Cholesky factorization of a real symmetric + !! positive definite matrix A. + !! The factorization has the form + !! A = U**T * U , if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37392,19 +37388,19 @@ module stdlib_linalg_lapack_s pure recursive subroutine stdlib_spotrf2( uplo, n, a, lda, info ) - !> SPOTRF2 computes the Cholesky factorization of a real symmetric - !> positive definite matrix A using the recursive algorithm. - !> The factorization has the form - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> 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 = n/2 - !> [ A21 | A22 ] n2 = n-n1 - !> The subroutine calls itself to factor A11. Update and scale A21 - !> or A12, update A22 then call itself to factor A22. + !! SPOTRF2 computes the Cholesky factorization of a real symmetric + !! positive definite matrix A using the recursive algorithm. + !! The factorization has the form + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! 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 = n/2 + !! [ A21 | A22 ] n2 = n-n1 + !! The subroutine calls itself to factor A11. Update and scale A21 + !! or A12, update A22 then call itself to factor A22. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37490,9 +37486,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spotri( uplo, n, a, lda, info ) - !> SPOTRI computes the inverse of a real symmetric positive definite - !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T - !> computed by SPOTRF. + !! SPOTRI computes the inverse of a real symmetric positive definite + !! matrix A using the Cholesky factorization A = U**T*U or A = L*L**T + !! computed by SPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37531,12 +37527,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sppcon( uplo, n, ap, anorm, rcond, work, iwork, info ) - !> SPPCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric positive definite packed matrix using - !> the Cholesky factorization A = U**T*U or A = L*L**T computed by - !> SPPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! SPPCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric positive definite packed matrix using + !! the Cholesky factorization A = U**T*U or A = L*L**T computed by + !! SPPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37625,10 +37621,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & - !> SPPRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric positive definite - !> and packed, and provides error bounds and backward error estimates - !> for the solution. + !! SPPRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric positive definite + !! and packed, and provides error bounds and backward error estimates + !! for the solution. iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37817,16 +37813,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sppsv( uplo, n, nrhs, ap, b, ldb, info ) - !> SPPSV computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite matrix stored in - !> packed format and X and B are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**T* U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is a lower triangular - !> matrix. The factored form of A is then used to solve the system of - !> equations A * X = B. + !! SPPSV computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite matrix stored in + !! packed format and X and B are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**T* U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is a lower triangular + !! matrix. The factored form of A is then used to solve the system of + !! equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37866,13 +37862,13 @@ module stdlib_linalg_lapack_s subroutine stdlib_sppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& - !> SPPSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to - !> compute the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite matrix stored in - !> packed format and X and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! SPPSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to + !! compute the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite matrix stored in + !! packed format and X and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38005,9 +38001,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spptri( uplo, n, ap, info ) - !> SPPTRI computes the inverse of a real symmetric positive definite - !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T - !> computed by SPPTRF. + !! SPPTRI computes the inverse of a real symmetric positive definite + !! matrix A using the Cholesky factorization A = U**T*U or A = L*L**T + !! computed by SPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38067,15 +38063,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spstf2( uplo, n, a, lda, piv, rank, tol, work, info ) - !> SPSTF2 computes the Cholesky factorization with complete - !> pivoting of a real symmetric positive semidefinite matrix A. - !> The factorization has the form - !> P**T * A * P = U**T * U , if UPLO = 'U', - !> P**T * A * P = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular, and - !> P is stored as vector PIV. - !> This algorithm does not attempt to check that A is positive - !> semidefinite. This version of the algorithm calls level 2 BLAS. + !! SPSTF2 computes the Cholesky factorization with complete + !! pivoting of a real symmetric positive semidefinite matrix A. + !! The factorization has the form + !! P**T * A * P = U**T * U , if UPLO = 'U', + !! P**T * A * P = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular, and + !! P is stored as vector PIV. + !! This algorithm does not attempt to check that A is positive + !! semidefinite. This version of the algorithm calls level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38246,15 +38242,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spstrf( uplo, n, a, lda, piv, rank, tol, work, info ) - !> SPSTRF computes the Cholesky factorization with complete - !> pivoting of a real symmetric positive semidefinite matrix A. - !> The factorization has the form - !> P**T * A * P = U**T * U , if UPLO = 'U', - !> P**T * A * P = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular, and - !> P is stored as vector PIV. - !> This algorithm does not attempt to check that A is positive - !> semidefinite. This version of the algorithm calls level 3 BLAS. + !! SPSTRF computes the Cholesky factorization with complete + !! pivoting of a real symmetric positive semidefinite matrix A. + !! The factorization has the form + !! P**T * A * P = U**T * U , if UPLO = 'U', + !! P**T * A * P = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular, and + !! P is stored as vector PIV. + !! This algorithm does not attempt to check that A is positive + !! semidefinite. This version of the algorithm calls level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38457,12 +38453,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spttrs( n, nrhs, d, e, b, ldb, info ) - !> SPTTRS solves a tridiagonal system of the form - !> A * X = B - !> using the L*D*L**T factorization of A computed by SPTTRF. D is a - !> diagonal matrix specified in the vector D, L is a unit bidiagonal - !> matrix whose subdiagonal is specified in the vector E, and X and B - !> are N by NRHS matrices. + !! SPTTRS solves a tridiagonal system of the form + !! A * X = B + !! using the L*D*L**T factorization of A computed by SPTTRF. D is a + !! diagonal matrix specified in the vector D, L is a unit bidiagonal + !! matrix whose subdiagonal is specified in the vector E, and X and B + !! are N by NRHS matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38512,8 +38508,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, lda, & - !> SSB2ST_KERNELS is an internal routine used by the SSYTRD_SB2ST - !> subroutine. + !! SSB2ST_KERNELS is an internal routine used by the SSYTRD_SB2ST + !! subroutine. v, tau, ldvt, work) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38657,11 +38653,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sspcon( uplo, n, ap, ipiv, anorm, rcond, work, iwork,info ) - !> SSPCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric packed matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by SSPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! SSPCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric packed matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by SSPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38739,10 +38735,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& - !> SSPRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite - !> and packed, and provides error bounds and backward error estimates - !> for the solution. + !! SSPRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric indefinite + !! and packed, and provides error bounds and backward error estimates + !! for the solution. iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38932,17 +38928,17 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> SSPSV computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric 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**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, D is symmetric 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. + !! SSPSV computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric 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**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, D is symmetric 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38983,12 +38979,12 @@ module stdlib_linalg_lapack_s subroutine stdlib_sspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & - !> SSPSVX uses the diagonal pivoting factorization A = U*D*U**T or - !> A = L*D*L**T to compute the solution to a real system of linear - !> equations A * X = B, where A is an N-by-N symmetric matrix stored - !> in packed format and X and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! SSPSVX uses the diagonal pivoting factorization A = U*D*U**T or + !! A = L*D*L**T to compute the solution to a real system of linear + !! equations A * X = B, where A is an N-by-N symmetric matrix stored + !! in packed format and X and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39061,9 +39057,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssptrd( uplo, n, ap, d, e, tau, info ) - !> SSPTRD reduces a real symmetric matrix A stored in packed form to - !> symmetric tridiagonal form T by an orthogonal similarity - !> transformation: Q**T * A * Q = T. + !! SSPTRD reduces a real symmetric matrix A stored in packed form to + !! symmetric tridiagonal form T by an orthogonal similarity + !! transformation: Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39158,11 +39154,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & - !> SSTEIN computes the eigenvectors of a real symmetric tridiagonal - !> matrix T corresponding to specified eigenvalues, using inverse - !> iteration. - !> The maximum number of iterations allowed for each eigenvector is - !> specified by an internal parameter MAXITS (currently set to 5). + !! SSTEIN computes the eigenvectors of a real symmetric tridiagonal + !! matrix T corresponding to specified eigenvalues, using inverse + !! iteration. + !! The maximum number of iterations allowed for each eigenvector is + !! specified by an internal parameter MAXITS (currently set to 5). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39356,11 +39352,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssteqr( compz, n, d, e, z, ldz, work, info ) - !> SSTEQR computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric tridiagonal matrix using the implicit QL or QR method. - !> The eigenvectors of a full or band symmetric matrix can also be found - !> if SSYTRD or SSPTRD or SSBTRD has been used to reduce this matrix to - !> tridiagonal form. + !! SSTEQR computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric tridiagonal matrix using the implicit QL or QR method. + !! The eigenvectors of a full or band symmetric matrix can also be found + !! if SSYTRD or SSPTRD or SSBTRD has been used to reduce this matrix to + !! tridiagonal form. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39673,8 +39669,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssterf( n, d, e, info ) - !> SSTERF computes all eigenvalues of a symmetric tridiagonal matrix - !> using the Pal-Walker-Kahan variant of the QL or QR algorithm. + !! SSTERF computes all eigenvalues of a symmetric tridiagonal matrix + !! using the Pal-Walker-Kahan variant of the QL or QR algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39907,8 +39903,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sstev( jobz, n, d, e, z, ldz, work, info ) - !> SSTEV computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric tridiagonal matrix A. + !! SSTEV computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric tridiagonal matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39990,10 +39986,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sstevx( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & - !> SSTEVX computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix A. Eigenvalues and - !> eigenvectors can be selected by specifying either a range of values - !> or a range of indices for the desired eigenvalues. + !! SSTEVX computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix A. Eigenvalues and + !! eigenvectors can be selected by specifying either a range of values + !! or a range of indices for the desired eigenvalues. work, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40184,11 +40180,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssycon( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) - !> SSYCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by SSYTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! SSYCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by SSYTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40267,11 +40263,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,iwork, info ) - !> SSYCON_ROOK estimates the reciprocal of the condition number (in the - !> 1-norm) of a real symmetric matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by SSYTRF_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))). + !! SSYCON_ROOK estimates the reciprocal of the condition number (in the + !! 1-norm) of a real symmetric matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by SSYTRF_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))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40350,9 +40346,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & - !> SSYRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite, and - !> provides error bounds and backward error estimates for the solution. + !! SSYRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric indefinite, and + !! provides error bounds and backward error estimates for the solution. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40539,20 +40535,20 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,work, lwork, info ) - !> SSYSV_RK computes the solution to a real system of linear - !> equations A * X = B, where A is an N-by-N symmetric 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**T)*(P**T), if UPLO = 'U', or - !> A = P*L*D*(L**T)*(P**T), if UPLO = 'L', - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric and block - !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. - !> SSYTRF_RK is called to compute the factorization of a real - !> symmetric matrix. The factored form of A is then used to solve - !> the system of equations A * X = B by calling BLAS3 routine SSYTRS_3. + !! SSYSV_RK computes the solution to a real system of linear + !! equations A * X = B, where A is an N-by-N symmetric 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**T)*(P**T), if UPLO = 'U', or + !! A = P*L*D*(L**T)*(P**T), if UPLO = 'L', + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric and block + !! diagonal with 1-by-1 and 2-by-2 diagonal blocks. + !! SSYTRF_RK is called to compute the factorization of a real + !! symmetric matrix. The factored form of A is then used to solve + !! the system of equations A * X = B by calling BLAS3 routine SSYTRS_3. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40616,22 +40612,22 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> SSYSV_ROOK computes the solution to a real system of linear - !> equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> The 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 symmetric and block diagonal with - !> 1-by-1 and 2-by-2 diagonal blocks. - !> SSYTRF_ROOK is called to compute the factorization of a real - !> symmetric 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 SSYTRS_ROOK. + !! SSYSV_ROOK computes the solution to a real system of linear + !! equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! The 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 symmetric and block diagonal with + !! 1-by-1 and 2-by-2 diagonal blocks. + !! SSYTRF_ROOK is called to compute the factorization of a real + !! symmetric 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 SSYTRS_ROOK. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40695,8 +40691,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytd2( uplo, n, a, lda, d, e, tau, info ) - !> SSYTD2 reduces a real symmetric matrix A to symmetric tridiagonal - !> form T by an orthogonal similarity transformation: Q**T * A * Q = T. + !! SSYTD2 reduces a real symmetric matrix A to symmetric tridiagonal + !! form T by an orthogonal similarity transformation: Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -40789,13 +40785,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytf2( uplo, n, a, lda, ipiv, info ) - !> SSYTF2 computes the factorization of a real symmetric matrix A using - !> the Bunch-Kaufman diagonal pivoting method: - !> 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, U**T is the transpose of U, and D is symmetric 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. + !! SSYTF2 computes the factorization of a real symmetric matrix A using + !! the Bunch-Kaufman diagonal pivoting method: + !! 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, U**T is the transpose of U, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41074,9 +41070,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) - !> SSYTRD reduces a real symmetric matrix A to real symmetric - !> tridiagonal form T by an orthogonal similarity transformation: - !> Q**T * A * Q = T. + !! SSYTRD reduces a real symmetric matrix A to real symmetric + !! tridiagonal form T by an orthogonal similarity transformation: + !! Q**T * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41200,9 +41196,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytrd_sb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & - !> SSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric - !> tridiagonal form T by a orthogonal similarity transformation: - !> Q**T * A * Q = T. + !! SSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric + !! tridiagonal form T by a orthogonal similarity transformation: + !! Q**T * A * Q = T. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41446,14 +41442,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytrf( uplo, n, a, lda, ipiv, work, lwork, info ) - !> SSYTRF computes the factorization of a real symmetric matrix A using - !> the Bunch-Kaufman diagonal pivoting method. The form of the - !> factorization is - !> A = U**T*D*U or A = L*D*L**T - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and D is symmetric 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. + !! SSYTRF computes the factorization of a real symmetric matrix A using + !! the Bunch-Kaufman diagonal pivoting method. The form of the + !! factorization is + !! A = U**T*D*U or A = L*D*L**T + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41572,12 +41568,12 @@ module stdlib_linalg_lapack_s subroutine stdlib_stbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,iwork, info ) - !> STBCON estimates the reciprocal of the condition number of a - !> triangular band matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! STBCON estimates the reciprocal of the condition number of a + !! triangular band matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41676,9 +41672,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stftri( transr, uplo, diag, n, a, info ) - !> STFTRI computes the inverse of a triangular matrix A stored in RFP - !> format. - !> This is a Level 3 BLAS version of the algorithm. + !! STFTRI computes the inverse of a triangular matrix A stored in RFP + !! format. + !! This is a Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41859,34 +41855,34 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & - !> STGSY2 solves the generalized Sylvester equation: - !> A * R - L * B = scale * C (1) - !> D * R - L * E = scale * F, - !> using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices, - !> (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M, - !> N-by-N and M-by-N, respectively, with real entries. (A, D) and (B, E) - !> must be in generalized Schur canonical form, i.e. A, B are upper - !> quasi triangular and D, E are upper triangular. The solution (R, L) - !> overwrites (C, F). 0 <= SCALE <= 1 is an output scaling factor - !> chosen to avoid overflow. - !> In matrix notation solving equation (1) corresponds to solve - !> Z*x = scale*b, where Z is defined as - !> Z = [ kron(In, A) -kron(B**T, Im) ] (2) - !> [ kron(In, D) -kron(E**T, Im) ], - !> Ik is the identity matrix of size k and X**T is the transpose of X. - !> kron(X, Y) is the Kronecker product between the matrices X and Y. - !> In the process of solving (1), we solve a number of such systems - !> where Dim(In), Dim(In) = 1 or 2. - !> If TRANS = 'T', solve the transposed system Z**T*y = scale*b for y, - !> which is equivalent to solve for R and L in - !> A**T * R + D**T * L = scale * C (3) - !> R * B**T + L * E**T = scale * -F - !> This case is used to compute an estimate of Dif[(A, D), (B, E)] = - !> sigma_min(Z) using reverse communication with SLACON. - !> STGSY2 also (IJOB >= 1) contributes to the computation in STGSYL - !> of an upper bound on the separation between to matrix pairs. Then - !> the input (A, D), (B, E) are sub-pencils of the matrix pair in - !> STGSYL. See STGSYL for details. + !! STGSY2 solves the generalized Sylvester equation: + !! A * R - L * B = scale * C (1) + !! D * R - L * E = scale * F, + !! using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices, + !! (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M, + !! N-by-N and M-by-N, respectively, with real entries. (A, D) and (B, E) + !! must be in generalized Schur canonical form, i.e. A, B are upper + !! quasi triangular and D, E are upper triangular. The solution (R, L) + !! overwrites (C, F). 0 <= SCALE <= 1 is an output scaling factor + !! chosen to avoid overflow. + !! In matrix notation solving equation (1) corresponds to solve + !! Z*x = scale*b, where Z is defined as + !! Z = [ kron(In, A) -kron(B**T, Im) ] (2) + !! [ kron(In, D) -kron(E**T, Im) ], + !! Ik is the identity matrix of size k and X**T is the transpose of X. + !! kron(X, Y) is the Kronecker product between the matrices X and Y. + !! In the process of solving (1), we solve a number of such systems + !! where Dim(In), Dim(In) = 1 or 2. + !! If TRANS = 'T', solve the transposed system Z**T*y = scale*b for y, + !! which is equivalent to solve for R and L in + !! A**T * R + D**T * L = scale * C (3) + !! R * B**T + L * E**T = scale * -F + !! This case is used to compute an estimate of Dif[(A, D), (B, E)] = + !! sigma_min(Z) using reverse communication with SLACON. + !! STGSY2 also (IJOB >= 1) contributes to the computation in STGSYL + !! of an upper bound on the separation between to matrix pairs. Then + !! the input (A, D), (B, E) are sub-pencils of the matrix pair in + !! STGSYL. See STGSYL for details. ldf, scale, rdsum, rdscal,iwork, pq, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42499,34 +42495,34 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & - !> STGSYL solves the generalized Sylvester equation: - !> A * R - L * B = scale * C (1) - !> D * R - L * E = scale * F - !> where R and L are unknown m-by-n matrices, (A, D), (B, E) and - !> (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n, - !> respectively, with real entries. (A, D) and (B, E) must be in - !> generalized (real) Schur canonical form, i.e. A, B are upper quasi - !> triangular and D, E are upper triangular. - !> The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output - !> scaling factor chosen to avoid overflow. - !> In matrix notation (1) is equivalent to solve Zx = scale b, where - !> Z is defined as - !> Z = [ kron(In, A) -kron(B**T, Im) ] (2) - !> [ kron(In, D) -kron(E**T, Im) ]. - !> Here Ik is the identity matrix of size k and X**T is the transpose of - !> X. kron(X, Y) is the Kronecker product between the matrices X and Y. - !> If TRANS = 'T', STGSYL solves the transposed system Z**T*y = scale*b, - !> which is equivalent to solve for R and L in - !> A**T * R + D**T * L = scale * C (3) - !> R * B**T + L * E**T = scale * -F - !> This case (TRANS = 'T') is used to compute an one-norm-based estimate - !> of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D) - !> and (B,E), using SLACON. - !> If IJOB >= 1, STGSYL computes a Frobenius norm-based estimate - !> of Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the - !> reciprocal of the smallest singular value of Z. See [1-2] for more - !> information. - !> This is a level 3 BLAS algorithm. + !! STGSYL solves the generalized Sylvester equation: + !! A * R - L * B = scale * C (1) + !! D * R - L * E = scale * F + !! where R and L are unknown m-by-n matrices, (A, D), (B, E) and + !! (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n, + !! respectively, with real entries. (A, D) and (B, E) must be in + !! generalized (real) Schur canonical form, i.e. A, B are upper quasi + !! triangular and D, E are upper triangular. + !! The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output + !! scaling factor chosen to avoid overflow. + !! In matrix notation (1) is equivalent to solve Zx = scale b, where + !! Z is defined as + !! Z = [ kron(In, A) -kron(B**T, Im) ] (2) + !! [ kron(In, D) -kron(E**T, Im) ]. + !! Here Ik is the identity matrix of size k and X**T is the transpose of + !! X. kron(X, Y) is the Kronecker product between the matrices X and Y. + !! If TRANS = 'T', STGSYL solves the transposed system Z**T*y = scale*b, + !! which is equivalent to solve for R and L in + !! A**T * R + D**T * L = scale * C (3) + !! R * B**T + L * E**T = scale * -F + !! This case (TRANS = 'T') is used to compute an one-norm-based estimate + !! of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D) + !! and (B,E), using SLACON. + !! If IJOB >= 1, STGSYL computes a Frobenius norm-based estimate + !! of Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the + !! reciprocal of the smallest singular value of Z. See [1-2] for more + !! information. + !! This is a level 3 BLAS algorithm. ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42828,12 +42824,12 @@ module stdlib_linalg_lapack_s subroutine stdlib_stpcon( norm, uplo, diag, n, ap, rcond, work, iwork,info ) - !> STPCON estimates the reciprocal of the condition number of a packed - !> triangular matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! STPCON estimates the reciprocal of the condition number of a packed + !! triangular matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42927,9 +42923,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) - !> STPLQT2 computes a LQ a factorization of a real "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. + !! STPLQT2 computes a LQ a factorization of a real "triangular-pentagonal" + !! matrix C, which is composed of a triangular block A and pentagonal block B, + !! using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43024,9 +43020,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, ldb, & - !> STPMLQT applies a real orthogonal matrix Q obtained from a - !> "triangular-pentagonal" real block reflector H to a general - !> real matrix C, which consists of two blocks A and B. + !! STPMLQT applies a real orthogonal matrix Q obtained from a + !! "triangular-pentagonal" real block reflector H to a general + !! real matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43142,9 +43138,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, ldb, & - !> STPMQRT applies a real orthogonal matrix Q obtained from a - !> "triangular-pentagonal" real block reflector H to a general - !> real matrix C, which consists of two blocks A and B. + !! STPMQRT applies a real orthogonal matrix Q obtained from a + !! "triangular-pentagonal" real block reflector H to a general + !! real matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43262,9 +43258,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) - !> STPQRT2 computes a QR factorization of a real "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. + !! STPQRT2 computes a QR factorization of a real "triangular-pentagonal" + !! matrix C, which is composed of a triangular block A and pentagonal block B, + !! using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43353,12 +43349,12 @@ module stdlib_linalg_lapack_s subroutine stdlib_strcon( norm, uplo, diag, n, a, lda, rcond, work,iwork, info ) - !> STRCON estimates the reciprocal of the condition number of a - !> triangular matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! STRCON estimates the reciprocal of the condition number of a + !! triangular matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43454,12 +43450,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stzrzf( m, n, a, lda, tau, work, lwork, info ) - !> STZRZF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A - !> to upper triangular form by means of orthogonal transformations. - !> The upper trapezoidal matrix A is factored as - !> A = ( R 0 ) * Z, - !> where Z is an N-by-N orthogonal matrix and R is an M-by-M upper - !> triangular matrix. + !! STZRZF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A + !! to upper triangular form by means of orthogonal transformations. + !! The upper trapezoidal matrix A is factored as + !! A = ( R 0 ) * Z, + !! where Z is an N-by-N orthogonal matrix and R is an M-by-M upper + !! triangular matrix. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43570,14 +43566,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) - !> SGBSV computes the solution to a real 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. + !! SGBSV computes the solution to a real 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43622,12 +43618,12 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & - !> SGBSVX uses the LU factorization to compute the solution to a real - !> system of linear equations A * X = B, A**T * X = B, or A**H * 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. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! SGBSVX uses the LU factorization to compute the solution to a real + !! system of linear equations A * X = B, A**T * X = B, or A**H * 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. + !! Error bounds on the solution and a condition estimate are also + !! provided. c, b, ldb, x, ldx,rcond, ferr, berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43848,14 +43844,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgebal( job, n, a, lda, ilo, ihi, scale, info ) - !> SGEBAL balances a general real 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. + !! SGEBAL balances a general real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44016,9 +44012,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgebd2( m, n, a, lda, d, e, tauq, taup, work, info ) - !> SGEBD2 reduces a real general m by n matrix A to upper or lower - !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. - !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. + !! SGEBD2 reduces a real general m by n matrix A to upper or lower + !! bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. + !! If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44108,8 +44104,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgehd2( n, ilo, ihi, a, lda, tau, work, info ) - !> SGEHD2 reduces a real general matrix A to upper Hessenberg form H by - !> an orthogonal similarity transformation: Q**T * A * Q = H . + !! SGEHD2 reduces a real general matrix A to upper Hessenberg form H by + !! an orthogonal similarity transformation: Q**T * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44160,12 +44156,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgelq2( m, n, a, lda, tau, work, info ) - !> SGELQ2 computes an LQ factorization of a real 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. + !! SGELQ2 computes an LQ factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44214,12 +44210,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgelqf( m, n, a, lda, tau, work, lwork, info ) - !> SGELQF computes an LQ factorization of a real 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. + !! SGELQF computes an LQ factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44311,10 +44307,10 @@ module stdlib_linalg_lapack_s pure recursive subroutine stdlib_sgelqt3( m, n, a, lda, t, ldt, info ) - !> SGELQT3 recursively computes a LQ factorization of a real 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. + !! SGELQT3 recursively computes a LQ factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44398,8 +44394,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgeql2( m, n, a, lda, tau, work, info ) - !> SGEQL2 computes a QL factorization of a real m by n matrix A: - !> A = Q * L. + !! SGEQL2 computes a QL factorization of a real m by n matrix A: + !! A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44447,8 +44443,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgeqlf( m, n, a, lda, tau, work, lwork, info ) - !> SGEQLF computes a QL factorization of a real M-by-N matrix A: - !> A = Q * L. + !! SGEQLF computes a QL factorization of a real M-by-N matrix A: + !! A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44553,13 +44549,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgeqr2( m, n, a, lda, tau, work, info ) - !> SGEQR2 computes a QR factorization of a real 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. + !! SGEQR2 computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44608,14 +44604,14 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgeqr2p( m, n, a, lda, tau, work, info ) - !> SGEQR2P computes a QR factorization of a real 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. + !! SGEQR2P computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44664,13 +44660,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgeqrf( m, n, a, lda, tau, work, lwork, info ) - !> SGEQRF computes a QR factorization of a real 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. + !! SGEQRF computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44766,14 +44762,14 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgeqrfp( m, n, a, lda, tau, work, lwork, info ) - !> SGEQR2P computes a QR factorization of a real 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. + !! SGEQR2P computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44865,8 +44861,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgeqrt2( m, n, a, lda, t, ldt, info ) - !> SGEQRT2 computes a QR factorization of a real M-by-N matrix A, - !> using the compact WY representation of Q. + !! SGEQRT2 computes a QR factorization of a real M-by-N matrix A, + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44933,10 +44929,10 @@ module stdlib_linalg_lapack_s pure recursive subroutine stdlib_sgeqrt3( m, n, a, lda, t, ldt, info ) - !> SGEQRT3 recursively computes a QR factorization of a real 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. + !! SGEQRT3 recursively computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45018,9 +45014,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & - !> SGERFS improves the computed solution to a system of linear - !> equations and provides error bounds and backward error estimates for - !> the solution. + !! SGERFS improves the computed solution to a system of linear + !! equations and provides error bounds and backward error estimates for + !! the solution. berr, work, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45211,8 +45207,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgerq2( m, n, a, lda, tau, work, info ) - !> SGERQ2 computes an RQ factorization of a real m by n matrix A: - !> A = R * Q. + !! SGERQ2 computes an RQ factorization of a real m by n matrix A: + !! A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45260,8 +45256,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgerqf( m, n, a, lda, tau, work, lwork, info ) - !> SGERQF computes an RQ factorization of a real M-by-N matrix A: - !> A = R * Q. + !! SGERQF computes an RQ factorization of a real M-by-N matrix A: + !! A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45366,14 +45362,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgetrf( m, n, a, lda, ipiv, info ) - !> SGETRF 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. + !! SGETRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45444,31 +45440,31 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & - !> SGGHD3 reduces a pair of real matrices (A,B) to generalized upper - !> Hessenberg form using orthogonal 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 orthogonal matrix Q to the left side - !> of the equation. - !> This subroutine simultaneously reduces A to a Hessenberg matrix H: - !> Q**T*A*Z = H - !> and transforms B to another upper triangular matrix T: - !> Q**T*B*Z = T - !> in order to reduce the problem to its standard form - !> H*y = lambda*T*y - !> where y = Z**T*x. - !> The orthogonal 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**T = (Q1*Q) * H * (Z1*Z)**T - !> Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T - !> If Q1 is the orthogonal matrix from the QR factorization of B in the - !> original equation A*x = lambda*B*x, then SGGHD3 reduces the original - !> problem to generalized Hessenberg form. - !> This is a blocked variant of SGGHRD, using matrix-matrix - !> multiplications for parts of the computation to enhance performance. + !! SGGHD3 reduces a pair of real matrices (A,B) to generalized upper + !! Hessenberg form using orthogonal 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 orthogonal matrix Q to the left side + !! of the equation. + !! This subroutine simultaneously reduces A to a Hessenberg matrix H: + !! Q**T*A*Z = H + !! and transforms B to another upper triangular matrix T: + !! Q**T*B*Z = T + !! in order to reduce the problem to its standard form + !! H*y = lambda*T*y + !! where y = Z**T*x. + !! The orthogonal 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**T = (Q1*Q) * H * (Z1*Z)**T + !! Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T + !! If Q1 is the orthogonal matrix from the QR factorization of B in the + !! original equation A*x = lambda*B*x, then SGGHD3 reduces the original + !! problem to generalized Hessenberg form. + !! This is a blocked variant of SGGHRD, using matrix-matrix + !! multiplications for parts of the computation to enhance performance. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45971,24 +45967,24 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) - !> SGGQRF 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 orthogonal matrix, Z is a P-by-P orthogonal - !> 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**T*(inv(T)*R) - !> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the - !> transpose of the matrix Z. + !! SGGQRF 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 orthogonal matrix, Z is a P-by-P orthogonal + !! 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**T*(inv(T)*R) + !! where inv(B) denotes the inverse of the matrix B, and Z**T denotes the + !! transpose of the matrix Z. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46049,24 +46045,24 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) - !> SGGRQF 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 orthogonal matrix, Z is a P-by-P orthogonal - !> 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**T - !> where inv(B) denotes the inverse of the matrix B, and Z**T denotes the - !> transpose of the matrix Z. + !! SGGRQF 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 orthogonal matrix, Z is a P-by-P orthogonal + !! 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**T + !! where inv(B) denotes the inverse of the matrix B, and Z**T denotes the + !! transpose of the matrix Z. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46127,11 +46123,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, iwork, info & - !> SGTCON estimates the reciprocal of the condition number of a real - !> tridiagonal matrix A using the LU factorization as computed by - !> SGTTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! SGTCON estimates the reciprocal of the condition number of a real + !! tridiagonal matrix A using the LU factorization as computed by + !! SGTTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46210,9 +46206,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, x, & - !> SGTRFS 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. + !! SGTRFS 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. ldx, ferr, berr, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46412,12 +46408,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & - !> SGTSVX uses the LU factorization to compute the solution to a real - !> system of linear equations A * X = B or A**T * X = B, - !> where A is a tridiagonal matrix of order N and X and B are N-by-NRHS - !> matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! SGTSVX uses the LU factorization to compute the solution to a real + !! system of linear equations A * X = B or A**T * X = B, + !! where A is a tridiagonal matrix of order N and X and B are N-by-NRHS + !! matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ldb, x, ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46501,49 +46497,49 @@ module stdlib_linalg_lapack_s subroutine stdlib_shgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alphar, alphai, & - !> SHGEQZ computes the eigenvalues of a real 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 real matrix pair (A,B): - !> A = Q1*H*Z1**T, B = Q1*T*Z1**T, - !> as computed by SGGHRD. - !> If JOB='S', then the Hessenberg-triangular pair (H,T) is - !> also reduced to generalized Schur form, - !> H = Q*S*Z**T, T = Q*P*Z**T, - !> where Q and Z are orthogonal matrices, P is an upper triangular - !> matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2 - !> diagonal blocks. - !> The 1-by-1 blocks correspond to real eigenvalues of the matrix pair - !> (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of - !> eigenvalues. - !> Additionally, the 2-by-2 upper triangular diagonal blocks of P - !> corresponding to 2-by-2 blocks of S are reduced to positive diagonal - !> form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0, - !> P(j,j) > 0, and P(j+1,j+1) > 0. - !> Optionally, the orthogonal matrix Q from the generalized Schur - !> factorization may be postmultiplied into an input matrix Q1, and the - !> orthogonal matrix Z may be postmultiplied into an input matrix Z1. - !> If Q1 and Z1 are the orthogonal matrices from SGGHRD that reduced - !> the matrix pair (A,B) to generalized upper Hessenberg form, then the - !> output matrices Q1*Q and Z1*Z are the orthogonal factors from the - !> generalized Schur factorization of (A,B): - !> A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T. - !> 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. - !> Real 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. + !! SHGEQZ computes the eigenvalues of a real 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 real matrix pair (A,B): + !! A = Q1*H*Z1**T, B = Q1*T*Z1**T, + !! as computed by SGGHRD. + !! If JOB='S', then the Hessenberg-triangular pair (H,T) is + !! also reduced to generalized Schur form, + !! H = Q*S*Z**T, T = Q*P*Z**T, + !! where Q and Z are orthogonal matrices, P is an upper triangular + !! matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2 + !! diagonal blocks. + !! The 1-by-1 blocks correspond to real eigenvalues of the matrix pair + !! (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of + !! eigenvalues. + !! Additionally, the 2-by-2 upper triangular diagonal blocks of P + !! corresponding to 2-by-2 blocks of S are reduced to positive diagonal + !! form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0, + !! P(j,j) > 0, and P(j+1,j+1) > 0. + !! Optionally, the orthogonal matrix Q from the generalized Schur + !! factorization may be postmultiplied into an input matrix Q1, and the + !! orthogonal matrix Z may be postmultiplied into an input matrix Z1. + !! If Q1 and Z1 are the orthogonal matrices from SGGHRD that reduced + !! the matrix pair (A,B) to generalized upper Hessenberg form, then the + !! output matrices Q1*Q and Z1*Z are the orthogonal factors from the + !! generalized Schur factorization of (A,B): + !! A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T. + !! 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. + !! Real 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. beta, q, ldq, z, ldz, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47376,13 +47372,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) - !> SLABRD reduces the first NB rows and columns of a real general - !> m by n matrix A to upper or lower bidiagonal form by an orthogonal - !> transformation Q**T * 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 SGEBRD + !! SLABRD reduces the first NB rows and columns of a real general + !! m by n matrix A to upper or lower bidiagonal form by an orthogonal + !! transformation Q**T * 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 SGEBRD ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47506,13 +47502,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sladiv( a, b, c, d, p, q ) - !> SLADIV 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" + !! SLADIV 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" ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47574,16 +47570,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaed4( n, i, d, z, delta, rho, dlam, info ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48179,12 +48175,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaed8( icompq, k, n, qsiz, d, q, ldq, indxq, rho,cutpnt, z, dlamda, & - !> SLAED8 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. + !! SLAED8 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. q2, ldq2, w, perm, givptr,givcol, givnum, indxp, indx, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48402,10 +48398,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaed9( k, kstart, kstop, n, d, q, ldq, rho, dlamda, w,s, lds, info ) - !> SLAED9 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 SLAED4 and then stores the new matrix of - !> eigenvectors for use in calculating the next level of Z vectors. + !! SLAED9 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 SLAED4 and then stores the new matrix of + !! eigenvectors for use in calculating the next level of Z vectors. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48508,9 +48504,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaein( rightv, noinit, n, h, ldh, wr, wi, vr, vi, b,ldb, work, eps3, & - !> SLAEIN uses inverse iteration to find a right or left eigenvector - !> corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg - !> matrix H. + !! SLAEIN uses inverse iteration to find a right or left eigenvector + !! corresponding to the eigenvalue (WR,WI) of a real upper Hessenberg + !! matrix H. smlnum, bignum, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48854,23 +48850,23 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slagv2( a, lda, b, ldb, alphar, alphai, beta, csl, snl,csr, snr ) - !> SLAGV2 computes the Generalized Schur factorization of a real 2-by-2 - !> matrix pencil (A,B) where B is upper triangular. This routine - !> computes orthogonal (rotation) matrices given by CSL, SNL and CSR, - !> SNR such that - !> 1) if the pencil (A,B) has two real eigenvalues (include 0/0 or 1/0 - !> types), then - !> [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ] - !> [ 0 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ] - !> [ b11 b12 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] - !> [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ], - !> 2) if the pencil (A,B) has a pair of complex conjugate eigenvalues, - !> then - !> [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ] - !> [ a21 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ] - !> [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] - !> [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ] - !> where b11 >= b22 > 0. + !! SLAGV2 computes the Generalized Schur factorization of a real 2-by-2 + !! matrix pencil (A,B) where B is upper triangular. This routine + !! computes orthogonal (rotation) matrices given by CSL, SNL and CSR, + !! SNR such that + !! 1) if the pencil (A,B) has two real eigenvalues (include 0/0 or 1/0 + !! types), then + !! [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ] + !! [ 0 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ] + !! [ b11 b12 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] + !! [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ], + !! 2) if the pencil (A,B) has a pair of complex conjugate eigenvalues, + !! then + !! [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ] + !! [ a21 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ] + !! [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] + !! [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ] + !! where b11 >= b22 > 0. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49018,12 +49014,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) - !> SLAHR2 reduces the first NB columns of A real general n-BY-(n-k+1) - !> matrix A so that elements below the k-th subdiagonal are zero. The - !> reduction is performed by an orthogonal similarity transformation - !> Q**T * A * Q. The routine returns the matrices V and T which determine - !> Q as a block reflector I - V*T*V**T, and also the matrix Y = A * V * T. - !> This is an auxiliary routine called by SGEHRD. + !! SLAHR2 reduces the first NB columns of A real general n-BY-(n-k+1) + !! matrix A so that elements below the k-th subdiagonal are zero. The + !! reduction is performed by an orthogonal similarity transformation + !! Q**T * A * Q. The routine returns the matrices V and T which determine + !! Q as a block reflector I - V*T*V**T, and also the matrix Y = A * V * T. + !! This is an auxiliary routine called by SGEHRD. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49106,31 +49102,31 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaln2( ltrans, na, nw, smin, ca, a, lda, d1, d2, b,ldb, wr, wi, x, & - !> SLALN2 solves a system of the form (ca A - w D ) X = s B - !> or (ca A**T - w D) X = s B with possible scaling ("s") and - !> perturbation of A. (A**T means A-transpose.) - !> A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA - !> real diagonal matrix, w is a real or complex value, and X and B are - !> NA x 1 matrices -- real if w is real, complex if w is complex. NA - !> may be 1 or 2. - !> If w is complex, X and B are represented as NA x 2 matrices, - !> the first column of each being the real part and the second - !> being the imaginary part. - !> "s" is a scaling factor (<= 1), computed by SLALN2, which is - !> so chosen that X can be computed without overflow. X is further - !> scaled if necessary to assure that norm(ca A - w D)*norm(X) is less - !> than overflow. - !> If both singular values of (ca A - w D) are less than SMIN, - !> SMIN*identity will be used instead of (ca A - w D). If only one - !> singular value is less than SMIN, one element of (ca A - w D) will be - !> perturbed enough to make the smallest singular value roughly SMIN. - !> If both singular values are at least SMIN, (ca A - w D) will not be - !> perturbed. In any case, the perturbation will be at most some small - !> multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values - !> are computed by infinity-norm approximations, and thus will only be - !> correct to a factor of 2 or so. - !> Note: all input quantities are assumed to be smaller than overflow - !> by a reasonable factor. (See BIGNUM.) + !! SLALN2 solves a system of the form (ca A - w D ) X = s B + !! or (ca A**T - w D) X = s B with possible scaling ("s") and + !! perturbation of A. (A**T means A-transpose.) + !! A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA + !! real diagonal matrix, w is a real or complex value, and X and B are + !! NA x 1 matrices -- real if w is real, complex if w is complex. NA + !! may be 1 or 2. + !! If w is complex, X and B are represented as NA x 2 matrices, + !! the first column of each being the real part and the second + !! being the imaginary part. + !! "s" is a scaling factor (<= 1), computed by SLALN2, which is + !! so chosen that X can be computed without overflow. X is further + !! scaled if necessary to assure that norm(ca A - w D)*norm(X) is less + !! than overflow. + !! If both singular values of (ca A - w D) are less than SMIN, + !! SMIN*identity will be used instead of (ca A - w D). If only one + !! singular value is less than SMIN, one element of (ca A - w D) will be + !! perturbed enough to make the smallest singular value roughly SMIN. + !! If both singular values are at least SMIN, (ca A - w D) will not be + !! perturbed. In any case, the perturbation will be at most some small + !! multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values + !! are computed by infinity-norm approximations, and thus will only be + !! correct to a factor of 2 or so. + !! Note: all input quantities are assumed to be smaller than overflow + !! by a reasonable factor. (See BIGNUM.) ldx, scale, xnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49431,26 +49427,26 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, & - !> SLALS0 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). + !! SLALS0 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). givcol, ldgcol, givnum, ldgnum,poles, difl, difr, z, k, c, s, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49628,13 +49624,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & - !> SLAMSWLQ overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product of blocked - !> elementary reflectors computed by short wide LQ - !> factorization (SLASWLQ) + !! SLAMSWLQ overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product of blocked + !! elementary reflectors computed by short wide LQ + !! factorization (SLASWLQ) lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49786,13 +49782,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & - !> SLAMTSQR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product - !> of blocked elementary reflectors computed by tall skinny - !> QR factorization (SLATSQR) + !! SLAMTSQR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product + !! of blocked elementary reflectors computed by tall skinny + !! QR factorization (SLATSQR) lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49948,14 +49944,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slanv2( a, b, c, d, rt1r, rt1i, rt2r, rt2i, cs, sn ) - !> SLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric - !> matrix in standard form: - !> [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ] - !> [ C D ] [ SN CS ] [ CC DD ] [-SN CS ] - !> where either - !> 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or - !> 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex - !> conjugate eigenvalues. + !! SLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric + !! matrix in standard form: + !! [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ] + !! [ C D ] [ SN CS ] [ CC DD ] [-SN CS ] + !! where either + !! 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or + !! 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex + !! conjugate eigenvalues. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50094,12 +50090,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slapll( n, x, incx, y, incy, ssmin ) - !> 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. + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50134,9 +50130,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaqp2( m, n, offset, a, lda, jpvt, tau, vn1, vn2,work ) - !> SLAQP2 computes a QR factorization with column pivoting of - !> the block A(OFFSET+1:M,1:N). - !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. + !! SLAQP2 computes a QR factorization with column pivoting of + !! the block A(OFFSET+1:M,1:N). + !! The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50211,14 +50207,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & - !> SLAQPS computes a step of QR factorization with column pivoting - !> of a real 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. + !! SLAQPS computes a step of QR factorization with column pivoting + !! of a real 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. ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50345,8 +50341,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts,sr, si, h, ldh, & - !> SLAQR5 , called by SLAQR0, performs a - !> single small-bulge multi-shift QR sweep. + !! SLAQR5 , called by SLAQR0, performs a + !! single small-bulge multi-shift QR sweep. iloz, ihiz, z, ldz, v, ldv, u,ldu, nv, wv, ldwv, nh, wh, ldwh ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50752,24 +50748,24 @@ module stdlib_linalg_lapack_s subroutine stdlib_slaqtr( ltran, lreal, n, t, ldt, b, w, scale, x, work,info ) - !> SLAQTR 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 STRSNA. + !! SLAQTR 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 STRSNA. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51198,17 +51194,17 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasd3( nl, nr, sqre, k, d, q, ldq, dsigma, u, ldu, u2,ldu2, vt, ldvt,& - !> SLASD3 finds all the square roots of the roots of the secular - !> equation, as defined by the values in D and Z. It makes the - !> appropriate calls to SLASD4 and then updates the singular - !> vectors by matrix multiplication. - !> 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. - !> SLASD3 is called from SLASD1. + !! SLASD3 finds all the square roots of the roots of the secular + !! equation, as defined by the values in D and Z. It makes the + !! appropriate calls to SLASD4 and then updates the singular + !! vectors by matrix multiplication. + !! 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. + !! SLASD3 is called from SLASD1. vt2, ldvt2, idxc, ctot, z,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51400,41 +51396,41 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasd6( icompq, nl, nr, sqre, d, vf, vl, alpha, beta,idxq, perm, & - !> SLASD6 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, SLASD1, handles the case in which all singular - !> values and singular vectors of the bidiagonal matrix are desired. - !> SLASD6 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 SLASD6. 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 SLASD7. - !> The second stage consists of calculating the updated - !> singular values. This is done by finding the roots of the - !> secular equation via the routine SLASD4 (as called by SLASD8). - !> This routine also updates VF and VL and computes the distances - !> between the updated singular values and the old singular - !> values. - !> SLASD6 is called from SLASDA. + !! SLASD6 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, SLASD1, handles the case in which all singular + !! values and singular vectors of the bidiagonal matrix are desired. + !! SLASD6 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 SLASD6. 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 SLASD7. + !! The second stage consists of calculating the updated + !! singular values. This is done by finding the roots of the + !! secular equation via the routine SLASD4 (as called by SLASD8). + !! This routine also updates VF and VL and computes the distances + !! between the updated singular values and the old singular + !! values. + !! SLASD6 is called from SLASDA. givptr, givcol, ldgcol, givnum,ldgnum, poles, difl, difr, z, k, c, s, work,iwork, info ) ! -- lapack auxiliary routine -- @@ -51528,11 +51524,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sopgtr( uplo, n, ap, tau, q, ldq, work, info ) - !> SOPGTR generates a real orthogonal matrix Q which is defined as the - !> product of n-1 elementary reflectors H(i) of order n, as returned by - !> SSPTRD using packed storage: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! SOPGTR generates a real orthogonal matrix Q which is defined as the + !! product of n-1 elementary reflectors H(i) of order n, as returned by + !! SSPTRD using packed storage: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51615,16 +51611,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sopmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) - !> SOPMTR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by SSPTRD using packed - !> storage: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! SOPMTR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by SSPTRD using packed + !! storage: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51762,21 +51758,21 @@ module stdlib_linalg_lapack_s subroutine stdlib_sorbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> SORBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, - !> M-P, or M-Q. Routines SORBDB2, SORBDB3, and SORBDB4 handle cases in - !> which Q is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! SORBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, + !! M-P, or M-Q. Routines SORBDB2, SORBDB3, and SORBDB4 handle cases in + !! which Q is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by + !! angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51865,21 +51861,21 @@ module stdlib_linalg_lapack_s subroutine stdlib_sorbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> SORBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, - !> Q, or M-Q. Routines SORBDB1, SORBDB3, and SORBDB4 handle cases in - !> which P is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! SORBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, + !! Q, or M-Q. Routines SORBDB1, SORBDB3, and SORBDB4 handle cases in + !! which P is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are P-by-P bidiagonal matrices represented implicitly by + !! angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51978,21 +51974,21 @@ module stdlib_linalg_lapack_s subroutine stdlib_sorbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> SORBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, - !> Q, or M-Q. Routines SORBDB1, SORBDB2, and SORBDB4 handle cases in - !> which M-P is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! SORBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, + !! Q, or M-Q. Routines SORBDB1, SORBDB2, and SORBDB4 handle cases in + !! which M-P is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52090,21 +52086,21 @@ module stdlib_linalg_lapack_s subroutine stdlib_sorbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> SORBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, - !> M-P, or Q. Routines SORBDB1, SORBDB2, and SORBDB3 handle cases in - !> which M-Q is not the minimum dimension. - !> The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! SORBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, + !! M-P, or Q. Routines SORBDB1, SORBDB2, and SORBDB3 handle cases in + !! which M-Q is not the minimum dimension. + !! The orthogonal matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52232,21 +52228,21 @@ module stdlib_linalg_lapack_s subroutine stdlib_sorcsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & - !> SORCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with - !> orthonormal columns that has been partitioned into a 2-by-1 block - !> structure: - !> [ I1 0 0 ] - !> [ 0 C 0 ] - !> [ X11 ] [ U1 | ] [ 0 0 0 ] - !> X = [-----] = [---------] [----------] V1**T . - !> [ X21 ] [ | U2 ] [ 0 0 0 ] - !> [ 0 S 0 ] - !> [ 0 0 I2] - !> X11 is P-by-Q. The orthogonal matrices U1, U2, and V1 are P-by-P, - !> (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R - !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which - !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a - !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). + !! SORCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with + !! orthonormal columns that has been partitioned into a 2-by-1 block + !! structure: + !! [ I1 0 0 ] + !! [ 0 C 0 ] + !! [ X11 ] [ U1 | ] [ 0 0 0 ] + !! X = [-----] = [---------] [----------] V1**T . + !! [ X21 ] [ | U2 ] [ 0 0 0 ] + !! [ 0 S 0 ] + !! [ 0 0 I2] + !! X11 is P-by-Q. The orthogonal matrices U1, U2, and V1 are P-by-P, + !! (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R + !! nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which + !! R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a + !! K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52647,11 +52643,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorgtr( uplo, n, a, lda, tau, work, lwork, info ) - !> SORGTR generates a real orthogonal matrix Q which is defined as the - !> product of n-1 elementary reflectors of order N, as returned by - !> SSYTRD: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! SORGTR generates a real orthogonal matrix Q which is defined as the + !! product of n-1 elementary reflectors of order N, as returned by + !! SSYTRD: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52748,11 +52744,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorgtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) - !> SORGTSQR generates an M-by-N real matrix Q_out with orthonormal columns, - !> which are the first N columns of a product of real orthogonal - !> matrices of order M which are returned by SLATSQR - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> See the documentation for SLATSQR. + !! SORGTSQR generates an M-by-N real matrix Q_out with orthonormal columns, + !! which are the first N columns of a product of real orthogonal + !! matrices of order M which are returned by SLATSQR + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! See the documentation for SLATSQR. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52846,15 +52842,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sormtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & - !> SORMTR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by SSYTRD: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! SORMTR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by SSYTRD: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52962,12 +52958,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spbtrf( uplo, n, kd, ab, ldab, info ) - !> SPBTRF computes the Cholesky factorization of a real symmetric - !> positive definite band matrix A. - !> The factorization has the form - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. + !! SPBTRF computes the Cholesky factorization of a real symmetric + !! positive definite band matrix A. + !! The factorization has the form + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53161,9 +53157,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spftri( transr, uplo, n, a, info ) - !> SPFTRI computes the inverse of a real (symmetric) positive definite - !> matrix A using the Cholesky factorization A = U**T*U or A = L*L**T - !> computed by SPFTRF. + !! SPFTRI computes the inverse of a real (symmetric) positive definite + !! matrix A using the Cholesky factorization A = U**T*U or A = L*L**T + !! computed by SPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53319,13 +53315,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spotrf( uplo, n, a, lda, info ) - !> SPOTRF computes the Cholesky factorization of a real symmetric - !> positive definite matrix A. - !> The factorization has the form - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the block version of the algorithm, calling Level 3 BLAS. + !! SPOTRF computes the Cholesky factorization of a real symmetric + !! positive definite matrix A. + !! The factorization has the form + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the block version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53413,10 +53409,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sptrfs( n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr,berr, work, info ) - !> SPTRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric positive definite - !> and tridiagonal, and provides error bounds and backward error - !> estimates for the solution. + !! SPTRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric positive definite + !! and tridiagonal, and provides error bounds and backward error + !! estimates for the solution. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53585,11 +53581,11 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sptsv( n, nrhs, d, e, b, ldb, info ) - !> SPTSV computes the solution to a real system of linear equations - !> A*X = B, where A is an N-by-N symmetric positive definite tridiagonal - !> matrix, and X and B are N-by-NRHS matrices. - !> A is factored as A = L*D*L**T, and the factored form of A is then - !> used to solve the system of equations. + !! SPTSV computes the solution to a real system of linear equations + !! A*X = B, where A is an N-by-N symmetric positive definite tridiagonal + !! matrix, and X and B are N-by-NRHS matrices. + !! A is factored as A = L*D*L**T, and the factored form of A is then + !! used to solve the system of equations. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53626,12 +53622,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& - !> SPTSVX uses the factorization A = L*D*L**T to compute the solution - !> to a real system of linear equations A*X = B, where A is an N-by-N - !> symmetric positive definite tridiagonal matrix and X and B are - !> N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! SPTSVX uses the factorization A = L*D*L**T to compute the solution + !! to a real system of linear equations A*X = B, where A is an N-by-N + !! symmetric positive definite tridiagonal matrix and X and B are + !! N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. work, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53700,8 +53696,8 @@ module stdlib_linalg_lapack_s subroutine stdlib_ssbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,info ) - !> SSBEV computes all the eigenvalues and, optionally, eigenvectors of - !> a real symmetric band matrix A. + !! SSBEV computes all the eigenvalues and, optionally, eigenvectors of + !! a real symmetric band matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53802,10 +53798,10 @@ module stdlib_linalg_lapack_s subroutine stdlib_ssbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & - !> SSBEVX computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric band matrix A. Eigenvalues and eigenvectors can - !> be selected by specifying either a range of values or a range of - !> indices for the desired eigenvalues. + !! SSBEVX computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric band matrix A. Eigenvalues and eigenvectors can + !! be selected by specifying either a range of values or a range of + !! indices for the desired eigenvalues. m, w, z, ldz, work, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54028,10 +54024,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & - !> SSBGV computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-definite banded eigenproblem, of - !> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric - !> and banded, and B is also positive definite. + !! SSBGV computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-definite banded eigenproblem, of + !! the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric + !! and banded, and B is also positive definite. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54106,12 +54102,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & - !> SSBGVX computes selected eigenvalues, and optionally, eigenvectors - !> of a real generalized symmetric-definite banded eigenproblem, of - !> the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric - !> and banded, and B is also positive definite. Eigenvalues and - !> eigenvectors can be selected by specifying either all eigenvalues, - !> a range of values or a range of indices for the desired eigenvalues. + !! SSBGVX computes selected eigenvalues, and optionally, eigenvectors + !! of a real generalized symmetric-definite banded eigenproblem, of + !! the form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric + !! and banded, and B is also positive definite. Eigenvalues and + !! eigenvectors can be selected by specifying either all eigenvalues, + !! a range of values or a range of indices for the desired eigenvalues. vu, il, iu, abstol, m, w, z,ldz, work, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54291,8 +54287,8 @@ module stdlib_linalg_lapack_s subroutine stdlib_sspev( jobz, uplo, n, ap, w, z, ldz, work, info ) - !> SSPEV computes all the eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A in packed storage. + !! SSPEV computes all the eigenvalues and, optionally, eigenvectors of a + !! real symmetric matrix A in packed storage. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54384,10 +54380,10 @@ module stdlib_linalg_lapack_s subroutine stdlib_sspevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> SSPEVX computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric matrix A in packed storage. Eigenvalues/vectors - !> can be selected by specifying either a range of values or a range of - !> indices for the desired eigenvalues. + !! SSPEVX computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric matrix A in packed storage. Eigenvalues/vectors + !! can be selected by specifying either a range of values or a range of + !! indices for the desired eigenvalues. work, iwork, ifail,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54597,11 +54593,11 @@ module stdlib_linalg_lapack_s subroutine stdlib_sspgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,info ) - !> SSPGV computes all the eigenvalues and, optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric, stored in packed format, - !> and B is also positive definite. + !! SSPGV computes all the eigenvalues and, optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric, stored in packed format, + !! and B is also positive definite. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54681,13 +54677,13 @@ module stdlib_linalg_lapack_s subroutine stdlib_sspgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & - !> SSPGVX computes selected eigenvalues, and optionally, eigenvectors - !> of a real generalized symmetric-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 symmetric, stored in packed storage, and B - !> is also positive definite. Eigenvalues and eigenvectors can be - !> selected by specifying either a range of values or a range of indices - !> for the desired eigenvalues. + !! SSPGVX computes selected eigenvalues, and optionally, eigenvectors + !! of a real generalized symmetric-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 symmetric, stored in packed storage, and B + !! is also positive definite. Eigenvalues and eigenvectors can be + !! selected by specifying either a range of values or a range of indices + !! for the desired eigenvalues. z, ldz, work, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54793,8 +54789,8 @@ module stdlib_linalg_lapack_s subroutine stdlib_ssyev( jobz, uplo, n, a, lda, w, work, lwork, info ) - !> SSYEV computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric matrix A. + !! SSYEV computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54900,10 +54896,10 @@ module stdlib_linalg_lapack_s subroutine stdlib_ssyevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> SSYEVX computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric matrix A. Eigenvalues and eigenvectors can be - !> selected by specifying either a range of values or a range of indices - !> for the desired eigenvalues. + !! SSYEVX computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric matrix A. Eigenvalues and eigenvectors can be + !! selected by specifying either a range of values or a range of indices + !! for the desired eigenvalues. work, lwork, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55147,11 +55143,11 @@ module stdlib_linalg_lapack_s subroutine stdlib_ssygv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, info ) - !> SSYGV computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric and B is also - !> positive definite. + !! SSYGV computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric and B is also + !! positive definite. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55247,12 +55243,12 @@ module stdlib_linalg_lapack_s subroutine stdlib_ssygvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& - !> SSYGVX computes selected eigenvalues, and optionally, eigenvectors - !> of a real generalized symmetric-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 symmetric and B is also positive definite. - !> Eigenvalues and eigenvectors can be selected by specifying either a - !> range of values or a range of indices for the desired eigenvalues. + !! SSYGVX computes selected eigenvalues, and optionally, eigenvectors + !! of a real generalized symmetric-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 symmetric and B is also positive definite. + !! Eigenvalues and eigenvectors can be selected by specifying either a + !! range of values or a range of indices for the desired eigenvalues. m, w, z, ldz, work,lwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55375,17 +55371,17 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> SSYSV computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> The 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 symmetric 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. + !! SSYSV computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! The 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 symmetric 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55453,12 +55449,12 @@ module stdlib_linalg_lapack_s subroutine stdlib_ssysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & - !> SSYSVX uses the diagonal pivoting factorization to compute the - !> solution to a real system of linear equations A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! SSYSVX uses the diagonal pivoting factorization to compute the + !! solution to a real system of linear equations A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ferr, berr, work, lwork,iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55550,9 +55546,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytrd_sy2sb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) - !> SSYTRD_SY2SB reduces a real symmetric matrix A to real symmetric - !> band-diagonal form AB by a orthogonal similarity transformation: - !> Q**T * A * Q = AB. + !! SSYTRD_SY2SB reduces a real symmetric matrix A to real symmetric + !! band-diagonal form AB by a orthogonal similarity transformation: + !! Q**T * A * Q = AB. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55726,24 +55722,24 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & - !> STGEVC computes some or all of the right and/or left eigenvectors of - !> a pair of real matrices (S,P), where S is a quasi-triangular matrix - !> and P is upper triangular. Matrix pairs of this type are produced by - !> the generalized Schur factorization of a matrix pair (A,B): - !> A = Q*S*Z**T, B = Q*P*Z**T - !> as computed by SGGHRD + SHGEQZ. - !> The right eigenvector x and the left eigenvector y of (S,P) - !> corresponding to an eigenvalue w are defined by: - !> S*x = w*P*x, (y**H)*S = w*(y**H)*P, - !> where y**H denotes the conjugate tranpose of y. - !> The eigenvalues are not input to this routine, but are computed - !> directly from the diagonal blocks of S and P. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of (S,P), or the products Z*X and/or Q*Y, - !> where Z and Q are input matrices. - !> If Q and Z are the orthogonal factors from the generalized Schur - !> factorization of a matrix pair (A,B), then Z*X and Q*Y - !> are the matrices of right and left eigenvectors of (A,B). + !! STGEVC computes some or all of the right and/or left eigenvectors of + !! a pair of real matrices (S,P), where S is a quasi-triangular matrix + !! and P is upper triangular. Matrix pairs of this type are produced by + !! the generalized Schur factorization of a matrix pair (A,B): + !! A = Q*S*Z**T, B = Q*P*Z**T + !! as computed by SGGHRD + SHGEQZ. + !! The right eigenvector x and the left eigenvector y of (S,P) + !! corresponding to an eigenvalue w are defined by: + !! S*x = w*P*x, (y**H)*S = w*(y**H)*P, + !! where y**H denotes the conjugate tranpose of y. + !! The eigenvalues are not input to this routine, but are computed + !! directly from the diagonal blocks of S and P. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of (S,P), or the products Z*X and/or Q*Y, + !! where Z and Q are input matrices. + !! If Q and Z are the orthogonal factors from the generalized Schur + !! factorization of a matrix pair (A,B), then Z*X and Q*Y + !! are the matrices of right and left eigenvectors of (A,B). mm, m, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56456,16 +56452,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, n1, n2, & - !> STGEX2 swaps adjacent diagonal blocks (A11, B11) and (A22, B22) - !> of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair - !> (A, B) by an orthogonal equivalence transformation. - !> (A, B) must be in generalized real Schur canonical form (as returned - !> by SGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2 - !> diagonal blocks. B is upper triangular. - !> Optionally, the matrices Q and Z of generalized Schur vectors are - !> updated. - !> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T - !> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T + !! STGEX2 swaps adjacent diagonal blocks (A11, B11) and (A22, B22) + !! of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair + !! (A, B) by an orthogonal equivalence transformation. + !! (A, B) must be in generalized real Schur canonical form (as returned + !! by SGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2 + !! diagonal blocks. B is upper triangular. + !! Optionally, the matrices Q and Z of generalized Schur vectors are + !! updated. + !! Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T + !! Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T work, lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56821,18 +56817,18 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & - !> STGEXC reorders the generalized real Schur decomposition of a real - !> matrix pair (A,B) using an orthogonal equivalence transformation - !> (A, B) = Q * (A, B) * Z**T, - !> so that the diagonal block of (A, B) with row index IFST is moved - !> to row ILST. - !> (A, B) must be in generalized real Schur canonical form (as returned - !> by SGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2 - !> diagonal blocks. B is upper triangular. - !> Optionally, the matrices Q and Z of generalized Schur vectors are - !> updated. - !> Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T - !> Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T + !! STGEXC reorders the generalized real Schur decomposition of a real + !! matrix pair (A,B) using an orthogonal equivalence transformation + !! (A, B) = Q * (A, B) * Z**T, + !! so that the diagonal block of (A, B) with row index IFST is moved + !! to row ILST. + !! (A, B) must be in generalized real Schur canonical form (as returned + !! by SGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2 + !! diagonal blocks. B is upper triangular. + !! Optionally, the matrices Q and Z of generalized Schur vectors are + !! updated. + !! Q(in) * A(in) * Z(in)**T = Q(out) * A(out) * Z(out)**T + !! Q(in) * B(in) * Z(in)**T = Q(out) * B(out) * Z(out)**T work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57070,26 +57066,26 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alphar, alphai, & - !> STGSEN reorders the generalized real Schur decomposition of a real - !> matrix pair (A, B) (in terms of an orthonormal equivalence trans- - !> formation Q**T * (A, B) * Z), so that a selected cluster of eigenvalues - !> appears in the leading diagonal blocks of the upper quasi-triangular - !> matrix A and the upper triangular B. The leading columns of Q and - !> Z form orthonormal bases of the corresponding left and right eigen- - !> spaces (deflating subspaces). (A, B) must be in generalized real - !> Schur canonical form (as returned by SGGES), i.e. A is block upper - !> triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper - !> triangular. - !> STGSEN also computes the generalized eigenvalues - !> w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j) - !> of the reordered matrix pair (A, B). - !> Optionally, STGSEN computes the estimates of reciprocal condition - !> numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11), - !> (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s) - !> between the matrix pairs (A11, B11) and (A22,B22) that correspond to - !> the selected cluster and the eigenvalues outside the cluster, resp., - !> and norms of "projections" onto left and right eigenspaces w.r.t. - !> the selected cluster in the (1,1)-block. + !! STGSEN reorders the generalized real Schur decomposition of a real + !! matrix pair (A, B) (in terms of an orthonormal equivalence trans- + !! formation Q**T * (A, B) * Z), so that a selected cluster of eigenvalues + !! appears in the leading diagonal blocks of the upper quasi-triangular + !! matrix A and the upper triangular B. The leading columns of Q and + !! Z form orthonormal bases of the corresponding left and right eigen- + !! spaces (deflating subspaces). (A, B) must be in generalized real + !! Schur canonical form (as returned by SGGES), i.e. A is block upper + !! triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper + !! triangular. + !! STGSEN also computes the generalized eigenvalues + !! w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j) + !! of the reordered matrix pair (A, B). + !! Optionally, STGSEN computes the estimates of reciprocal condition + !! numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11), + !! (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s) + !! between the matrix pairs (A11, B11) and (A22,B22) that correspond to + !! the selected cluster and the eigenvalues outside the cluster, resp., + !! and norms of "projections" onto left and right eigenspaces w.r.t. + !! the selected cluster in the (1,1)-block. beta, q, ldq, z, ldz, m, pl,pr, dif, work, lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57396,67 +57392,67 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & - !> STGSJA computes the generalized singular value decomposition (GSVD) - !> of two real upper triangular (or trapezoidal) matrices A and B. - !> On entry, it is assumed that matrices A and B have the following - !> forms, which may be obtained by the preprocessing subroutine SGGSVP - !> from a general M-by-N matrix A and P-by-N matrix B: - !> N-K-L K L - !> A = K ( 0 A12 A13 ) if M-K-L >= 0; - !> L ( 0 0 A23 ) - !> M-K-L ( 0 0 0 ) - !> N-K-L K L - !> A = K ( 0 A12 A13 ) if M-K-L < 0; - !> M-K ( 0 0 A23 ) - !> N-K-L K L - !> B = L ( 0 0 B13 ) - !> P-L ( 0 0 0 ) - !> where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular - !> upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, - !> otherwise A23 is (M-K)-by-L upper trapezoidal. - !> On exit, - !> U**T *A*Q = D1*( 0 R ), V**T *B*Q = D2*( 0 R ), - !> where U, V and Q are orthogonal matrices. - !> R is a nonsingular upper triangular matrix, and D1 and D2 are - !> ``diagonal'' matrices, which are of the following structures: - !> If M-K-L >= 0, - !> K L - !> D1 = K ( I 0 ) - !> L ( 0 C ) - !> M-K-L ( 0 0 ) - !> K L - !> D2 = L ( 0 S ) - !> P-L ( 0 0 ) - !> N-K-L K L - !> ( 0 R ) = K ( 0 R11 R12 ) K - !> L ( 0 0 R22 ) L - !> where - !> C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), - !> S = diag( BETA(K+1), ... , BETA(K+L) ), - !> C**2 + S**2 = I. - !> R is stored in A(1:K+L,N-K-L+1:N) on exit. - !> If M-K-L < 0, - !> K M-K K+L-M - !> D1 = K ( I 0 0 ) - !> M-K ( 0 C 0 ) - !> K M-K K+L-M - !> D2 = M-K ( 0 S 0 ) - !> K+L-M ( 0 0 I ) - !> P-L ( 0 0 0 ) - !> N-K-L K M-K K+L-M - !> ( 0 R ) = K ( 0 R11 R12 R13 ) - !> M-K ( 0 0 R22 R23 ) - !> K+L-M ( 0 0 0 R33 ) - !> where - !> C = diag( ALPHA(K+1), ... , ALPHA(M) ), - !> S = diag( BETA(K+1), ... , BETA(M) ), - !> C**2 + S**2 = I. - !> R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored - !> ( 0 R22 R23 ) - !> in B(M-K+1:L,N+M-K-L+1:N) on exit. - !> The computation of the orthogonal transformation matrices U, V or Q - !> is optional. These matrices may either be formed explicitly, or they - !> may be postmultiplied into input matrices U1, V1, or Q1. + !! STGSJA computes the generalized singular value decomposition (GSVD) + !! of two real upper triangular (or trapezoidal) matrices A and B. + !! On entry, it is assumed that matrices A and B have the following + !! forms, which may be obtained by the preprocessing subroutine SGGSVP + !! from a general M-by-N matrix A and P-by-N matrix B: + !! N-K-L K L + !! A = K ( 0 A12 A13 ) if M-K-L >= 0; + !! L ( 0 0 A23 ) + !! M-K-L ( 0 0 0 ) + !! N-K-L K L + !! A = K ( 0 A12 A13 ) if M-K-L < 0; + !! M-K ( 0 0 A23 ) + !! N-K-L K L + !! B = L ( 0 0 B13 ) + !! P-L ( 0 0 0 ) + !! where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular + !! upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, + !! otherwise A23 is (M-K)-by-L upper trapezoidal. + !! On exit, + !! U**T *A*Q = D1*( 0 R ), V**T *B*Q = D2*( 0 R ), + !! where U, V and Q are orthogonal matrices. + !! R is a nonsingular upper triangular matrix, and D1 and D2 are + !! ``diagonal'' matrices, which are of the following structures: + !! If M-K-L >= 0, + !! K L + !! D1 = K ( I 0 ) + !! L ( 0 C ) + !! M-K-L ( 0 0 ) + !! K L + !! D2 = L ( 0 S ) + !! P-L ( 0 0 ) + !! N-K-L K L + !! ( 0 R ) = K ( 0 R11 R12 ) K + !! L ( 0 0 R22 ) L + !! where + !! C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), + !! S = diag( BETA(K+1), ... , BETA(K+L) ), + !! C**2 + S**2 = I. + !! R is stored in A(1:K+L,N-K-L+1:N) on exit. + !! If M-K-L < 0, + !! K M-K K+L-M + !! D1 = K ( I 0 0 ) + !! M-K ( 0 C 0 ) + !! K M-K K+L-M + !! D2 = M-K ( 0 S 0 ) + !! K+L-M ( 0 0 I ) + !! P-L ( 0 0 0 ) + !! N-K-L K M-K K+L-M + !! ( 0 R ) = K ( 0 R11 R12 R13 ) + !! M-K ( 0 0 R22 R23 ) + !! K+L-M ( 0 0 0 R33 ) + !! where + !! C = diag( ALPHA(K+1), ... , ALPHA(M) ), + !! S = diag( BETA(K+1), ... , BETA(M) ), + !! C**2 + S**2 = I. + !! R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored + !! ( 0 R22 R23 ) + !! in B(M-K+1:L,N+M-K-L+1:N) on exit. + !! The computation of the orthogonal transformation matrices U, V or Q + !! is optional. These matrices may either be formed explicitly, or they + !! may be postmultiplied into input matrices U1, V1, or Q1. alpha, beta, u, ldu, v, ldv,q, ldq, work, ncycle, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57637,14 +57633,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & - !> STGSNA estimates reciprocal condition numbers for specified - !> eigenvalues and/or eigenvectors of a matrix pair (A, B) in - !> generalized real Schur canonical form (or of any matrix pair - !> (Q*A*Z**T, Q*B*Z**T) with orthogonal matrices Q and Z, where - !> Z**T denotes the transpose of Z. - !> (A, B) must be in generalized real Schur form (as returned by SGGES), - !> i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal - !> blocks. B is upper triangular. + !! STGSNA estimates reciprocal condition numbers for specified + !! eigenvalues and/or eigenvectors of a matrix pair (A, B) in + !! generalized real Schur canonical form (or of any matrix pair + !! (Q*A*Z**T, Q*B*Z**T) with orthogonal matrices Q and Z, where + !! Z**T denotes the transpose of Z. + !! (A, B) must be in generalized real Schur form (as returned by SGGES), + !! i.e. A is block upper triangular with 1-by-1 and 2-by-2 diagonal + !! blocks. B is upper triangular. dif, mm, m, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57885,10 +57881,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) - !> STPLQT computes a blocked LQ factorization of a real - !> "triangular-pentagonal" matrix C, which is composed of a - !> triangular block A and pentagonal block B, using the compact - !> WY representation for Q. + !! STPLQT computes a blocked LQ factorization of a real + !! "triangular-pentagonal" matrix C, which is composed of a + !! triangular block A and pentagonal block B, using the compact + !! WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57947,10 +57943,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_stpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) - !> STPQRT computes a blocked QR factorization of a real - !> "triangular-pentagonal" matrix C, which is composed of a - !> triangular block A and pentagonal block B, using the compact - !> WY representation for Q. + !! STPQRT computes a blocked QR factorization of a real + !! "triangular-pentagonal" matrix C, which is composed of a + !! triangular block A and pentagonal block B, using the compact + !! WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58009,21 +58005,21 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_strevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & - !> STREVC computes some or all of the right and/or left eigenvectors of - !> a real upper quasi-triangular matrix T. - !> Matrices of this type are produced by the Schur factorization of - !> a real general matrix: A = Q*T*Q**T, as computed by SHSEQR. - !> The right eigenvector x and the left eigenvector y of T corresponding - !> to an eigenvalue w are defined by: - !> T*x = w*x, (y**H)*T = w*(y**H) - !> where y**H denotes the conjugate transpose of y. - !> The eigenvalues are not input to this routine, but are read directly - !> from the diagonal blocks of T. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an - !> input matrix. If Q is the orthogonal factor that reduces a matrix - !> A to Schur form T, then Q*X and Q*Y are the matrices of right and - !> left eigenvectors of A. + !! STREVC computes some or all of the right and/or left eigenvectors of + !! a real upper quasi-triangular matrix T. + !! Matrices of this type are produced by the Schur factorization of + !! a real general matrix: A = Q*T*Q**T, as computed by SHSEQR. + !! The right eigenvector x and the left eigenvector y of T corresponding + !! to an eigenvalue w are defined by: + !! T*x = w*x, (y**H)*T = w*(y**H) + !! where y**H denotes the conjugate transpose of y. + !! The eigenvalues are not input to this routine, but are read directly + !! from the diagonal blocks of T. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an + !! input matrix. If Q is the orthogonal factor that reduces a matrix + !! A to Schur form T, then Q*X and Q*Y are the matrices of right and + !! left eigenvectors of A. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58622,22 +58618,22 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_strevc3( side, howmny, select, n, t, ldt, vl, ldvl,vr, ldvr, mm, m, & - !> STREVC3 computes some or all of the right and/or left eigenvectors of - !> a real upper quasi-triangular matrix T. - !> Matrices of this type are produced by the Schur factorization of - !> a real general matrix: A = Q*T*Q**T, as computed by SHSEQR. - !> The right eigenvector x and the left eigenvector y of T corresponding - !> to an eigenvalue w are defined by: - !> T*x = w*x, (y**T)*T = w*(y**T) - !> where y**T denotes the transpose of the vector y. - !> The eigenvalues are not input to this routine, but are read directly - !> from the diagonal blocks of T. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an - !> input matrix. If Q is the orthogonal factor that reduces a matrix - !> A to Schur form T, then Q*X and Q*Y are the matrices of right and - !> left eigenvectors of A. - !> This uses a Level 3 BLAS version of the back transformation. + !! STREVC3 computes some or all of the right and/or left eigenvectors of + !! a real upper quasi-triangular matrix T. + !! Matrices of this type are produced by the Schur factorization of + !! a real general matrix: A = Q*T*Q**T, as computed by SHSEQR. + !! The right eigenvector x and the left eigenvector y of T corresponding + !! to an eigenvalue w are defined by: + !! T*x = w*x, (y**T)*T = w*(y**T) + !! where y**T denotes the transpose of the vector y. + !! The eigenvalues are not input to this routine, but are read directly + !! from the diagonal blocks of T. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an + !! input matrix. If Q is the orthogonal factor that reduces a matrix + !! A to Schur form T, then Q*X and Q*Y are the matrices of right and + !! left eigenvectors of A. + !! This uses a Level 3 BLAS version of the back transformation. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59444,17 +59440,17 @@ module stdlib_linalg_lapack_s subroutine stdlib_strsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) - !> STRSYL solves the real Sylvester matrix equation: - !> op(A)*X + X*op(B) = scale*C or - !> op(A)*X - X*op(B) = scale*C, - !> where op(A) = A or A**T, and A and B are both upper quasi- - !> triangular. A is M-by-M and B is N-by-N; the right hand side C and - !> the solution X are M-by-N; and scale is an output scale factor, set - !> <= 1 to avoid overflow in X. - !> A and B must be in Schur canonical form (as returned by SHSEQR), 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. + !! STRSYL solves the real Sylvester matrix equation: + !! op(A)*X + X*op(B) = scale*C or + !! op(A)*X - X*op(B) = scale*C, + !! where op(A) = A or A**T, and A and B are both upper quasi- + !! triangular. A is M-by-M and B is N-by-N; the right hand side C and + !! the solution X are M-by-N; and scale is an output scale factor, set + !! <= 1 to avoid overflow in X. + !! A and B must be in Schur canonical form (as returned by SHSEQR), 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60105,9 +60101,9 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) - !> SGEBRD reduces a general real M-by-N matrix A to upper or lower - !> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. - !> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. + !! SGEBRD reduces a general real M-by-N matrix A to upper or lower + !! bidiagonal form B by an orthogonal transformation: Q**T * A * P = B. + !! If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60210,8 +60206,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info ) - !> SGEHRD reduces a real general matrix A to upper Hessenberg form H by - !> an orthogonal similarity transformation: Q**T * A * Q = H . + !! SGEHRD reduces a real general matrix A to upper Hessenberg form H by + !! an orthogonal similarity transformation: Q**T * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60339,8 +60335,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgelqt( m, n, mb, a, lda, t, ldt, work, info ) - !> DGELQT computes a blocked LQ factorization of a real M-by-N matrix A - !> using the compact WY representation of Q. + !! DGELQT computes a blocked LQ factorization of a real M-by-N matrix A + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60390,24 +60386,24 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) - !> SGELS solves overdetermined or underdetermined real linear systems - !> involving an M-by-N matrix A, or its 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 = 'T' and m >= n: find the minimum norm solution of - !> an underdetermined system A**T * X = B. - !> 4. If TRANS = 'T' 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. + !! SGELS solves overdetermined or underdetermined real linear systems + !! involving an M-by-N matrix A, or its 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 = 'T' and m >= n: find the minimum norm solution of + !! an underdetermined system A**T * X = B. + !! 4. If TRANS = 'T' 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60607,13 +60603,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & - !> SGEMLQ overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product - !> of blocked elementary reflectors computed by short wide LQ - !> factorization (SGELQ) + !! SGEMLQ overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product + !! of blocked elementary reflectors computed by short wide LQ + !! factorization (SGELQ) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60704,13 +60700,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & - !> SGEMQR overwrites the general real M-by-N matrix C with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> where Q is a real orthogonal matrix defined as the product - !> of blocked elementary reflectors computed by tall skinny - !> QR factorization (SGEQR) + !! SGEMQR overwrites the general real M-by-N matrix C with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! where Q is a real orthogonal matrix defined as the product + !! of blocked elementary reflectors computed by tall skinny + !! QR factorization (SGEQR) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60801,8 +60797,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgeqp3( m, n, a, lda, jpvt, tau, work, lwork, info ) - !> SGEQP3 computes a QR factorization with column pivoting of a - !> matrix A: A*P = Q*R using Level 3 BLAS. + !! SGEQP3 computes a QR factorization with column pivoting of a + !! matrix A: A*P = Q*R using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60950,8 +60946,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgeqrt( m, n, nb, a, lda, t, ldt, work, info ) - !> SGEQRT computes a blocked QR factorization of a real M-by-N matrix A - !> using the compact WY representation of Q. + !! SGEQRT computes a blocked QR factorization of a real M-by-N matrix A + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61007,15 +61003,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) - !> SGESV computes the solution to a real 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. + !! SGESV computes the solution to a real 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61055,12 +61051,12 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & - !> SGESVX uses the LU factorization to compute the solution to a real - !> system of linear equations - !> A * X = B, - !> where A is an N-by-N matrix and X and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! SGESVX uses the LU factorization to compute the solution to a real + !! system of linear equations + !! A * X = B, + !! where A is an N-by-N matrix and X and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. x, ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61259,32 +61255,32 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alphar, & - !> SGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B), - !> the generalized eigenvalues, the generalized real Schur form (S,T), - !> optionally, the left and/or right matrices of Schur vectors (VSL and - !> VSR). This gives the generalized Schur factorization - !> (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T ) - !> Optionally, it also orders the eigenvalues so that a selected cluster - !> of eigenvalues appears in the leading diagonal blocks of the upper - !> quasi-triangular matrix S and the upper triangular matrix T.The - !> leading columns of VSL and VSR then form an orthonormal basis for the - !> corresponding left and right eigenspaces (deflating subspaces). - !> (If only the generalized eigenvalues are needed, use the driver - !> SGGEV 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 or both being zero. - !> A pair of matrices (S,T) is in generalized real Schur form if T is - !> upper triangular with non-negative diagonal and S is block upper - !> triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond - !> to real generalized eigenvalues, while 2-by-2 blocks of S will be - !> "standardized" by making the corresponding elements of T have the - !> form: - !> [ a 0 ] - !> [ 0 b ] - !> and the pair of corresponding 2-by-2 blocks in S and T will have a - !> complex conjugate pair of generalized eigenvalues. + !! SGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B), + !! the generalized eigenvalues, the generalized real Schur form (S,T), + !! optionally, the left and/or right matrices of Schur vectors (VSL and + !! VSR). This gives the generalized Schur factorization + !! (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T ) + !! Optionally, it also orders the eigenvalues so that a selected cluster + !! of eigenvalues appears in the leading diagonal blocks of the upper + !! quasi-triangular matrix S and the upper triangular matrix T.The + !! leading columns of VSL and VSR then form an orthonormal basis for the + !! corresponding left and right eigenspaces (deflating subspaces). + !! (If only the generalized eigenvalues are needed, use the driver + !! SGGEV 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 or both being zero. + !! A pair of matrices (S,T) is in generalized real Schur form if T is + !! upper triangular with non-negative diagonal and S is block upper + !! triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond + !! to real generalized eigenvalues, while 2-by-2 blocks of S will be + !! "standardized" by making the corresponding elements of T have the + !! form: + !! [ a 0 ] + !! [ 0 b ] + !! and the pair of corresponding 2-by-2 blocks in S and T will have a + !! complex conjugate pair of generalized eigenvalues. alphai, beta, vsl, ldvsl, vsr,ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61578,34 +61574,34 @@ module stdlib_linalg_lapack_s subroutine stdlib_sggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, & - !> SGGESX computes for a pair of N-by-N real nonsymmetric matrices - !> (A,B), the generalized eigenvalues, the real Schur form (S,T), and, - !> optionally, the left and/or right matrices of Schur vectors (VSL and - !> VSR). This gives the generalized Schur factorization - !> (A,B) = ( (VSL) S (VSR)**T, (VSL) T (VSR)**T ) - !> Optionally, it also orders the eigenvalues so that a selected cluster - !> of eigenvalues appears in the leading diagonal blocks of the upper - !> quasi-triangular matrix S and the upper triangular matrix T; computes - !> a reciprocal condition number for the average of the selected - !> eigenvalues (RCONDE); and computes a reciprocal condition number for - !> the right and left deflating subspaces corresponding to the selected - !> eigenvalues (RCONDV). The leading columns of VSL and VSR then form - !> an orthonormal basis for the corresponding left and right eigenspaces - !> (deflating subspaces). - !> 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 or for both being zero. - !> A pair of matrices (S,T) is in generalized real Schur form if T is - !> upper triangular with non-negative diagonal and S is block upper - !> triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond - !> to real generalized eigenvalues, while 2-by-2 blocks of S will be - !> "standardized" by making the corresponding elements of T have the - !> form: - !> [ a 0 ] - !> [ 0 b ] - !> and the pair of corresponding 2-by-2 blocks in S and T will have a - !> complex conjugate pair of generalized eigenvalues. + !! SGGESX computes for a pair of N-by-N real nonsymmetric matrices + !! (A,B), the generalized eigenvalues, the real Schur form (S,T), and, + !! optionally, the left and/or right matrices of Schur vectors (VSL and + !! VSR). This gives the generalized Schur factorization + !! (A,B) = ( (VSL) S (VSR)**T, (VSL) T (VSR)**T ) + !! Optionally, it also orders the eigenvalues so that a selected cluster + !! of eigenvalues appears in the leading diagonal blocks of the upper + !! quasi-triangular matrix S and the upper triangular matrix T; computes + !! a reciprocal condition number for the average of the selected + !! eigenvalues (RCONDE); and computes a reciprocal condition number for + !! the right and left deflating subspaces corresponding to the selected + !! eigenvalues (RCONDV). The leading columns of VSL and VSR then form + !! an orthonormal basis for the corresponding left and right eigenspaces + !! (deflating subspaces). + !! 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 or for both being zero. + !! A pair of matrices (S,T) is in generalized real Schur form if T is + !! upper triangular with non-negative diagonal and S is block upper + !! triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond + !! to real generalized eigenvalues, while 2-by-2 blocks of S will be + !! "standardized" by making the corresponding elements of T have the + !! form: + !! [ a 0 ] + !! [ 0 b ] + !! and the pair of corresponding 2-by-2 blocks in S and T will have a + !! complex conjugate pair of generalized eigenvalues. alphar, alphai, beta, vsl, ldvsl,vsr, ldvsr, rconde, rcondv, work, lwork, iwork,liwork, & bwork, info ) ! -- lapack driver routine -- @@ -61948,21 +61944,21 @@ module stdlib_linalg_lapack_s subroutine stdlib_sggev( jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai,beta, vl, ldvl, vr, & - !> SGGEV computes for a pair of N-by-N real 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) - !> of (A,B) satisfies - !> A * v(j) = lambda(j) * B * v(j). - !> The left eigenvector u(j) corresponding to the eigenvalue 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). + !! SGGEV computes for a pair of N-by-N real 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) + !! of (A,B) satisfies + !! A * v(j) = lambda(j) * B * v(j). + !! The left eigenvector u(j) corresponding to the eigenvalue 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). ldvr, work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62246,26 +62242,26 @@ module stdlib_linalg_lapack_s subroutine stdlib_sggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alphar, alphai, & - !> SGGEVX computes for a pair of N-by-N real nonsymmetric matrices (A,B) - !> the generalized eigenvalues, and optionally, the left and/or right - !> generalized eigenvectors. - !> Optionally also, it computes a balancing transformation to improve - !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, - !> LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for - !> the eigenvalues (RCONDE), and reciprocal condition numbers for the - !> right eigenvectors (RCONDV). - !> 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) - !> of (A,B) satisfies - !> A * v(j) = lambda(j) * B * v(j) . - !> The left eigenvector u(j) corresponding to the eigenvalue 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). + !! SGGEVX computes for a pair of N-by-N real nonsymmetric matrices (A,B) + !! the generalized eigenvalues, and optionally, the left and/or right + !! generalized eigenvectors. + !! Optionally also, it computes a balancing transformation to improve + !! the conditioning of the eigenvalues and eigenvectors (ILO, IHI, + !! LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for + !! the eigenvalues (RCONDE), and reciprocal condition numbers for the + !! right eigenvectors (RCONDV). + !! 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) + !! of (A,B) satisfies + !! A * v(j) = lambda(j) * B * v(j) . + !! The left eigenvector u(j) corresponding to the eigenvalue 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). beta, vl, ldvl, vr, ldvr, ilo,ihi, lscale, rscale, abnrm, bbnrm, rconde,rcondv, work, lwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -62640,24 +62636,24 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) - !> SGGGLM 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. + !! SGGGLM 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62776,18 +62772,18 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) - !> SGGLSE 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. + !! SGGLSE 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62908,12 +62904,12 @@ module stdlib_linalg_lapack_s subroutine stdlib_shsein( side, eigsrc, initv, select, n, h, ldh, wr, wi,vl, ldvl, vr, ldvr, & - !> SHSEIN uses inverse iteration to find specified right and/or left - !> eigenvectors of a real 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. + !! SHSEIN uses inverse iteration to find specified right and/or left + !! eigenvectors of a real 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. mm, m, work, ifaill,ifailr, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63123,12 +63119,12 @@ module stdlib_linalg_lapack_s real(sp) function stdlib_sla_porpvgrw( uplo, ncols, a, lda, af, ldaf, work ) - !> SLA_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. + !! SLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63211,18 +63207,18 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaed3( k, n, n1, d, q, ldq, rho, dlamda, q2, indx,ctot, w, s, info ) - !> SLAED3 finds the roots of the secular equation, as defined by the - !> values in D, W, and RHO, between 1 and K. It makes the - !> appropriate calls to SLAED4 and then updates the eigenvectors by - !> multiplying the matrix of eigenvectors of the pair of eigensystems - !> being combined by the matrix of eigenvectors of the K-by-K system - !> which is solved here. - !> 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. + !! SLAED3 finds the roots of the secular equation, as defined by the + !! values in D, W, and RHO, between 1 and K. It makes the + !! appropriate calls to SLAED4 and then updates the eigenvectors by + !! multiplying the matrix of eigenvectors of the pair of eigensystems + !! being combined by the matrix of eigenvectors of the K-by-K system + !! which is solved here. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63346,32 +63342,32 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaed7( icompq, n, qsiz, tlvls, curlvl, curpbm, d, q,ldq, indxq, rho, & - !> SLAED7 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 symmetric matrix - !> that has been reduced to tridiagonal form. SLAED1 handles - !> the case in which all eigenvalues and eigenvectors of a symmetric - !> tridiagonal matrix are desired. - !> T = Q(in) ( D(in) + RHO * Z*Z**T ) Q**T(in) = Q(out) * D(out) * Q**T(out) - !> where Z = Q**Tu, 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 SLAED8. - !> 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 SLAED9). - !> 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. + !! SLAED7 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 symmetric matrix + !! that has been reduced to tridiagonal form. SLAED1 handles + !! the case in which all eigenvalues and eigenvectors of a symmetric + !! tridiagonal matrix are desired. + !! T = Q(in) ( D(in) + RHO * Z*Z**T ) Q**T(in) = Q(out) * D(out) * Q**T(out) + !! where Z = Q**Tu, 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 SLAED8. + !! 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 SLAED9). + !! 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. cutpnt, qstore, qptr, prmptr,perm, givptr, givcol, givnum, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63480,13 +63476,13 @@ module stdlib_linalg_lapack_s subroutine stdlib_slaexc( wantq, n, t, ldt, q, ldq, j1, n1, n2, work,info ) - !> SLAEXC 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. + !! SLAEXC 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63677,10 +63673,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slahqr( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, & - !> SLAHQR is an auxiliary routine called by SHSEQR to update the - !> eigenvalues and Schur decomposition already computed by SHSEQR, by - !> dealing with the Hessenberg submatrix in rows and columns ILO to - !> IHI. + !! SLAHQR is an auxiliary routine called by SHSEQR to update the + !! eigenvalues and Schur decomposition already computed by SHSEQR, by + !! dealing with the Hessenberg submatrix in rows and columns ILO to + !! IHI. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63986,13 +63982,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasd2( nl, nr, sqre, k, d, z, alpha, beta, u, ldu, vt,ldvt, dsigma, & - !> SLASD2 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. - !> SLASD2 is called from SLASD1. + !! SLASD2 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. + !! SLASD2 is called from SLASD1. u2, ldu2, vt2, ldvt2, idxp, idx,idxc, idxq, coltyp, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64271,16 +64267,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) - !> SLASWLQ computes a blocked Tall-Skinny LQ factorization of - !> a real 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. + !! SLASWLQ computes a blocked Tall-Skinny LQ factorization of + !! a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -64355,17 +64351,17 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) - !> SLATSQR computes a blocked Tall-Skinny QR factorization of - !> a real M-by-N matrix A for M >= N: - !> A = Q * ( R ), - !> ( 0 ) - !> where: - !> Q is a M-by-M orthogonal matrix, stored on exit in an implicit - !> form in the elements below the diagonal of the array A and in - !> the elements of the array T; - !> R is an upper-triangular N-by-N matrix, stored on exit in - !> the elements on and above the diagonal of the array A. - !> 0 is a (M-N)-by-N zero matrix, and is not stored. + !! SLATSQR computes a blocked Tall-Skinny QR factorization of + !! a real M-by-N matrix A for M >= N: + !! A = Q * ( R ), + !! ( 0 ) + !! where: + !! Q is a M-by-M orthogonal matrix, stored on exit in an implicit + !! form in the elements below the diagonal of the array A and in + !! the elements of the array T; + !! R is an upper-triangular N-by-N matrix, stored on exit in + !! the elements on and above the diagonal of the array A. + !! 0 is a (M-N)-by-N zero matrix, and is not stored. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -64440,22 +64436,22 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sorgbr( vect, m, n, k, a, lda, tau, work, lwork, info ) - !> SORGBR generates one of the real orthogonal matrices Q or P**T - !> determined by SGEBRD when reducing a real matrix A to bidiagonal - !> form: A = Q * B * P**T. Q and P**T are defined as products of - !> elementary reflectors H(i) or G(i) respectively. - !> If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q - !> is of order M: - !> if m >= k, Q = H(1) H(2) . . . H(k) and SORGBR returns the first n - !> columns of Q, where m >= n >= k; - !> if m < k, Q = H(1) H(2) . . . H(m-1) and SORGBR returns Q as an - !> M-by-M matrix. - !> If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T - !> is of order N: - !> if k < n, P**T = G(k) . . . G(2) G(1) and SORGBR returns the first m - !> rows of P**T, where n >= m >= k; - !> if k >= n, P**T = G(n-1) . . . G(2) G(1) and SORGBR returns P**T as - !> an N-by-N matrix. + !! SORGBR generates one of the real orthogonal matrices Q or P**T + !! determined by SGEBRD when reducing a real matrix A to bidiagonal + !! form: A = Q * B * P**T. Q and P**T are defined as products of + !! elementary reflectors H(i) or G(i) respectively. + !! If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q + !! is of order M: + !! if m >= k, Q = H(1) H(2) . . . H(k) and SORGBR returns the first n + !! columns of Q, where m >= n >= k; + !! if m < k, Q = H(1) H(2) . . . H(m-1) and SORGBR returns Q as an + !! M-by-M matrix. + !! If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T + !! is of order N: + !! if k < n, P**T = G(k) . . . G(2) G(1) and SORGBR returns the first m + !! rows of P**T, where n >= m >= k; + !! if k >= n, P**T = G(n-1) . . . G(2) G(1) and SORGBR returns P**T as + !! an N-by-N matrix. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64589,28 +64585,28 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sormbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & - !> If VECT = 'Q', SORMBR: overwrites the general real M-by-N matrix C - !> with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': Q * C C * Q - !> TRANS = 'T': Q**T * C C * Q**T - !> If VECT = 'P', SORMBR overwrites the general real M-by-N matrix C - !> with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': P * C C * P - !> TRANS = 'T': P**T * C C * P**T - !> Here Q and P**T are the orthogonal matrices determined by SGEBRD when - !> reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and - !> P**T are defined as products of elementary reflectors H(i) and G(i) - !> respectively. - !> Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the - !> order of the orthogonal matrix Q or P**T that is applied. - !> If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: - !> if nq >= k, Q = H(1) H(2) . . . H(k); - !> if nq < k, Q = H(1) H(2) . . . H(nq-1). - !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: - !> if k < nq, P = G(1) G(2) . . . G(k); - !> if k >= nq, P = G(1) G(2) . . . G(nq-1). + !! If VECT = 'Q', SORMBR: overwrites the general real M-by-N matrix C + !! with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': Q * C C * Q + !! TRANS = 'T': Q**T * C C * Q**T + !! If VECT = 'P', SORMBR overwrites the general real M-by-N matrix C + !! with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': P * C C * P + !! TRANS = 'T': P**T * C C * P**T + !! Here Q and P**T are the orthogonal matrices determined by SGEBRD when + !! reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and + !! P**T are defined as products of elementary reflectors H(i) and G(i) + !! respectively. + !! Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the + !! order of the orthogonal matrix Q or P**T that is applied. + !! If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: + !! if nq >= k, Q = H(1) H(2) . . . H(k); + !! if nq < k, Q = H(1) H(2) . . . H(nq-1). + !! If VECT = 'P', A is assumed to have been a K-by-NQ matrix: + !! if k < nq, P = G(1) G(2) . . . G(k); + !! if k >= nq, P = G(1) G(2) . . . G(nq-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64747,17 +64743,17 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) - !> SPBSV computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite band matrix and X - !> and B are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular band matrix, and L is a lower - !> triangular band matrix, with the same number of superdiagonals or - !> subdiagonals as A. The factored form of A is then used to solve the - !> system of equations A * X = B. + !! SPBSV computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite band matrix and X + !! and B are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular band matrix, and L is a lower + !! triangular band matrix, with the same number of superdiagonals or + !! subdiagonals as A. The factored form of A is then used to solve the + !! system of equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64801,13 +64797,13 @@ module stdlib_linalg_lapack_s subroutine stdlib_spbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & - !> SPBSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to - !> compute the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite band matrix and X - !> and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! SPBSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to + !! compute the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite band matrix and X + !! and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64957,13 +64953,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spftrf( transr, uplo, n, a, info ) - !> SPFTRF computes the Cholesky factorization of a real symmetric - !> positive definite matrix A. - !> The factorization has the form - !> A = U**T * U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the block version of the algorithm, calling Level 3 BLAS. + !! SPFTRF computes the Cholesky factorization of a real symmetric + !! positive definite matrix A. + !! The factorization has the form + !! A = U**T * U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the block version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65132,16 +65128,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sposv( uplo, n, nrhs, a, lda, b, ldb, info ) - !> SPOSV computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**T* U, if UPLO = 'U', or - !> A = L * L**T, if UPLO = 'L', - !> where U is an upper triangular matrix and L is a lower triangular - !> matrix. The factored form of A is then used to solve the system of - !> equations A * X = B. + !! SPOSV computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**T* U, if UPLO = 'U', or + !! A = L * L**T, if UPLO = 'L', + !! where U is an upper triangular matrix and L is a lower triangular + !! matrix. The factored form of A is then used to solve the system of + !! equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65183,13 +65179,13 @@ module stdlib_linalg_lapack_s subroutine stdlib_sposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & - !> SPOSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to - !> compute the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! SPOSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to + !! compute the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. rcond, ferr, berr, work,iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65326,16 +65322,16 @@ module stdlib_linalg_lapack_s subroutine stdlib_strexc( compq, n, t, ldt, q, ldq, ifst, ilst, work,info ) - !> STREXC reorders the real Schur factorization of a real matrix - !> A = Q*T*Q**T, so that the diagonal block of T with row index IFST is - !> moved to row ILST. - !> The real Schur form T is reordered by an orthogonal similarity - !> transformation Z**T*T*Z, and optionally the matrix Q of Schur vectors - !> is updated by postmultiplying it with Z. - !> T must be in Schur canonical form (as returned by SHSEQR), 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. + !! STREXC reorders the real Schur factorization of a real matrix + !! A = Q*T*Q**T, so that the diagonal block of T with row index IFST is + !! moved to row ILST. + !! The real Schur form T is reordered by an orthogonal similarity + !! transformation Z**T*T*Z, and optionally the matrix Q of Schur vectors + !! is updated by postmultiplying it with Z. + !! T must be in Schur canonical form (as returned by SHSEQR), 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65530,17 +65526,17 @@ module stdlib_linalg_lapack_s subroutine stdlib_strsen( job, compq, select, n, t, ldt, q, ldq, wr, wi,m, s, sep, work, & - !> STRSEN reorders the real Schur factorization of a real matrix - !> A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in - !> the leading diagonal blocks of the upper quasi-triangular matrix T, - !> and the leading columns of Q form an orthonormal basis of the - !> corresponding right invariant subspace. - !> Optionally the routine computes the reciprocal condition numbers of - !> the cluster of eigenvalues and/or the invariant subspace. - !> T must be in Schur canonical form (as returned by SHSEQR), 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. + !! STRSEN reorders the real Schur factorization of a real matrix + !! A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in + !! the leading diagonal blocks of the upper quasi-triangular matrix T, + !! and the leading columns of Q form an orthonormal basis of the + !! corresponding right invariant subspace. + !! Optionally the routine computes the reciprocal condition numbers of + !! the cluster of eigenvalues and/or the invariant subspace. + !! T must be in Schur canonical form (as returned by SHSEQR), 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. lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65725,14 +65721,14 @@ module stdlib_linalg_lapack_s subroutine stdlib_strsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm, m, & - !> STRSNA estimates reciprocal condition numbers for specified - !> eigenvalues and/or right eigenvectors of a real upper - !> quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q - !> orthogonal). - !> T must be in Schur canonical form (as returned by SHSEQR), 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. + !! STRSNA estimates reciprocal condition numbers for specified + !! eigenvalues and/or right eigenvectors of a real upper + !! quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q + !! orthogonal). + !! T must be in Schur canonical form (as returned by SHSEQR), 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. work, ldwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65970,12 +65966,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgelq( m, n, a, lda, t, tsize, work, lwork,info ) - !> SGELQ computes an LQ factorization of a real 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. + !! SGELQ computes an LQ factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -66095,38 +66091,38 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, info ) - !> SGELSY computes the minimum-norm solution to a real 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 orthogonal 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**T [ inv(T11)*Q1**T*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 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. - !> o The permutation of matrix B (the right hand side) is faster and - !> more simple. + !! SGELSY computes the minimum-norm solution to a real 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 orthogonal 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**T [ inv(T11)*Q1**T*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 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. + !! o The permutation of matrix B (the right hand side) is faster and + !! more simple. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66328,13 +66324,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgeqr( m, n, a, lda, t, tsize, work, lwork,info ) - !> SGEQR computes a QR factorization of a real 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. + !! SGEQR computes a QR factorization of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -66443,24 +66439,24 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) - !> SGETSLS solves overdetermined or underdetermined real 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 = 'T' and m >= n: find the minimum norm solution of - !> an undetermined system A**T * X = B. - !> 4. If TRANS = 'T' 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. + !! SGETSLS solves overdetermined or underdetermined real 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 = 'T' and m >= n: find the minimum norm solution of + !! an undetermined system A**T * X = B. + !! 4. If TRANS = 'T' 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -66679,18 +66675,18 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) - !> SGETSQRHRT 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 SGEQRT - !> (Q is in blocked compact WY-representation). See the documentation - !> of SGEQRT for more details on the format. + !! SGETSQRHRT 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 SGEQRT + !! (Q is in blocked compact WY-representation). See the documentation + !! of SGEQRT for more details on the format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66812,12 +66808,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaed2( k, n, n1, d, q, ldq, indxq, rho, z, dlamda, w,q2, indx, indxc,& - !> SLAED2 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 entry in the - !> Z vector. For each such occurrence the order of the related secular - !> equation problem is reduced by one. + !! SLAED2 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 entry in the + !! Z vector. For each such occurrence the order of the related secular + !! equation problem is reduced by one. indxp, coltyp, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67069,17 +67065,17 @@ module stdlib_linalg_lapack_s subroutine stdlib_slaqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& - !> SLAQR2 is identical to SLAQR3 except that it avoids - !> recursion by calling SLAHQR instead of SLAQR4. - !> Aggressive early deflation: - !> This subroutine accepts as input an upper Hessenberg matrix - !> H and performs an orthogonal similarity transformation - !> designed to detect and deflate fully converged eigenvalues from - !> a trailing principal submatrix. On output H has been over- - !> written by a new Hessenberg matrix that is a perturbation of - !> an orthogonal similarity transformation of H. It is to be - !> hoped that the final version of H has many zero subdiagonal - !> entries. + !! SLAQR2 is identical to SLAQR3 except that it avoids + !! recursion by calling SLAHQR instead of SLAQR4. + !! Aggressive early deflation: + !! This subroutine accepts as input an upper Hessenberg matrix + !! H and performs an orthogonal similarity transformation + !! designed to detect and deflate fully converged eigenvalues from + !! a trailing principal submatrix. On output H has been over- + !! written by a new Hessenberg matrix that is a perturbation of + !! an orthogonal similarity transformation of H. It is to be + !! hoped that the final version of H has many zero subdiagonal + !! entries. sr, si, v, ldv, nh, t,ldt, nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67372,35 +67368,35 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasd1( nl, nr, sqre, d, alpha, beta, u, ldu, vt, ldvt,idxq, iwork, & - !> SLASD1 computes the SVD of an upper bidiagonal N-by-M matrix B, - !> where N = NL + NR + 1 and M = N + SQRE. SLASD1 is called from SLASD0. - !> A related subroutine SLASD7 handles the case in which the singular - !> values (and the singular vectors in factored form) are desired. - !> SLASD1 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 SLASD2. - !> 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 SLASD4 (as called - !> by SLASD3). 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. + !! SLASD1 computes the SVD of an upper bidiagonal N-by-M matrix B, + !! where N = NL + NR + 1 and M = N + SQRE. SLASD1 is called from SLASD0. + !! A related subroutine SLASD7 handles the case in which the singular + !! values (and the singular vectors in factored form) are desired. + !! SLASD1 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 SLASD2. + !! 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 SLASD4 (as called + !! by SLASD3). 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. work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67487,32 +67483,32 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaed1( n, d, q, ldq, indxq, rho, cutpnt, work, iwork,info ) - !> SLAED1 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. SLAED7 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 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. + !! SLAED1 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. SLAED7 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 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67590,8 +67586,8 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slaed0( icompq, qsiz, n, d, e, q, ldq, qstore, ldqs,work, iwork, info & - !> SLAED0 computes all eigenvalues and corresponding eigenvectors of a - !> symmetric tridiagonal matrix using the divide and conquer method. + !! SLAED0 computes all eigenvalues and corresponding eigenvectors of a + !! symmetric tridiagonal matrix using the divide and conquer method. ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67794,17 +67790,17 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sstedc( compz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) - !> SSTEDC computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric tridiagonal matrix using the divide and conquer method. - !> The eigenvectors of a full or band real symmetric matrix can also be - !> found if SSYTRD or SSPTRD or SSBTRD has been used to reduce this - !> matrix to tridiagonal 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 SLAED3 for details. + !! SSTEDC computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric tridiagonal matrix using the divide and conquer method. + !! The eigenvectors of a full or band real symmetric matrix can also be + !! found if SSYTRD or SSPTRD or SSBTRD has been used to reduce this + !! matrix to tridiagonal 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 SLAED3 for details. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68020,15 +68016,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sstevd( jobz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) - !> SSTEVD computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric tridiagonal matrix. 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. + !! SSTEVD computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric tridiagonal matrix. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68125,17 +68121,17 @@ module stdlib_linalg_lapack_s subroutine stdlib_ssyevd( jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info ) - !> SSYEVD computes all eigenvalues and, optionally, eigenvectors of a - !> real symmetric 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. - !> Because of large use of BLAS of level 3, SSYEVD needs N**2 more - !> workspace than SSYEVX. + !! SSYEVD computes all eigenvalues and, optionally, eigenvectors of a + !! real symmetric 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. + !! Because of large use of BLAS of level 3, SSYEVD needs N**2 more + !! workspace than SSYEVX. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -68259,17 +68255,17 @@ module stdlib_linalg_lapack_s subroutine stdlib_ssygvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, iwork, liwork,& - !> SSYGVD computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric 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. + !! SSYGVD computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68380,15 +68376,15 @@ module stdlib_linalg_lapack_s subroutine stdlib_ssbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, iwork, liwork, & - !> SSBEVD computes all the eigenvalues and, optionally, eigenvectors of - !> a real symmetric 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. + !! SSBEVD computes all the eigenvalues and, optionally, eigenvectors of + !! a real symmetric 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68512,17 +68508,17 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & - !> SSBGVD computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-definite banded eigenproblem, of the - !> form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric 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. + !! SSBGVD computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-definite banded eigenproblem, of the + !! form A*x=(lambda)*B*x. Here A and B are assumed to be symmetric 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. lwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68629,15 +68625,15 @@ module stdlib_linalg_lapack_s subroutine stdlib_sspevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,iwork, liwork, info ) - !> SSPEVD computes all the eigenvalues and, optionally, eigenvectors - !> of a real symmetric 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. + !! SSPEVD computes all the eigenvalues and, optionally, eigenvectors + !! of a real symmetric 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68754,18 +68750,18 @@ module stdlib_linalg_lapack_s subroutine stdlib_sspgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, iwork, liwork,& - !> SSPGVD computes all the eigenvalues, and optionally, the eigenvectors - !> of a real generalized symmetric-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 symmetric, 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. + !! SSPGVD computes all the eigenvalues, and optionally, the eigenvectors + !! of a real generalized symmetric-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 symmetric, 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68878,22 +68874,22 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sbdsdc( uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq,work, iwork, & - !> SBDSDC 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. SBDSDC 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 SLASD3 for details. - !> The code currently calls SLASDQ if singular values only are desired. - !> However, it can be slightly modified to compute singular values - !> using the divide and conquer method. + !! SBDSDC 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. SBDSDC 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 SLASD3 for details. + !! The code currently calls SLASDQ if singular values only are desired. + !! However, it can be slightly modified to compute singular values + !! using the divide and conquer method. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69136,30 +69132,30 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, work, & - !> SBDSQR 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**T - !> 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**T*VT instead of - !> P**T, for given real input matrices U and VT. When U and VT are the - !> orthogonal matrices that reduce a general matrix A to bidiagonal - !> form: A = U*B*VT, as computed by SGEBRD, then - !> A = (U*Q) * S * (P**T*VT) - !> is the SVD of A. Optionally, the subroutine may also compute Q**T*C - !> for a given real 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. + !! SBDSQR 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**T + !! 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**T*VT instead of + !! P**T, for given real input matrices U and VT. When U and VT are the + !! orthogonal matrices that reduce a general matrix A to bidiagonal + !! form: A = U*B*VT, as computed by SGEBRD, then + !! A = (U*Q) * S * (P**T*VT) + !! is the SVD of A. Optionally, the subroutine may also compute Q**T*C + !! for a given real 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69602,19 +69598,19 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgees( jobvs, sort, select, n, a, lda, sdim, wr, wi,vs, ldvs, work, lwork, & - !> SGEES computes for an N-by-N real nonsymmetric matrix A, the - !> eigenvalues, the real Schur form T, and, optionally, the matrix of - !> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). - !> Optionally, it also orders the eigenvalues on the diagonal of the - !> real 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 matrix is in real Schur form if it is upper quasi-triangular with - !> 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in the - !> form - !> [ a b ] - !> [ c a ] - !> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). + !! SGEES computes for an N-by-N real nonsymmetric matrix A, the + !! eigenvalues, the real Schur form T, and, optionally, the matrix of + !! Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). + !! Optionally, it also orders the eigenvalues on the diagonal of the + !! real 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 matrix is in real Schur form if it is upper quasi-triangular with + !! 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in the + !! form + !! [ a b ] + !! [ c a ] + !! where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69848,25 +69844,25 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgeesx( jobvs, sort, select, sense, n, a, lda, sdim,wr, wi, vs, ldvs, & - !> SGEESX computes for an N-by-N real nonsymmetric matrix A, the - !> eigenvalues, the real Schur form T, and, optionally, the matrix of - !> Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). - !> Optionally, it also orders the eigenvalues on the diagonal of the - !> real Schur form so that selected eigenvalues are at the top left; - !> computes a reciprocal condition number for the average of the - !> selected eigenvalues (RCONDE); and computes a reciprocal condition - !> number for the right invariant subspace corresponding to the - !> selected eigenvalues (RCONDV). The leading columns of Z form an - !> orthonormal basis for this invariant subspace. - !> For further explanation of the reciprocal condition numbers RCONDE - !> and RCONDV, see Section 4.10_sp of the LAPACK Users' Guide (where - !> these quantities are called s and sep respectively). - !> A real matrix is in real Schur form if it is upper quasi-triangular - !> with 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in - !> the form - !> [ a b ] - !> [ c a ] - !> where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). + !! SGEESX computes for an N-by-N real nonsymmetric matrix A, the + !! eigenvalues, the real Schur form T, and, optionally, the matrix of + !! Schur vectors Z. This gives the Schur factorization A = Z*T*(Z**T). + !! Optionally, it also orders the eigenvalues on the diagonal of the + !! real Schur form so that selected eigenvalues are at the top left; + !! computes a reciprocal condition number for the average of the + !! selected eigenvalues (RCONDE); and computes a reciprocal condition + !! number for the right invariant subspace corresponding to the + !! selected eigenvalues (RCONDV). The leading columns of Z form an + !! orthonormal basis for this invariant subspace. + !! For further explanation of the reciprocal condition numbers RCONDE + !! and RCONDV, see Section 4.10_sp of the LAPACK Users' Guide (where + !! these quantities are called s and sep respectively). + !! A real matrix is in real Schur form if it is upper quasi-triangular + !! with 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in + !! the form + !! [ a b ] + !! [ c a ] + !! where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc). rconde, rcondv, work, lwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70142,16 +70138,16 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgeev( jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr,ldvr, work, lwork, & - !> SGEEV computes for an N-by-N real 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. + !! SGEEV computes for an N-by-N real 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70401,31 +70397,31 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgeevx( balanc, jobvl, jobvr, sense, n, a, lda, wr, wi,vl, ldvl, vr, ldvr, & - !> SGEEVX computes for an N-by-N real nonsymmetric matrix A, the - !> eigenvalues and, optionally, the left and/or right eigenvectors. - !> Optionally also, it computes a balancing transformation to improve - !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, - !> SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues - !> (RCONDE), and reciprocal condition numbers for the right - !> eigenvectors (RCONDV). - !> 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. - !> Balancing a matrix means permuting the rows and columns to make it - !> more nearly upper triangular, and applying a diagonal similarity - !> transformation D * A * D**(-1), where D is a diagonal matrix, to - !> make its rows and columns closer in norm and the condition numbers - !> of its eigenvalues and eigenvectors smaller. The computed - !> reciprocal condition numbers correspond to the balanced matrix. - !> Permuting rows and columns will not change the condition numbers - !> (in exact arithmetic) but diagonal scaling will. For further - !> explanation of balancing, see section 4.10.2_sp of the LAPACK - !> Users' Guide. + !! SGEEVX computes for an N-by-N real nonsymmetric matrix A, the + !! eigenvalues and, optionally, the left and/or right eigenvectors. + !! Optionally also, it computes a balancing transformation to improve + !! the conditioning of the eigenvalues and eigenvectors (ILO, IHI, + !! SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues + !! (RCONDE), and reciprocal condition numbers for the right + !! eigenvectors (RCONDV). + !! 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. + !! Balancing a matrix means permuting the rows and columns to make it + !! more nearly upper triangular, and applying a diagonal similarity + !! transformation D * A * D**(-1), where D is a diagonal matrix, to + !! make its rows and columns closer in norm and the condition numbers + !! of its eigenvalues and eigenvectors smaller. The computed + !! reciprocal condition numbers correspond to the balanced matrix. + !! Permuting rows and columns will not change the condition numbers + !! (in exact arithmetic) but diagonal scaling will. For further + !! explanation of balancing, see section 4.10.2_sp of the LAPACK + !! Users' Guide. ilo, ihi, scale, abnrm,rconde, rcondv, work, lwork, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70713,18 +70709,18 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & - !> SGEJSV computes the singular value decomposition (SVD) of a real M-by-N - !> matrix [A], where M >= N. The SVD of [A] is written as - !> [A] = [U] * [SIGMA] * [V]^t, - !> 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) orthonormal matrix, and - !> [V] is an N-by-N orthogonal 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. - !> SGEJSV can sometimes compute tiny singular values and their singular vectors much - !> more accurately than other SVD routines, see below under Further Details. + !! SGEJSV computes the singular value decomposition (SVD) of a real M-by-N + !! matrix [A], where M >= N. The SVD of [A] is written as + !! [A] = [U] * [SIGMA] * [V]^t, + !! 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) orthonormal matrix, and + !! [V] is an N-by-N orthogonal 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. + !! SGEJSV can sometimes compute tiny singular values and their singular vectors much + !! more accurately than other SVD routines, see below under Further Details. v, ldv,work, lwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71803,31 +71799,31 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond,rank, work, lwork, iwork, & - !> SGELSD 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. + !! SGELSD 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72129,18 +72125,18 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, info ) - !> SGELSS 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 effective rank of A is determined by treating as zero those - !> singular values which are less than RCOND times the largest singular - !> value. + !! SGELSS 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 effective rank of A is determined by treating as zero those + !! singular values which are less than RCOND times the largest singular + !! value. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72568,25 +72564,25 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, iwork, info ) - !> SGESDD computes the singular value decomposition (SVD) of a real - !> M-by-N matrix A, optionally computing the left and right singular - !> vectors. If singular vectors are desired, it uses a - !> divide-and-conquer algorithm. - !> The SVD is written - !> A = U * SIGMA * 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 orthogonal matrix, and - !> V is an N-by-N orthogonal 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**T, 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. + !! SGESDD computes the singular value decomposition (SVD) of a real + !! M-by-N matrix A, optionally computing the left and right singular + !! vectors. If singular vectors are desired, it uses a + !! divide-and-conquer algorithm. + !! The SVD is written + !! A = U * SIGMA * 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 orthogonal matrix, and + !! V is an N-by-N orthogonal 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**T, 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73539,17 +73535,17 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, info ) - !> SGESVD computes the singular value decomposition (SVD) of a real - !> M-by-N matrix A, optionally computing the left and/or right singular - !> vectors. The SVD is written - !> A = U * SIGMA * 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 orthogonal matrix, and - !> V is an N-by-N orthogonal 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**T, not V. + !! SGESVD computes the singular value decomposition (SVD) of a real + !! M-by-N matrix A, optionally computing the left and/or right singular + !! vectors. The SVD is written + !! A = U * SIGMA * 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 orthogonal matrix, and + !! V is an N-by-N orthogonal 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**T, not V. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75799,15 +75795,15 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & - !> SGESVDQ computes the singular value decomposition (SVD) of a real - !> 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 orthogonal 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. + !! SGESVDQ computes the singular value decomposition (SVD) of a real + !! 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 orthogonal 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. numrank, iwork, liwork,work, lwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -76665,17 +76661,17 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, work, lwork, & - !> SGESVJ computes the singular value decomposition (SVD) of a real - !> M-by-N matrix A, where M >= N. The SVD of A is written as - !> [++] [xx] [x0] [xx] - !> A = U * SIGMA * V^t, [++] = [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 orthogonal 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. - !> SGESVJ can sometimes compute tiny singular values and their singular vectors much - !> more accurately than other SVD routines, see below under Further Details. + !! SGESVJ computes the singular value decomposition (SVD) of a real + !! M-by-N matrix A, where M >= N. The SVD of A is written as + !! [++] [xx] [x0] [xx] + !! A = U * SIGMA * V^t, [++] = [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 orthogonal 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. + !! SGESVJ can sometimes compute tiny singular values and their singular vectors much + !! more accurately than other SVD routines, see below under Further Details. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77644,32 +77640,32 @@ module stdlib_linalg_lapack_s subroutine stdlib_sgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alphar, & - !> SGGES3 computes for a pair of N-by-N real nonsymmetric matrices (A,B), - !> the generalized eigenvalues, the generalized real Schur form (S,T), - !> optionally, the left and/or right matrices of Schur vectors (VSL and - !> VSR). This gives the generalized Schur factorization - !> (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T ) - !> Optionally, it also orders the eigenvalues so that a selected cluster - !> of eigenvalues appears in the leading diagonal blocks of the upper - !> quasi-triangular matrix S and the upper triangular matrix T.The - !> leading columns of VSL and VSR then form an orthonormal basis for the - !> corresponding left and right eigenspaces (deflating subspaces). - !> (If only the generalized eigenvalues are needed, use the driver - !> SGGEV 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 or both being zero. - !> A pair of matrices (S,T) is in generalized real Schur form if T is - !> upper triangular with non-negative diagonal and S is block upper - !> triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond - !> to real generalized eigenvalues, while 2-by-2 blocks of S will be - !> "standardized" by making the corresponding elements of T have the - !> form: - !> [ a 0 ] - !> [ 0 b ] - !> and the pair of corresponding 2-by-2 blocks in S and T will have a - !> complex conjugate pair of generalized eigenvalues. + !! SGGES3 computes for a pair of N-by-N real nonsymmetric matrices (A,B), + !! the generalized eigenvalues, the generalized real Schur form (S,T), + !! optionally, the left and/or right matrices of Schur vectors (VSL and + !! VSR). This gives the generalized Schur factorization + !! (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T ) + !! Optionally, it also orders the eigenvalues so that a selected cluster + !! of eigenvalues appears in the leading diagonal blocks of the upper + !! quasi-triangular matrix S and the upper triangular matrix T.The + !! leading columns of VSL and VSR then form an orthonormal basis for the + !! corresponding left and right eigenspaces (deflating subspaces). + !! (If only the generalized eigenvalues are needed, use the driver + !! SGGEV 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 or both being zero. + !! A pair of matrices (S,T) is in generalized real Schur form if T is + !! upper triangular with non-negative diagonal and S is block upper + !! triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond + !! to real generalized eigenvalues, while 2-by-2 blocks of S will be + !! "standardized" by making the corresponding elements of T have the + !! form: + !! [ a 0 ] + !! [ 0 b ] + !! and the pair of corresponding 2-by-2 blocks in S and T will have a + !! complex conjugate pair of generalized eigenvalues. alphai, beta, vsl, ldvsl,vsr, ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77958,21 +77954,21 @@ module stdlib_linalg_lapack_s subroutine stdlib_sggev3( jobvl, jobvr, n, a, lda, b, ldb, alphar,alphai, beta, vl, ldvl, vr,& - !> SGGEV3 computes for a pair of N-by-N real 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) - !> of (A,B) satisfies - !> A * v(j) = lambda(j) * B * v(j). - !> The left eigenvector u(j) corresponding to the eigenvalue 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). + !! SGGEV3 computes for a pair of N-by-N real 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) + !! of (A,B) satisfies + !! A * v(j) = lambda(j) * B * v(j). + !! The left eigenvector u(j) corresponding to the eigenvalue 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). ldvr, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78253,10 +78249,10 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & - !> SGSVJ0 is called from SGESVJ as a pre-processor and that is its main - !> purpose. It applies Jacobi rotations in the same way as SGESVJ does, but - !> it does not check convergence (stopping criterion). Few tuning - !> parameters (marked by [TP]) are available for the implementer. + !! SGSVJ0 is called from SGESVJ as a pre-processor and that is its main + !! purpose. It applies Jacobi rotations in the same way as SGESVJ does, but + !! it does not check convergence (stopping criterion). Few tuning + !! parameters (marked by [TP]) are available for the implementer. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78901,30 +78897,30 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & - !> SGSVJ1 is called from SGESVJ as a pre-processor and that is its main - !> purpose. It applies Jacobi rotations in the same way as SGESVJ 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 - !> ~~~~~~~~~~~~~~~ - !> SGSVJ1 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. + !! SGSVJ1 is called from SGESVJ as a pre-processor and that is its main + !! purpose. It applies Jacobi rotations in the same way as SGESVJ 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 + !! ~~~~~~~~~~~~~~~ + !! SGSVJ1 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. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79332,14 +79328,14 @@ module stdlib_linalg_lapack_s subroutine stdlib_shseqr( job, compz, n, ilo, ihi, h, ldh, wr, wi, z,ldz, work, lwork, info ) - !> SHSEQR computes the eigenvalues of a Hessenberg matrix H - !> and, optionally, the matrices T and Z from the Schur decomposition - !> H = Z T Z**T, where T is an upper quasi-triangular matrix (the - !> Schur form), and Z is the orthogonal matrix of Schur vectors. - !> Optionally Z may be postmultiplied into an input orthogonal - !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. + !! SHSEQR computes the eigenvalues of a Hessenberg matrix H + !! and, optionally, the matrices T and Z from the Schur decomposition + !! H = Z T Z**T, where T is an upper quasi-triangular matrix (the + !! Schur form), and Z is the orthogonal matrix of Schur vectors. + !! Optionally Z may be postmultiplied into an input orthogonal + !! 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79479,15 +79475,15 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, difl,& - !> SLALSA 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, SLALSA applies the inverse of the left singular vector - !> matrix of an upper bidiagonal matrix to the right hand side; and if - !> ICOMPQ = 1, SLALSA applies the right singular vector matrix to the - !> right hand side. The singular vector matrices were generated in - !> compact form by SLALSA. + !! SLALSA 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, SLALSA applies the inverse of the left singular vector + !! matrix of an upper bidiagonal matrix to the right hand side; and if + !! ICOMPQ = 1, SLALSA applies the right singular vector matrix to the + !! right hand side. The singular vector matrices were generated in + !! compact form by SLALSA. difr, z, poles, givptr,givcol, ldgcol, perm, givnum, c, s, work,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79663,20 +79659,20 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, iwork, & - !> SLALSD 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. + !! SLALSD 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79936,14 +79932,14 @@ module stdlib_linalg_lapack_s subroutine stdlib_slaqr0( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& - !> SLAQR0 computes the eigenvalues of a Hessenberg matrix H - !> and, optionally, the matrices T and Z from the Schur decomposition - !> H = Z T Z**T, where T is an upper quasi-triangular matrix (the - !> Schur form), and Z is the orthogonal matrix of Schur vectors. - !> Optionally Z may be postmultiplied into an input orthogonal - !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. + !! SLAQR0 computes the eigenvalues of a Hessenberg matrix H + !! and, optionally, the matrices T and Z from the Schur decomposition + !! H = Z T Z**T, where T is an upper quasi-triangular matrix (the + !! Schur form), and Z is the orthogonal matrix of Schur vectors. + !! Optionally Z may be postmultiplied into an input orthogonal + !! 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80306,15 +80302,15 @@ module stdlib_linalg_lapack_s subroutine stdlib_slaqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, ns, nd,& - !> Aggressive early deflation: - !> SLAQR3 accepts as input an upper Hessenberg matrix - !> H and performs an orthogonal similarity transformation - !> designed to detect and deflate fully converged eigenvalues from - !> a trailing principal submatrix. On output H has been over- - !> written by a new Hessenberg matrix that is a perturbation of - !> an orthogonal similarity transformation of H. It is to be - !> hoped that the final version of H has many zero subdiagonal - !> entries. + !! Aggressive early deflation: + !! SLAQR3 accepts as input an upper Hessenberg matrix + !! H and performs an orthogonal similarity transformation + !! designed to detect and deflate fully converged eigenvalues from + !! a trailing principal submatrix. On output H has been over- + !! written by a new Hessenberg matrix that is a perturbation of + !! an orthogonal similarity transformation of H. It is to be + !! hoped that the final version of H has many zero subdiagonal + !! entries. sr, si, v, ldv, nh, t,ldt, nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80617,20 +80613,20 @@ module stdlib_linalg_lapack_s subroutine stdlib_slaqr4( wantt, wantz, n, ilo, ihi, h, ldh, wr, wi,iloz, ihiz, z, ldz, work,& - !> SLAQR4 implements one level of recursion for SLAQR0. - !> It is a complete implementation of the small bulge multi-shift - !> QR algorithm. It may be called by SLAQR0 and, for large enough - !> deflation window size, it may be called by SLAQR3. This - !> subroutine is identical to SLAQR0 except that it calls SLAQR2 - !> instead of SLAQR3. - !> SLAQR4 computes the eigenvalues of a Hessenberg matrix H - !> and, optionally, the matrices T and Z from the Schur decomposition - !> H = Z T Z**T, where T is an upper quasi-triangular matrix (the - !> Schur form), and Z is the orthogonal matrix of Schur vectors. - !> Optionally Z may be postmultiplied into an input orthogonal - !> 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. + !! SLAQR4 implements one level of recursion for SLAQR0. + !! It is a complete implementation of the small bulge multi-shift + !! QR algorithm. It may be called by SLAQR0 and, for large enough + !! deflation window size, it may be called by SLAQR3. This + !! subroutine is identical to SLAQR0 except that it calls SLAQR2 + !! instead of SLAQR3. + !! SLAQR4 computes the eigenvalues of a Hessenberg matrix H + !! and, optionally, the matrices T and Z from the Schur decomposition + !! H = Z T Z**T, where T is an upper quasi-triangular matrix (the + !! Schur form), and Z is the orthogonal matrix of Schur vectors. + !! Optionally Z may be postmultiplied into an input orthogonal + !! 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 orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80988,54 +80984,54 @@ module stdlib_linalg_lapack_s recursive subroutine stdlib_slaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alphar, & - !> SLAQZ0 computes the eigenvalues of a real 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 real matrix pair (A,B): - !> A = Q1*H*Z1**T, B = Q1*T*Z1**T, - !> as computed by SGGHRD. - !> If JOB='S', then the Hessenberg-triangular pair (H,T) is - !> also reduced to generalized Schur form, - !> H = Q*S*Z**T, T = Q*P*Z**T, - !> where Q and Z are orthogonal matrices, P is an upper triangular - !> matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2 - !> diagonal blocks. - !> The 1-by-1 blocks correspond to real eigenvalues of the matrix pair - !> (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of - !> eigenvalues. - !> Additionally, the 2-by-2 upper triangular diagonal blocks of P - !> corresponding to 2-by-2 blocks of S are reduced to positive diagonal - !> form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0, - !> P(j,j) > 0, and P(j+1,j+1) > 0. - !> Optionally, the orthogonal matrix Q from the generalized Schur - !> factorization may be postmultiplied into an input matrix Q1, and the - !> orthogonal matrix Z may be postmultiplied into an input matrix Z1. - !> If Q1 and Z1 are the orthogonal matrices from SGGHRD that reduced - !> the matrix pair (A,B) to generalized upper Hessenberg form, then the - !> output matrices Q1*Q and Z1*Z are the orthogonal factors from the - !> generalized Schur factorization of (A,B): - !> A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T. - !> 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. - !> Real 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" + !! SLAQZ0 computes the eigenvalues of a real 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 real matrix pair (A,B): + !! A = Q1*H*Z1**T, B = Q1*T*Z1**T, + !! as computed by SGGHRD. + !! If JOB='S', then the Hessenberg-triangular pair (H,T) is + !! also reduced to generalized Schur form, + !! H = Q*S*Z**T, T = Q*P*Z**T, + !! where Q and Z are orthogonal matrices, P is an upper triangular + !! matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2 + !! diagonal blocks. + !! The 1-by-1 blocks correspond to real eigenvalues of the matrix pair + !! (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of + !! eigenvalues. + !! Additionally, the 2-by-2 upper triangular diagonal blocks of P + !! corresponding to 2-by-2 blocks of S are reduced to positive diagonal + !! form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0, + !! P(j,j) > 0, and P(j+1,j+1) > 0. + !! Optionally, the orthogonal matrix Q from the generalized Schur + !! factorization may be postmultiplied into an input matrix Q1, and the + !! orthogonal matrix Z may be postmultiplied into an input matrix Z1. + !! If Q1 and Z1 are the orthogonal matrices from SGGHRD that reduced + !! the matrix pair (A,B) to generalized upper Hessenberg form, then the + !! output matrices Q1*Q and Z1*Z are the orthogonal factors from the + !! generalized Schur factorization of (A,B): + !! A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T. + !! 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. + !! Real 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" alphai, beta,q, ldq, z, ldz, work, lwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -81380,7 +81376,7 @@ module stdlib_linalg_lapack_s recursive subroutine stdlib_slaqz3( ilschur, ilq, ilz, n, ilo, ihi, nw,a, lda, b, ldb, q, & - !> SLAQZ3 performs AED + !! SLAQZ3 performs AED ldq, z, ldz, ns,nd, alphar, alphai, beta, qc, ldqc,zc, ldzc, work, lwork, rec, info ) ! arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -81652,19 +81648,19 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slarre( range, n, vl, vu, il, iu, d, e, e2,rtol1, rtol2, spltol, & - !> To find the desired eigenvalues of a given real symmetric - !> tridiagonal matrix T, SLARRE: 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 - !> SSTEMR 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 SLASQ2) to - !> conpute all and then discard any unwanted one. - !> As an added benefit, SLARRE also outputs the n - !> Gerschgorin intervals for the matrices L_i D_i L_i^T. + !! To find the desired eigenvalues of a given real symmetric + !! tridiagonal matrix T, SLARRE: 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 + !! SSTEMR 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 SLASQ2) to + !! conpute all and then discard any unwanted one. + !! As an added benefit, SLARRE also outputs the n + !! Gerschgorin intervals for the matrices L_i D_i L_i^T. nsplit, isplit, m,w, werr, wgap, iblock, indexw, gers, pivmin,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82181,13 +82177,13 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasd0( n, sqre, d, e, u, ldu, vt, ldvt, smlsiz, iwork,work, info ) - !> Using a divide and conquer approach, SLASD0: 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, SLASDA, computes only the singular values, - !> and optionally, the singular vectors in compact form. + !! Using a divide and conquer approach, SLASD0: 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, SLASDA, computes only the singular values, + !! and optionally, the singular vectors in compact form. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82320,14 +82316,14 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasda( icompq, smlsiz, n, sqre, d, e, u, ldu, vt, k,difl, difr, z, & - !> Using a divide and conquer approach, SLASDA: 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, SLASD0, computes the singular values and - !> the singular vectors in explicit form. + !! Using a divide and conquer approach, SLASDA: 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, SLASD0, computes the singular values and + !! the singular vectors in explicit form. poles, givptr, givcol, ldgcol,perm, givnum, c, s, work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82522,18 +82518,18 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasdq( uplo, sqre, n, ncvt, nru, ncc, d, e, vt, ldvt,u, ldu, c, ldc, & - !> SLASDQ 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. + !! SLASDQ 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. work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82687,16 +82683,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasq1( n, d, e, work, info ) - !> SLASQ1 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. + !! SLASQ1 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -82779,19 +82775,19 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasq2( n, z, info ) - !> SLASQ2 computes all the eigenvalues of the symmetric positive - !> definite tridiagonal matrix associated with the qd array Z to high - !> relative accuracy are computed to high relative accuracy, in the - !> absence of denormalization, underflow and overflow. - !> To see the relation of Z to the tridiagonal matrix, let L be a - !> unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and - !> let U be an upper bidiagonal matrix with 1's above and diagonal - !> Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the - !> symmetric tridiagonal to which it is similar. - !> Note : SLASQ2 defines a logical variable, IEEE, which is true - !> on machines which follow ieee-754 floating-point standard in their - !> handling of infinities and NaNs, and false otherwise. This variable - !> is passed to SLASQ3. + !! SLASQ2 computes all the eigenvalues of the symmetric positive + !! definite tridiagonal matrix associated with the qd array Z to high + !! relative accuracy are computed to high relative accuracy, in the + !! absence of denormalization, underflow and overflow. + !! To see the relation of Z to the tridiagonal matrix, let L be a + !! unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and + !! let U be an upper bidiagonal matrix with 1's above and diagonal + !! Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the + !! symmetric tridiagonal to which it is similar. + !! Note : SLASQ2 defines a logical variable, IEEE, which is true + !! on machines which follow ieee-754 floating-point standard in their + !! handling of infinities and NaNs, and false otherwise. This variable + !! is passed to SLASQ3. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83172,16 +83168,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_slasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) - !> DLATRF_AA factorizes a panel of a real 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. + !! DLATRF_AA factorizes a panel of a real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83406,21 +83402,21 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_spteqr( compz, n, d, e, z, ldz, work, info ) - !> SPTEQR computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric positive definite tridiagonal matrix by first factoring the - !> matrix using SPTTRF, and then calling SBDSQR to compute the singular - !> values of the bidiagonal factor. - !> This routine computes the eigenvalues of the positive definite - !> tridiagonal matrix to high relative accuracy. This means that if the - !> eigenvalues range over many orders of magnitude in size, then the - !> small eigenvalues and corresponding eigenvectors will be computed - !> more accurately than, for example, with the standard QR method. - !> The eigenvectors of a full or band symmetric positive definite matrix - !> can also be found if SSYTRD, SSPTRD, or SSBTRD has been used to - !> reduce this matrix to tridiagonal form. (The reduction to tridiagonal - !> form, however, may preclude the possibility of obtaining high - !> relative accuracy in the small eigenvalues of the original matrix, if - !> these eigenvalues range over many orders of magnitude.) + !! SPTEQR computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric positive definite tridiagonal matrix by first factoring the + !! matrix using SPTTRF, and then calling SBDSQR to compute the singular + !! values of the bidiagonal factor. + !! This routine computes the eigenvalues of the positive definite + !! tridiagonal matrix to high relative accuracy. This means that if the + !! eigenvalues range over many orders of magnitude in size, then the + !! small eigenvalues and corresponding eigenvectors will be computed + !! more accurately than, for example, with the standard QR method. + !! The eigenvectors of a full or band symmetric positive definite matrix + !! can also be found if SSYTRD, SSPTRD, or SSBTRD has been used to + !! reduce this matrix to tridiagonal form. (The reduction to tridiagonal + !! form, however, may preclude the possibility of obtaining high + !! relative accuracy in the small eigenvalues of the original matrix, if + !! these eigenvalues range over many orders of magnitude.) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -83500,22 +83496,22 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> SSTEGR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has - !> a well defined set of pairwise different real eigenvalues, the corresponding - !> real eigenvectors are pairwise orthogonal. - !> The spectrum may be computed either completely or partially by specifying - !> either an interval (VL,VU] or a range of indices IL:IU for the desired - !> eigenvalues. - !> SSTEGR is a compatibility wrapper around the improved SSTEMR routine. - !> See SSTEMR for further details. - !> One important change is that the ABSTOL parameter no longer provides any - !> benefit and hence is no longer used. - !> Note : SSTEGR and SSTEMR work only on machines which follow - !> IEEE-754 floating-point standard in their handling of infinities and - !> NaNs. Normal execution may create these exceptiona values and hence - !> may abort due to a floating point exception in environments which - !> do not conform to the IEEE-754 standard. + !! SSTEGR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Any such unreduced matrix has + !! a well defined set of pairwise different real eigenvalues, the corresponding + !! real eigenvectors are pairwise orthogonal. + !! The spectrum may be computed either completely or partially by specifying + !! either an interval (VL,VU] or a range of indices IL:IU for the desired + !! eigenvalues. + !! SSTEGR is a compatibility wrapper around the improved SSTEMR routine. + !! See SSTEMR for further details. + !! One important change is that the ABSTOL parameter no longer provides any + !! benefit and hence is no longer used. + !! Note : SSTEGR and SSTEMR work only on machines which follow + !! IEEE-754 floating-point standard in their handling of infinities and + !! NaNs. Normal execution may create these exceptiona values and hence + !! may abort due to a floating point exception in environments which + !! do not conform to the IEEE-754 standard. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83542,51 +83538,51 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & - !> SSTEMR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has - !> a well defined set of pairwise different real eigenvalues, the corresponding - !> real eigenvectors are pairwise orthogonal. - !> The spectrum may be computed either completely or partially by specifying - !> either an interval (VL,VU] or a range of indices IL:IU for the desired - !> eigenvalues. - !> Depending on the number of desired eigenvalues, these are computed either - !> by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are - !> computed by the use of various suitable L D L^T factorizations near clusters - !> of close eigenvalues (referred to as RRRs, Relatively Robust - !> Representations). An informal sketch of the algorithm 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. - !> For more details, see: - !> - 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. - !> Further Details - !> 1.SSTEMR works only on machines which follow IEEE-754 - !> floating-point standard in their handling of infinities and NaNs. - !> This permits the use of efficient inner loops avoiding a check for - !> zero divisors. + !! SSTEMR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Any such unreduced matrix has + !! a well defined set of pairwise different real eigenvalues, the corresponding + !! real eigenvectors are pairwise orthogonal. + !! The spectrum may be computed either completely or partially by specifying + !! either an interval (VL,VU] or a range of indices IL:IU for the desired + !! eigenvalues. + !! Depending on the number of desired eigenvalues, these are computed either + !! by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are + !! computed by the use of various suitable L D L^T factorizations near clusters + !! of close eigenvalues (referred to as RRRs, Relatively Robust + !! Representations). An informal sketch of the algorithm 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. + !! For more details, see: + !! - 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. + !! Further Details + !! 1.SSTEMR works only on machines which follow IEEE-754 + !! floating-point standard in their handling of infinities and NaNs. + !! This permits the use of efficient inner loops avoiding a check for + !! zero divisors. isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83962,41 +83958,41 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_sstevr( jobz, range, n, d, e, vl, vu, il, iu, abstol,m, w, z, ldz, & - !> SSTEVR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Eigenvalues and - !> eigenvectors can be selected by specifying either a range of values - !> or a range of indices for the desired eigenvalues. - !> Whenever possible, SSTEVR calls SSTEMR to compute the - !> eigenspectrum using Relatively Robust Representations. SSTEMR - !> 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 the i-th - !> unreduced block of T, - !> (a) Compute T - sigma_i = L_i D_i L_i^T, such that L_i D_i L_i^T - !> is a relatively robust representation, - !> (b) Compute the eigenvalues, lambda_j, of L_i D_i L_i^T to high - !> relative accuracy by the dqds algorithm, - !> (c) If there is a cluster of close eigenvalues, "choose" sigma_i - !> close to the cluster, and go to step (a), - !> (d) Given the approximate eigenvalue lambda_j of L_i D_i L_i^T, - !> compute the corresponding eigenvector by forming a - !> rank-revealing twisted factorization. - !> The desired accuracy of the output can be specified by the input - !> parameter ABSTOL. - !> For more details, see "A new O(n^2) algorithm for the symmetric - !> tridiagonal eigenvalue/eigenvector problem", by Inderjit Dhillon, - !> Computer Science Division Technical Report No. UCB//CSD-97-971, - !> UC Berkeley, May 1997. - !> Note 1 : SSTEVR calls SSTEMR when the full spectrum is requested - !> on machines which conform to the ieee-754 floating point standard. - !> SSTEVR calls SSTEBZ and SSTEIN on non-ieee machines and - !> when partial spectrum requests are made. - !> Normal execution of SSTEMR 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. + !! SSTEVR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Eigenvalues and + !! eigenvectors can be selected by specifying either a range of values + !! or a range of indices for the desired eigenvalues. + !! Whenever possible, SSTEVR calls SSTEMR to compute the + !! eigenspectrum using Relatively Robust Representations. SSTEMR + !! 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 the i-th + !! unreduced block of T, + !! (a) Compute T - sigma_i = L_i D_i L_i^T, such that L_i D_i L_i^T + !! is a relatively robust representation, + !! (b) Compute the eigenvalues, lambda_j, of L_i D_i L_i^T to high + !! relative accuracy by the dqds algorithm, + !! (c) If there is a cluster of close eigenvalues, "choose" sigma_i + !! close to the cluster, and go to step (a), + !! (d) Given the approximate eigenvalue lambda_j of L_i D_i L_i^T, + !! compute the corresponding eigenvector by forming a + !! rank-revealing twisted factorization. + !! The desired accuracy of the output can be specified by the input + !! parameter ABSTOL. + !! For more details, see "A new O(n^2) algorithm for the symmetric + !! tridiagonal eigenvalue/eigenvector problem", by Inderjit Dhillon, + !! Computer Science Division Technical Report No. UCB//CSD-97-971, + !! UC Berkeley, May 1997. + !! Note 1 : SSTEVR calls SSTEMR when the full spectrum is requested + !! on machines which conform to the ieee-754 floating point standard. + !! SSTEVR calls SSTEBZ and SSTEIN on non-ieee machines and + !! when partial spectrum requests are made. + !! Normal execution of SSTEMR 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. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84209,56 +84205,56 @@ module stdlib_linalg_lapack_s subroutine stdlib_ssyevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> SSYEVR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric matrix A. Eigenvalues and eigenvectors can be - !> selected by specifying either a range of values or a range of - !> indices for the desired eigenvalues. - !> SSYEVR first reduces the matrix A to tridiagonal form T with a call - !> to SSYTRD. Then, whenever possible, SSYEVR calls SSTEMR to compute - !> the eigenspectrum using Relatively Robust Representations. SSTEMR - !> 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 SSTEMR'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 : SSYEVR calls SSTEMR when the full spectrum is requested - !> on machines which conform to the ieee-754 floating point standard. - !> SSYEVR calls SSTEBZ and SSTEIN on non-ieee machines and - !> when partial spectrum requests are made. - !> Normal execution of SSTEMR 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. + !! SSYEVR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric matrix A. Eigenvalues and eigenvectors can be + !! selected by specifying either a range of values or a range of + !! indices for the desired eigenvalues. + !! SSYEVR first reduces the matrix A to tridiagonal form T with a call + !! to SSYTRD. Then, whenever possible, SSYEVR calls SSTEMR to compute + !! the eigenspectrum using Relatively Robust Representations. SSTEMR + !! 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 SSTEMR'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 : SSYEVR calls SSTEMR when the full spectrum is requested + !! on machines which conform to the ieee-754 floating point standard. + !! SSYEVR calls SSTEBZ and SSTEIN on non-ieee machines and + !! when partial spectrum requests are made. + !! Normal execution of SSTEMR 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. isuppz, work, lwork,iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84538,16 +84534,16 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> SSYSV computes the solution to a real system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> Aasen's algorithm is used to factor A as - !> A = U**T * T * U, if UPLO = 'U', or - !> A = L * T * L**T, if UPLO = 'L', - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and T is symmetric tridiagonal. The factored - !> form of A is then used to solve the system of equations A * X = B. + !! SSYSV computes the solution to a real system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! Aasen's algorithm is used to factor A as + !! A = U**T * T * U, if UPLO = 'U', or + !! A = L * T * L**T, if UPLO = 'L', + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and T is symmetric tridiagonal. The factored + !! form of A is then used to solve the system of equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84610,12 +84606,12 @@ module stdlib_linalg_lapack_s pure subroutine stdlib_ssytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) - !> SSYTRF_AA computes the factorization of a real symmetric matrix A - !> using the Aasen's algorithm. The form of the factorization is - !> A = U**T*T*U or A = L*T*L**T - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and T is a symmetric tridiagonal matrix. - !> This is the blocked version of the algorithm, calling Level 3 BLAS. + !! SSYTRF_AA computes the factorization of a real symmetric matrix A + !! using the Aasen's algorithm. The form of the factorization is + !! A = U**T*T*U or A = L*T*L**T + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and T is a symmetric tridiagonal matrix. + !! This is the blocked version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_lapack_w.fypp b/src/stdlib_linalg_lapack_w.fypp index f5e1337a9..62ff5a694 100644 --- a/src/stdlib_linalg_lapack_w.fypp +++ b/src/stdlib_linalg_lapack_w.fypp @@ -508,11 +508,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlag2w( m, n, sa, ldsa, a, lda, info ) - !> ZLAG2W: converts a COMPLEX matrix, SA, to a COMPLEX*16 matrix, A. - !> Note that while it is possible to overflow while converting - !> from double to single, it is not possible to overflow when - !> converting from single to double. - !> This is an auxiliary routine so there is no argument checking. + !! ZLAG2W: converts a COMPLEX matrix, SA, to a COMPLEX*16 matrix, A. + !! Note that while it is possible to overflow while converting + !! from double to single, it is not possible to overflow when + !! converting from single to double. + !! This is an auxiliary routine so there is no argument checking. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -537,27 +537,27 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wbbcsd( jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q,theta, phi, u1, & - !> ZBBCSD: 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 ZUNCSD 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. + !! ZBBCSD: 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 ZUNCSD 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. ldu1, u2, ldu2, v1t, ldv1t,v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e,b22d, b22e, rwork, & lrwork, info ) ! -- lapack computational routine -- @@ -1150,30 +1150,30 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, rwork,& - !> ZBDSQR: 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 ZGEBRD, 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. + !! ZBDSQR: 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 ZGEBRD, 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1613,33 +1613,33 @@ module stdlib_linalg_lapack_w subroutine stdlib_wcgesv( n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work,swork, rwork, iter, & - !> ZCGESV: 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. - !> ZCGESV first attempts to factorize the matrix in COMPLEX and use this - !> factorization within an iterative refinement procedure to produce a - !> solution with COMPLEX*16 normwise backward error quality (see below). - !> If the approach fails the method switches to a COMPLEX*16 - !> factorization and solve. - !> The iterative refinement is not going to be a winning strategy if - !> the ratio COMPLEX performance over COMPLEX*16 performance is too - !> small. A reasonable strategy should take the number of right-hand - !> sides and the size of the matrix into account. This might be done - !> with a call to ILAENV in the future. Up to now, we always try - !> iterative refinement. - !> The iterative refinement process is stopped if - !> ITER > ITERMAX - !> or for all the RHS we have: - !> RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX - !> where - !> o ITER is the number of the current iteration in the iterative - !> refinement process - !> o RNRM is the infinity-norm of the residual - !> o XNRM is the infinity-norm of the solution - !> o ANRM is the infinity-operator-norm of the matrix A - !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') - !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 - !> respectively. + !! ZCGESV: 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. + !! ZCGESV first attempts to factorize the matrix in COMPLEX and use this + !! factorization within an iterative refinement procedure to produce a + !! solution with COMPLEX*16 normwise backward error quality (see below). + !! If the approach fails the method switches to a COMPLEX*16 + !! factorization and solve. + !! The iterative refinement is not going to be a winning strategy if + !! the ratio COMPLEX performance over COMPLEX*16 performance is too + !! small. A reasonable strategy should take the number of right-hand + !! sides and the size of the matrix into account. This might be done + !! with a call to ILAENV in the future. Up to now, we always try + !! iterative refinement. + !! The iterative refinement process is stopped if + !! ITER > ITERMAX + !! or for all the RHS we have: + !! RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX + !! where + !! o ITER is the number of the current iteration in the iterative + !! refinement process + !! o RNRM is the infinity-norm of the residual + !! o XNRM is the infinity-norm of the solution + !! o ANRM is the infinity-operator-norm of the matrix A + !! o EPS is the machine epsilon returned by DLAMCH('Epsilon') + !! The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 + !! respectively. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1799,34 +1799,34 @@ module stdlib_linalg_lapack_w subroutine stdlib_wcposv( uplo, n, nrhs, a, lda, b, ldb, x, ldx, work,swork, rwork, iter, & - !> ZCPOSV: computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> ZCPOSV first attempts to factorize the matrix in COMPLEX and use this - !> factorization within an iterative refinement procedure to produce a - !> solution with COMPLEX*16 normwise backward error quality (see below). - !> If the approach fails the method switches to a COMPLEX*16 - !> factorization and solve. - !> The iterative refinement is not going to be a winning strategy if - !> the ratio COMPLEX performance over COMPLEX*16 performance is too - !> small. A reasonable strategy should take the number of right-hand - !> sides and the size of the matrix into account. This might be done - !> with a call to ILAENV in the future. Up to now, we always try - !> iterative refinement. - !> The iterative refinement process is stopped if - !> ITER > ITERMAX - !> or for all the RHS we have: - !> RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX - !> where - !> o ITER is the number of the current iteration in the iterative - !> refinement process - !> o RNRM is the infinity-norm of the residual - !> o XNRM is the infinity-norm of the solution - !> o ANRM is the infinity-operator-norm of the matrix A - !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') - !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 - !> respectively. + !! ZCPOSV: computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! ZCPOSV first attempts to factorize the matrix in COMPLEX and use this + !! factorization within an iterative refinement procedure to produce a + !! solution with COMPLEX*16 normwise backward error quality (see below). + !! If the approach fails the method switches to a COMPLEX*16 + !! factorization and solve. + !! The iterative refinement is not going to be a winning strategy if + !! the ratio COMPLEX performance over COMPLEX*16 performance is too + !! small. A reasonable strategy should take the number of right-hand + !! sides and the size of the matrix into account. This might be done + !! with a call to ILAENV in the future. Up to now, we always try + !! iterative refinement. + !! The iterative refinement process is stopped if + !! ITER > ITERMAX + !! or for all the RHS we have: + !! RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX + !! where + !! o ITER is the number of the current iteration in the iterative + !! refinement process + !! o RNRM is the infinity-norm of the residual + !! o XNRM is the infinity-norm of the solution + !! o ANRM is the infinity-operator-norm of the matrix A + !! o EPS is the machine epsilon returned by DLAMCH('Epsilon') + !! The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 + !! respectively. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1986,9 +1986,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wdrscl( n, sa, sx, incx ) - !> ZDRSCL: multiplies an n-element complex vector x by the real scalar - !> 1/a. This is done without overflow or underflow as long as - !> the final result x/a does not overflow or underflow. + !! ZDRSCL: multiplies an n-element complex vector x by the real scalar + !! 1/a. This is done without overflow or underflow as long as + !! the final result x/a does not overflow or underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2040,10 +2040,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & - !> ZGBBRD: 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. + !! ZGBBRD: 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. ldc, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2317,12 +2317,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, rwork, & - !> ZGBCON: 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 ZGBTRF. - !> 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)) ). + !! ZGBCON: 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 ZGBTRF. + !! 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)) ). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2451,15 +2451,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) - !> ZGBEQU: 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. + !! ZGBEQU: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2586,21 +2586,21 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) - !> ZGBEQUB: 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 ZGEEQU 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). + !! ZGBEQUB: 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 ZGEEQU 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). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2736,9 +2736,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, x, & - !> ZGBRFS: 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. + !! ZGBRFS: 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. ldx, ferr, berr, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2942,14 +2942,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) - !> ZGBSV: 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. + !! ZGBSV: 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2994,12 +2994,12 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & - !> ZGBSVX: uses the LU factorization to compute the solution to a complex - !> system of linear equations A * X = B, A**T * X = B, or A**H * 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. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZGBSVX: uses the LU factorization to compute the solution to a complex + !! system of linear equations A * X = B, A**T * X = B, or A**H * 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. + !! Error bounds on the solution and a condition estimate are also + !! provided. c, b, ldb, x, ldx,rcond, ferr, berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -3221,9 +3221,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgbtf2( m, n, kl, ku, ab, ldab, ipiv, info ) - !> ZGBTF2: computes an LU factorization of a complex m-by-n band matrix - !> A using partial pivoting with row interchanges. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! ZGBTF2: computes an LU factorization of a complex m-by-n band matrix + !! A using partial pivoting with row interchanges. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3307,9 +3307,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) - !> ZGBTRF: 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. + !! ZGBTRF: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3557,10 +3557,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) - !> ZGBTRS: 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 ZGBTRF. + !! ZGBTRS: 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 ZGBTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3670,9 +3670,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) - !> ZGEBAK: forms the right or left eigenvectors of a complex general - !> matrix by backward transformation on the computed eigenvectors of the - !> balanced matrix output by ZGEBAL. + !! ZGEBAK: forms the right or left eigenvectors of a complex general + !! matrix by backward transformation on the computed eigenvectors of the + !! balanced matrix output by ZGEBAL. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3767,14 +3767,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgebal( job, n, a, lda, ilo, ihi, scale, info ) - !> ZGEBAL: 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. + !! ZGEBAL: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3937,9 +3937,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgebd2( m, n, a, lda, d, e, tauq, taup, work, info ) - !> ZGEBD2: reduces a complex general m by n matrix A to upper or lower - !> real 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. + !! ZGEBD2: reduces a complex general m by n matrix A to upper or lower + !! real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4035,9 +4035,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) - !> ZGEBRD: 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. + !! ZGEBRD: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4142,12 +4142,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgecon( norm, n, a, lda, anorm, rcond, work, rwork,info ) - !> ZGECON: 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 ZGETRF. - !> 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)) ). + !! ZGECON: 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 ZGETRF. + !! 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)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4248,15 +4248,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) - !> ZGEEQU: 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. + !! ZGEEQU: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4376,21 +4376,21 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) - !> ZGEEQUB: 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 ZGEEQU 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). + !! ZGEEQUB: 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 ZGEEQU 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). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4520,14 +4520,14 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgees( jobvs, sort, select, n, a, lda, sdim, w, vs,ldvs, work, lwork, & - !> ZGEES: 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. + !! ZGEES: 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. rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4691,20 +4691,20 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgeesx( jobvs, sort, select, sense, n, a, lda, sdim, w,vs, ldvs, rconde, & - !> ZGEESX: 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; - !> computes a reciprocal condition number for the average of the - !> selected eigenvalues (RCONDE); and computes a reciprocal condition - !> number for the right invariant subspace corresponding to the - !> selected eigenvalues (RCONDV). The leading columns of Z form an - !> orthonormal basis for this invariant subspace. - !> For further explanation of the reciprocal condition numbers RCONDE - !> and RCONDV, see Section 4.10_qp of the LAPACK Users' Guide (where - !> these quantities are called s and sep respectively). - !> A complex matrix is in Schur form if it is upper triangular. + !! ZGEESX: 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; + !! computes a reciprocal condition number for the average of the + !! selected eigenvalues (RCONDE); and computes a reciprocal condition + !! number for the right invariant subspace corresponding to the + !! selected eigenvalues (RCONDV). The leading columns of Z form an + !! orthonormal basis for this invariant subspace. + !! For further explanation of the reciprocal condition numbers RCONDE + !! and RCONDV, see Section 4.10_qp of the LAPACK Users' Guide (where + !! these quantities are called s and sep respectively). + !! A complex matrix is in Schur form if it is upper triangular. rcondv, work, lwork, rwork,bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4893,16 +4893,16 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgeev( jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr,work, lwork, rwork, & - !> ZGEEV: 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. + !! ZGEEV: 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5142,31 +5142,31 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgeevx( balanc, jobvl, jobvr, sense, n, a, lda, w, vl,ldvl, vr, ldvr, ilo, & - !> ZGEEVX: computes for an N-by-N complex nonsymmetric matrix A, the - !> eigenvalues and, optionally, the left and/or right eigenvectors. - !> Optionally also, it computes a balancing transformation to improve - !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, - !> SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues - !> (RCONDE), and reciprocal condition numbers for the right - !> eigenvectors (RCONDV). - !> 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. - !> Balancing a matrix means permuting the rows and columns to make it - !> more nearly upper triangular, and applying a diagonal similarity - !> transformation D * A * D**(-1), where D is a diagonal matrix, to - !> make its rows and columns closer in norm and the condition numbers - !> of its eigenvalues and eigenvectors smaller. The computed - !> reciprocal condition numbers correspond to the balanced matrix. - !> Permuting rows and columns will not change the condition numbers - !> (in exact arithmetic) but diagonal scaling will. For further - !> explanation of balancing, see section 4.10.2_qp of the LAPACK - !> Users' Guide. + !! ZGEEVX: computes for an N-by-N complex nonsymmetric matrix A, the + !! eigenvalues and, optionally, the left and/or right eigenvectors. + !! Optionally also, it computes a balancing transformation to improve + !! the conditioning of the eigenvalues and eigenvectors (ILO, IHI, + !! SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues + !! (RCONDE), and reciprocal condition numbers for the right + !! eigenvectors (RCONDV). + !! 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. + !! Balancing a matrix means permuting the rows and columns to make it + !! more nearly upper triangular, and applying a diagonal similarity + !! transformation D * A * D**(-1), where D is a diagonal matrix, to + !! make its rows and columns closer in norm and the condition numbers + !! of its eigenvalues and eigenvectors smaller. The computed + !! reciprocal condition numbers correspond to the balanced matrix. + !! Permuting rows and columns will not change the condition numbers + !! (in exact arithmetic) but diagonal scaling will. For further + !! explanation of balancing, see section 4.10.2_qp of the LAPACK + !! Users' Guide. ihi, scale, abnrm, rconde,rcondv, work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5444,8 +5444,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgehd2( n, ilo, ihi, a, lda, tau, work, info ) - !> ZGEHD2: reduces a complex general matrix A to upper Hessenberg form H - !> by a unitary similarity transformation: Q**H * A * Q = H . + !! ZGEHD2: reduces a complex general matrix A to upper Hessenberg form H + !! by a unitary similarity transformation: Q**H * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5496,8 +5496,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info ) - !> ZGEHRD: reduces a complex general matrix A to upper Hessenberg form H by - !> an unitary similarity transformation: Q**H * A * Q = H . + !! ZGEHRD: reduces a complex general matrix A to upper Hessenberg form H by + !! an unitary similarity transformation: Q**H * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5626,16 +5626,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & - !> ZGEJSV: 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. + !! ZGEJSV: 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. v, ldv,cwork, lwork, rwork, lrwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7031,12 +7031,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgelq( m, n, a, lda, t, tsize, work, lwork,info ) - !> ZGELQ: 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. + !! ZGELQ: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -7156,12 +7156,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgelq2( m, n, a, lda, tau, work, info ) - !> ZGELQ2: 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. + !! ZGELQ2: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7212,12 +7212,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgelqf( m, n, a, lda, tau, work, lwork, info ) - !> ZGELQF: 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. + !! ZGELQF: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7309,8 +7309,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgelqt( m, n, mb, a, lda, t, ldt, work, info ) - !> ZGELQT: computes a blocked LQ factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. + !! ZGELQT: computes a blocked LQ factorization of a complex M-by-N matrix A + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7360,10 +7360,10 @@ module stdlib_linalg_lapack_w pure recursive subroutine stdlib_wgelqt3( m, n, a, lda, t, ldt, info ) - !> ZGELQT3: 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. + !! ZGELQT3: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7450,24 +7450,24 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) - !> ZGELS: 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. + !! ZGELS: 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7668,31 +7668,31 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & - !> ZGELSD: 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. + !! ZGELSD: 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. iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8006,18 +8006,18 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & - !> ZGELSS: 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. + !! ZGELSS: 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8464,38 +8464,38 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, rwork, & - !> ZGELSY: 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. + !! ZGELSY: 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8689,13 +8689,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & - !> ZGEMLQ: 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 (ZGELQ) + !! ZGEMLQ: 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 (ZGELQ) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8786,15 +8786,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) - !> ZGEMLQT: 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 ZGELQT. - !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. + !! ZGEMLQT: 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 ZGELQT. + !! Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8884,13 +8884,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & - !> ZGEMQR: 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 (ZGEQR) + !! ZGEMQR: 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 (ZGEQR) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8981,15 +8981,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) - !> ZGEMQRT: 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 ZGEQRT. - !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. + !! ZGEMQRT: 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 ZGEQRT. + !! Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -9079,8 +9079,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgeql2( m, n, a, lda, tau, work, info ) - !> ZGEQL2: computes a QL factorization of a complex m by n matrix A: - !> A = Q * L. + !! ZGEQL2: computes a QL factorization of a complex m by n matrix A: + !! A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9128,8 +9128,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgeqlf( m, n, a, lda, tau, work, lwork, info ) - !> ZGEQLF: computes a QL factorization of a complex M-by-N matrix A: - !> A = Q * L. + !! ZGEQLF: computes a QL factorization of a complex M-by-N matrix A: + !! A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9234,8 +9234,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgeqp3( m, n, a, lda, jpvt, tau, work, lwork, rwork,info ) - !> ZGEQP3: computes a QR factorization with column pivoting of a - !> matrix A: A*P = Q*R using Level 3 BLAS. + !! ZGEQP3: computes a QR factorization with column pivoting of a + !! matrix A: A*P = Q*R using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9386,13 +9386,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgeqr( m, n, a, lda, t, tsize, work, lwork,info ) - !> ZGEQR: 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. + !! ZGEQR: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -9501,13 +9501,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgeqr2( m, n, a, lda, tau, work, info ) - !> ZGEQR2: 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. + !! ZGEQR2: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9556,14 +9556,14 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgeqr2p( m, n, a, lda, tau, work, info ) - !> ZGEQR2P: 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. + !! ZGEQR2P: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9612,13 +9612,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgeqrf( m, n, a, lda, tau, work, lwork, info ) - !> ZGEQRF: 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. + !! ZGEQRF: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9714,14 +9714,14 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgeqrfp( m, n, a, lda, tau, work, lwork, info ) - !> ZGEQR2P 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. + !! ZGEQR2P 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9813,8 +9813,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgeqrt( m, n, nb, a, lda, t, ldt, work, info ) - !> ZGEQRT: computes a blocked QR factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. + !! ZGEQRT: computes a blocked QR factorization of a complex M-by-N matrix A + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9870,8 +9870,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgeqrt2( m, n, a, lda, t, ldt, info ) - !> ZGEQRT2: computes a QR factorization of a complex M-by-N matrix A, - !> using the compact WY representation of Q. + !! ZGEQRT2: computes a QR factorization of a complex M-by-N matrix A, + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9938,10 +9938,10 @@ module stdlib_linalg_lapack_w pure recursive subroutine stdlib_wgeqrt3( m, n, a, lda, t, ldt, info ) - !> ZGEQRT3: 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. + !! ZGEQRT3: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10026,9 +10026,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & - !> ZGERFS: improves the computed solution to a system of linear - !> equations and provides error bounds and backward error estimates for - !> the solution. + !! ZGERFS: improves the computed solution to a system of linear + !! equations and provides error bounds and backward error estimates for + !! the solution. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10223,8 +10223,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgerq2( m, n, a, lda, tau, work, info ) - !> ZGERQ2: computes an RQ factorization of a complex m by n matrix A: - !> A = R * Q. + !! ZGERQ2: computes an RQ factorization of a complex m by n matrix A: + !! A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10274,8 +10274,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgerqf( m, n, a, lda, tau, work, lwork, info ) - !> ZGERQF: computes an RQ factorization of a complex M-by-N matrix A: - !> A = R * Q. + !! ZGERQF: computes an RQ factorization of a complex M-by-N matrix A: + !! A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10380,10 +10380,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) - !> ZGESC2: solves a system of linear equations - !> A * X = scale* RHS - !> with a general N-by-N matrix A using the LU factorization with - !> complete pivoting computed by ZGETC2. + !! ZGESC2: solves a system of linear equations + !! A * X = scale* RHS + !! with a general N-by-N matrix A using the LU factorization with + !! complete pivoting computed by ZGETC2. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10439,23 +10439,23 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, iwork, & - !> ZGESDD: 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. + !! ZGESDD: 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -11934,15 +11934,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) - !> ZGESV: 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. + !! ZGESV: 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11982,17 +11982,17 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,vt, ldvt, work, lwork, rwork, & - !> ZGESVD: 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. + !! ZGESVD: 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -14428,15 +14428,15 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & - !> ZCGESVDQ 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. + !! ZCGESVDQ 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. numrank, iwork, liwork,cwork, lcwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -15306,15 +15306,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, cwork, lwork, & - !> ZGESVJ: 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. + !! ZGESVJ: 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. rwork, lrwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16158,12 +16158,12 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & - !> ZGESVX: uses the LU factorization to compute 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. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZGESVX: uses the LU factorization to compute 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. + !! Error bounds on the solution and a condition estimate are also + !! provided. x, ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16363,11 +16363,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgetc2( n, a, lda, ipiv, jpiv, info ) - !> ZGETC2: computes an LU factorization, using complete pivoting, of the - !> n-by-n matrix A. The factorization has the form A = P * L * U * Q, - !> where P and Q are permutation matrices, L is lower triangular with - !> unit diagonal elements and U is upper triangular. - !> This is a level 1 BLAS version of the algorithm. + !! ZGETC2: computes an LU factorization, using complete pivoting, of the + !! n-by-n matrix A. The factorization has the form A = P * L * U * Q, + !! where P and Q are permutation matrices, L is lower triangular with + !! unit diagonal elements and U is upper triangular. + !! This is a level 1 BLAS version of the algorithm. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16447,14 +16447,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgetf2( m, n, a, lda, ipiv, info ) - !> ZGETF2: 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 2 BLAS version of the algorithm. + !! ZGETF2: 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 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16520,14 +16520,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgetrf( m, n, a, lda, ipiv, info ) - !> ZGETRF: 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. + !! ZGETRF: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16598,25 +16598,25 @@ module stdlib_linalg_lapack_w pure recursive subroutine stdlib_wgetrf2( m, n, a, lda, ipiv, info ) - !> ZGETRF2: 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. + !! ZGETRF2: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16714,10 +16714,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgetri( n, a, lda, ipiv, work, lwork, info ) - !> ZGETRI: computes the inverse of a matrix using the LU factorization - !> computed by ZGETRF. - !> This method inverts U and then computes inv(A) by solving the system - !> inv(A)*L = inv(U) for inv(A). + !! ZGETRI: computes the inverse of a matrix using the LU factorization + !! computed by ZGETRF. + !! This method inverts U and then computes inv(A) by solving the system + !! inv(A)*L = inv(U) for inv(A). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16816,10 +16816,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) - !> ZGETRS: 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 ZGETRF. + !! ZGETRS: 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 ZGETRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16885,24 +16885,24 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) - !> ZGETSLS: 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. + !! ZGETSLS: 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17122,18 +17122,18 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) - !> ZGETSQRHRT: 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 ZGEQRT - !> (Q is in blocked compact WY-representation). See the documentation - !> of ZGEQRT for more details on the format. + !! ZGETSQRHRT: 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 ZGEQRT + !! (Q is in blocked compact WY-representation). See the documentation + !! of ZGEQRT for more details on the format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17255,10 +17255,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) - !> ZGGBAK: 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 - !> ZGGBAL. + !! ZGGBAK: 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 + !! ZGGBAL. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17368,15 +17368,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) - !> ZGGBAL: 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. + !! ZGGBAL: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17672,26 +17672,26 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alpha, beta, & - !> ZGGES: 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 - !> ZGGEV 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. + !! ZGGES: 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 + !! ZGGEV 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. vsl, ldvsl, vsr, ldvsr, work,lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17924,26 +17924,26 @@ module stdlib_linalg_lapack_w subroutine stdlib_wgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alpha, beta, & - !> ZGGES3: 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 - !> ZGGEV 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. + !! ZGGES3: 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 + !! ZGGEV 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. vsl, ldvsl, vsr, ldvsr,work, lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -18175,28 +18175,28 @@ module stdlib_linalg_lapack_w subroutine stdlib_wggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, alpha,& - !> ZGGESX: computes for a pair of N-by-N complex nonsymmetric matrices - !> (A,B), the generalized eigenvalues, the complex Schur form (S,T), - !> and, optionally, the left and/or right matrices of 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; computes - !> a reciprocal condition number for the average of the selected - !> eigenvalues (RCONDE); and computes a reciprocal condition number for - !> the right and left deflating subspaces corresponding to the selected - !> eigenvalues (RCONDV). The leading columns of VSL and VSR then form - !> an orthonormal basis for the corresponding left and right eigenspaces - !> (deflating subspaces). - !> 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 or for both being zero. - !> A pair of matrices (S,T) is in generalized complex Schur form if T is - !> upper triangular with non-negative diagonal and S is upper - !> triangular. + !! ZGGESX: computes for a pair of N-by-N complex nonsymmetric matrices + !! (A,B), the generalized eigenvalues, the complex Schur form (S,T), + !! and, optionally, the left and/or right matrices of 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; computes + !! a reciprocal condition number for the average of the selected + !! eigenvalues (RCONDE); and computes a reciprocal condition number for + !! the right and left deflating subspaces corresponding to the selected + !! eigenvalues (RCONDV). The leading columns of VSL and VSR then form + !! an orthonormal basis for the corresponding left and right eigenspaces + !! (deflating subspaces). + !! 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 or for both being zero. + !! A pair of matrices (S,T) is in generalized complex Schur form if T is + !! upper triangular with non-negative diagonal and S is upper + !! triangular. beta, vsl, ldvsl, vsr,ldvsr, rconde, rcondv, work, lwork, rwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- @@ -18485,21 +18485,21 @@ module stdlib_linalg_lapack_w subroutine stdlib_wggev( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & - !> ZGGEV: 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). + !! ZGGEV: 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). work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -18755,21 +18755,21 @@ module stdlib_linalg_lapack_w subroutine stdlib_wggev3( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & - !> ZGGEV3: 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). + !! ZGGEV3: 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). work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19027,26 +19027,26 @@ module stdlib_linalg_lapack_w subroutine stdlib_wggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alpha, beta, vl, & - !> ZGGEVX: 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. - !> Optionally, it also computes a balancing transformation to improve - !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, - !> LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for - !> the eigenvalues (RCONDE), and reciprocal condition numbers for the - !> right eigenvectors (RCONDV). - !> 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) - !> of (A,B) satisfies - !> A * v(j) = lambda(j) * B * v(j) . - !> The left eigenvector u(j) corresponding to the eigenvalue 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). + !! ZGGEVX: 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. + !! Optionally, it also computes a balancing transformation to improve + !! the conditioning of the eigenvalues and eigenvectors (ILO, IHI, + !! LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for + !! the eigenvalues (RCONDE), and reciprocal condition numbers for the + !! right eigenvectors (RCONDV). + !! 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) + !! of (A,B) satisfies + !! A * v(j) = lambda(j) * B * v(j) . + !! The left eigenvector u(j) corresponding to the eigenvalue 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). ldvl, vr, ldvr, ilo, ihi,lscale, rscale, abnrm, bbnrm, rconde, rcondv,work, lwork, rwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -19375,24 +19375,24 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) - !> ZGGGLM: 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. + !! ZGGGLM: 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19511,31 +19511,31 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & - !> ZGGHD3: 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 ZGGHD3 reduces the original - !> problem to generalized Hessenberg form. - !> This is a blocked variant of CGGHRD, using matrix-matrix - !> multiplications for parts of the computation to enhance performance. + !! ZGGHD3: 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 ZGGHD3 reduces the original + !! problem to generalized Hessenberg form. + !! This is a blocked variant of CGGHRD, using matrix-matrix + !! multiplications for parts of the computation to enhance performance. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20041,29 +20041,29 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & - !> ZGGHRD: 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 ZGGHRD reduces the original - !> problem to generalized Hessenberg form. + !! ZGGHRD: 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 ZGGHRD reduces the original + !! problem to generalized Hessenberg form. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20173,18 +20173,18 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) - !> ZGGLSE: 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. + !! ZGGLSE: 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20305,24 +20305,24 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) - !> ZGGQRF: 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**H denotes the - !> conjugate transpose of matrix Z. + !! ZGGQRF: 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**H denotes the + !! conjugate transpose of matrix Z. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20383,24 +20383,24 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) - !> ZGGRQF: 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. + !! ZGGRQF: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20461,10 +20461,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & - !> ZGSVJ0: is called from ZGESVJ as a pre-processor and that is its main - !> purpose. It applies Jacobi rotations in the same way as ZGESVJ does, but - !> it does not check convergence (stopping criterion). Few tuning - !> parameters (marked by [TP]) are available for the implementer. + !! ZGSVJ0: is called from ZGESVJ as a pre-processor and that is its main + !! purpose. It applies Jacobi rotations in the same way as ZGESVJ does, but + !! it does not check convergence (stopping criterion). Few tuning + !! parameters (marked by [TP]) are available for the implementer. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21002,30 +21002,30 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & - !> ZGSVJ1: is called from ZGESVJ as a pre-processor and that is its main - !> purpose. It applies Jacobi rotations in the same way as ZGESVJ 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 - !> ~~~~~~~~~~~~~~~ - !> ZGSVJ1 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. + !! ZGSVJ1: is called from ZGESVJ as a pre-processor and that is its main + !! purpose. It applies Jacobi rotations in the same way as ZGESVJ 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 + !! ~~~~~~~~~~~~~~~ + !! ZGSVJ1 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. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21375,11 +21375,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, info ) - !> ZGTCON: estimates the reciprocal of the condition number of a complex - !> tridiagonal matrix A using the LU factorization as computed by - !> ZGTTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZGTCON: estimates the reciprocal of the condition number of a complex + !! tridiagonal matrix A using the LU factorization as computed by + !! ZGTTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21459,9 +21459,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, x, & - !> ZGTRFS: 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. + !! ZGTRFS: 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. ldx, ferr, berr, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21666,12 +21666,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgtsv( n, nrhs, dl, d, du, b, ldb, info ) - !> ZGTSV: 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. + !! ZGTSV: 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21758,12 +21758,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & - !> ZGTSVX: uses the LU factorization to compute the solution to a complex - !> system of linear equations A * X = B, A**T * X = B, or A**H * X = B, - !> where A is a tridiagonal matrix of order N and X and B are N-by-NRHS - !> matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZGTSVX: uses the LU factorization to compute the solution to a complex + !! system of linear equations A * X = B, A**T * X = B, or A**H * X = B, + !! where A is a tridiagonal matrix of order N and X and B are N-by-NRHS + !! matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ldb, x, ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21846,13 +21846,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgttrf( n, dl, d, du, du2, ipiv, info ) - !> ZGTTRF: 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. + !! ZGTTRF: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21942,10 +21942,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) - !> ZGTTRS: 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 ZGTTRF. + !! ZGTTRS: 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 ZGTTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22008,10 +22008,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) - !> ZGTTS2: 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 ZGTTRF. + !! ZGTTS2: 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 ZGTTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22179,8 +22179,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, lda, & - !> ZHB2ST_KERNELS: is an internal routine used by the ZHETRD_HB2ST - !> subroutine. + !! ZHB2ST_KERNELS: is an internal routine used by the ZHETRD_HB2ST + !! subroutine. v, tau, ldvt, work) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22324,8 +22324,8 @@ module stdlib_linalg_lapack_w subroutine stdlib_whbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,rwork, info ) - !> ZHBEV: computes all the eigenvalues and, optionally, eigenvectors of - !> a complex Hermitian band matrix A. + !! ZHBEV: computes all the eigenvalues and, optionally, eigenvectors of + !! a complex Hermitian band matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22428,15 +22428,15 @@ module stdlib_linalg_lapack_w subroutine stdlib_whbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, rwork, lrwork, & - !> ZHBEVD: 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. + !! ZHBEVD: 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22578,10 +22578,10 @@ module stdlib_linalg_lapack_w subroutine stdlib_whbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & - !> ZHBEVX: computes selected eigenvalues and, optionally, eigenvectors - !> of a complex Hermitian band matrix A. Eigenvalues and eigenvectors - !> can be selected by specifying either a range of values or a range of - !> indices for the desired eigenvalues. + !! ZHBEVX: computes selected eigenvalues and, optionally, eigenvectors + !! of a complex Hermitian band matrix A. Eigenvalues and eigenvectors + !! can be selected by specifying either a range of values or a range of + !! indices for the desired eigenvalues. m, w, z, ldz, work, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -22809,13 +22809,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, rwork,& - !> ZHBGST: 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 ZPBSTF, 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. + !! ZHBGST: 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 ZPBSTF, 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23741,10 +23741,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & - !> ZHBGV: 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. + !! ZHBGV: 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. rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23821,17 +23821,17 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & - !> ZHBGVD: 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. + !! ZHBGVD: 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. lwork, rwork, lrwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23948,12 +23948,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & - !> ZHBGVX: 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. Eigenvalues and - !> eigenvectors can be selected by specifying either all eigenvalues, - !> a range of values or a range of indices for the desired eigenvalues. + !! ZHBGVX: 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. Eigenvalues and + !! eigenvectors can be selected by specifying either all eigenvalues, + !! a range of values or a range of indices for the desired eigenvalues. vu, il, iu, abstol, m, w, z,ldz, work, rwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24137,9 +24137,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) - !> ZHBTRD: reduces a complex Hermitian band matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. + !! ZHBTRD: reduces a complex Hermitian band matrix A to real symmetric + !! tridiagonal form T by a unitary similarity transformation: + !! Q**H * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24501,11 +24501,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whecon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) - !> ZHECON: 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 ZHETRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZHECON: 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 ZHETRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24582,11 +24582,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whecon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) - !> ZHECON_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))). + !! ZHECON_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))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24663,13 +24663,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wheequb( uplo, n, a, lda, s, scond, amax, work, info ) - !> ZHEEQUB: 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. + !! ZHEEQUB: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24845,8 +24845,8 @@ module stdlib_linalg_lapack_w subroutine stdlib_wheev( jobz, uplo, n, a, lda, w, work, lwork, rwork,info ) - !> ZHEEV: computes all eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix A. + !! ZHEEV: computes all eigenvalues and, optionally, eigenvectors of a + !! complex Hermitian matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24956,15 +24956,15 @@ module stdlib_linalg_lapack_w subroutine stdlib_wheevd( jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, liwork,& - !> ZHEEVD: 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. + !! ZHEEVD: 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25109,56 +25109,56 @@ module stdlib_linalg_lapack_w subroutine stdlib_wheevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> ZHEEVR: 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. - !> ZHEEVR first reduces the matrix A to tridiagonal form T with a call - !> to ZHETRD. Then, whenever possible, ZHEEVR calls ZSTEMR to compute - !> eigenspectrum using Relatively Robust Representations. ZSTEMR - !> 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 ZSTEMR'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 : ZHEEVR calls ZSTEMR when the full spectrum is requested - !> on machines which conform to the ieee-754 floating point standard. - !> ZHEEVR calls DSTEBZ and ZSTEIN on non-ieee machines and - !> when partial spectrum requests are made. - !> Normal execution of ZSTEMR 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. + !! ZHEEVR: 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. + !! ZHEEVR first reduces the matrix A to tridiagonal form T with a call + !! to ZHETRD. Then, whenever possible, ZHEEVR calls ZSTEMR to compute + !! eigenspectrum using Relatively Robust Representations. ZSTEMR + !! 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 ZSTEMR'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 : ZHEEVR calls ZSTEMR when the full spectrum is requested + !! on machines which conform to the ieee-754 floating point standard. + !! ZHEEVR calls DSTEBZ and ZSTEIN on non-ieee machines and + !! when partial spectrum requests are made. + !! Normal execution of ZSTEMR 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. isuppz, work, lwork,rwork, lrwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25448,10 +25448,10 @@ module stdlib_linalg_lapack_w subroutine stdlib_wheevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> ZHEEVX: 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. + !! ZHEEVX: 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. work, lwork, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25695,13 +25695,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whegs2( itype, uplo, n, a, lda, b, ldb, info ) - !> ZHEGS2: 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 ZPOTRF. + !! ZHEGS2: 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 ZPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25828,13 +25828,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whegst( itype, uplo, n, a, lda, b, ldb, info ) - !> ZHEGST: 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 ZPOTRF. + !! ZHEGST: 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 ZPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25967,11 +25967,11 @@ module stdlib_linalg_lapack_w subroutine stdlib_whegv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, info ) - !> ZHEGV: 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. + !! ZHEGV: 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26068,17 +26068,17 @@ module stdlib_linalg_lapack_w subroutine stdlib_whegvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, lrwork,& - !> ZHEGVD: 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. + !! ZHEGVD: 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26200,12 +26200,12 @@ module stdlib_linalg_lapack_w subroutine stdlib_whegvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& - !> ZHEGVX: computes selected eigenvalues, and optionally, 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. - !> Eigenvalues and eigenvectors can be selected by specifying either a - !> range of values or a range of indices for the desired eigenvalues. + !! ZHEGVX: computes selected eigenvalues, and optionally, 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. + !! Eigenvalues and eigenvectors can be selected by specifying either a + !! range of values or a range of indices for the desired eigenvalues. m, w, z, ldz, work,lwork, rwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26328,9 +26328,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wherfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & - !> ZHERFS: 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. + !! ZHERFS: 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. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26521,17 +26521,17 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whesv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> ZHESV: 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. + !! ZHESV: 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26599,16 +26599,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whesv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> ZHESV_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. + !! ZHESV_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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26671,20 +26671,20 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whesv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) - !> ZHESV_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. - !> ZHETRF_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 ZHETRS_3. + !! ZHESV_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. + !! ZHETRF_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 ZHETRS_3. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26748,22 +26748,22 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whesv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> ZHESV_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. - !> ZHETRF_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 ZHETRS_ROOK (uses BLAS 2). + !! ZHESV_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. + !! ZHETRF_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 ZHETRS_ROOK (uses BLAS 2). ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26827,12 +26827,12 @@ module stdlib_linalg_lapack_w subroutine stdlib_whesvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & - !> ZHESVX: uses the diagonal pivoting factorization to compute 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. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZHESVX: uses the diagonal pivoting factorization to compute 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. + !! Error bounds on the solution and a condition estimate are also + !! provided. ferr, berr, work, lwork,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26924,8 +26924,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wheswapr( uplo, n, a, lda, i1, i2) - !> ZHESWAPR: applies an elementary permutation on the rows and the columns of - !> a hermitian matrix. + !! ZHESWAPR: applies an elementary permutation on the rows and the columns of + !! a hermitian matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26996,9 +26996,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetd2( uplo, n, a, lda, d, e, tau, info ) - !> ZHETD2: reduces a complex Hermitian matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. + !! ZHETD2: reduces a complex Hermitian matrix A to real symmetric + !! tridiagonal form T by a unitary similarity transformation: + !! Q**H * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27100,13 +27100,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetf2( uplo, n, a, lda, ipiv, info ) - !> ZHETF2: computes the factorization of a complex Hermitian 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, 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. + !! ZHETF2: computes the factorization of a complex Hermitian 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, 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27426,15 +27426,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetf2_rk( uplo, n, a, lda, e, ipiv, info ) - !> ZHETF2_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. + !! ZHETF2_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27957,13 +27957,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetf2_rook( uplo, n, a, lda, ipiv, info ) - !> ZHETF2_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. + !! ZHETF2_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28446,9 +28446,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) - !> ZHETRD: reduces a complex Hermitian matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. + !! ZHETRD: reduces a complex Hermitian matrix A to real symmetric + !! tridiagonal form T by a unitary similarity transformation: + !! Q**H * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28574,9 +28574,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & - !> ZHETRD_HB2ST: reduces a complex Hermitian band matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. + !! ZHETRD_HB2ST: reduces a complex Hermitian band matrix A to real symmetric + !! tridiagonal form T by a unitary similarity transformation: + !! Q**H * A * Q = T. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28847,9 +28847,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) - !> ZHETRD_HE2HB: reduces a complex Hermitian matrix A to complex Hermitian - !> band-diagonal form AB by a unitary similarity transformation: - !> Q**H * A * Q = AB. + !! ZHETRD_HE2HB: reduces a complex Hermitian matrix A to complex Hermitian + !! band-diagonal form AB by a unitary similarity transformation: + !! Q**H * A * Q = AB. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29023,14 +29023,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetrf( uplo, n, a, lda, ipiv, work, lwork, info ) - !> ZHETRF: 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. + !! ZHETRF: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29149,12 +29149,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) - !> ZHETRF_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. + !! ZHETRF_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29378,15 +29378,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) - !> ZHETRF_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. + !! ZHETRF_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29544,14 +29544,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) - !> ZHETRF_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. + !! ZHETRF_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29672,9 +29672,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetri( uplo, n, a, lda, ipiv, work, info ) - !> ZHETRI: 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 - !> ZHETRF. + !! ZHETRI: 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 + !! ZHETRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29876,9 +29876,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetri_rook( uplo, n, a, lda, ipiv, work, info ) - !> ZHETRI_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 - !> ZHETRF_ROOK. + !! ZHETRI_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 + !! ZHETRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30144,9 +30144,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) - !> ZHETRS: 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 ZHETRF. + !! ZHETRS: 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 ZHETRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30375,9 +30375,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) - !> ZHETRS2: 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 ZHETRF and converted by ZSYCONV. + !! ZHETRS2: 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 ZHETRF and converted by ZSYCONV. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30556,15 +30556,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) - !> ZHETRS_3: solves a system of linear equations A * X = B with a complex - !> Hermitian matrix A using the factorization computed - !> by ZHETRF_RK or ZHETRF_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. + !! ZHETRS_3: solves a system of linear equations A * X = B with a complex + !! Hermitian matrix A using the factorization computed + !! by ZHETRF_RK or ZHETRF_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30716,9 +30716,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) - !> ZHETRS_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 ZHETRF_AA. + !! ZHETRS_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 ZHETRF_AA. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30837,9 +30837,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whetrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) - !> ZHETRS_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 ZHETRF_ROOK. + !! ZHETRS_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 ZHETRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31076,14 +31076,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) - !> Level 3 BLAS like routine for C in RFP Format. - !> ZHFRK: 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. + !! Level 3 BLAS like routine for C in RFP Format. + !! ZHFRK: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31336,39 +31336,39 @@ module stdlib_linalg_lapack_w subroutine stdlib_whgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alpha, beta, q, ldq,& - !> ZHGEQZ: 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 ZGGHRD. - !> 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 ZGGHRD 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. + !! ZHGEQZ: 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 ZGGHRD. + !! 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 ZGGHRD 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. z, ldz, work, lwork,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31836,11 +31836,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whpcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) - !> ZHPCON: 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 ZHPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZHPCON: 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 ZHPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31917,8 +31917,8 @@ module stdlib_linalg_lapack_w subroutine stdlib_whpev( jobz, uplo, n, ap, w, z, ldz, work, rwork,info ) - !> ZHPEV: computes all the eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix in packed storage. + !! ZHPEV: computes all the eigenvalues and, optionally, eigenvectors of a + !! complex Hermitian matrix in packed storage. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32014,15 +32014,15 @@ module stdlib_linalg_lapack_w subroutine stdlib_whpevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,rwork, lrwork, iwork, & - !> ZHPEVD: 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. + !! ZHPEVD: 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. liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32156,10 +32156,10 @@ module stdlib_linalg_lapack_w subroutine stdlib_whpevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> ZHPEVX: computes selected eigenvalues and, optionally, eigenvectors - !> of a complex Hermitian matrix A in packed storage. - !> Eigenvalues/vectors can be selected by specifying either a range of - !> values or a range of indices for the desired eigenvalues. + !! ZHPEVX: computes selected eigenvalues and, optionally, eigenvectors + !! of a complex Hermitian matrix A in packed storage. + !! Eigenvalues/vectors can be selected by specifying either a range of + !! values or a range of indices for the desired eigenvalues. work, rwork, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32373,13 +32373,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whpgst( itype, uplo, n, ap, bp, info ) - !> ZHPGST: 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 ZPPTRF. + !! ZHPGST: 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 ZPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32502,11 +32502,11 @@ module stdlib_linalg_lapack_w subroutine stdlib_whpgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,rwork, info ) - !> ZHPGV: 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. + !! ZHPGV: 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -32587,18 +32587,18 @@ module stdlib_linalg_lapack_w subroutine stdlib_whpgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, rwork, lrwork,& - !> ZHPGVD: 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. + !! ZHPGVD: 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32720,13 +32720,13 @@ module stdlib_linalg_lapack_w subroutine stdlib_whpgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & - !> ZHPGVX: computes selected eigenvalues and, optionally, 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. Eigenvalues and eigenvectors can be selected by - !> specifying either a range of values or a range of indices for the - !> desired eigenvalues. + !! ZHPGVX: computes selected eigenvalues and, optionally, 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. Eigenvalues and eigenvectors can be selected by + !! specifying either a range of values or a range of indices for the + !! desired eigenvalues. z, ldz, work, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32832,10 +32832,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& - !> ZHPRFS: 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. + !! ZHPRFS: 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. rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33029,17 +33029,17 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whpsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> ZHPSV: 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. + !! ZHPSV: 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33080,12 +33080,12 @@ module stdlib_linalg_lapack_w subroutine stdlib_whpsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & - !> ZHPSVX: uses the diagonal pivoting factorization A = U*D*U**H or - !> A = L*D*L**H to compute 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. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZHPSVX: uses the diagonal pivoting factorization A = U*D*U**H or + !! A = L*D*L**H to compute 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. + !! Error bounds on the solution and a condition estimate are also + !! provided. berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33158,9 +33158,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whptrd( uplo, n, ap, d, e, tau, info ) - !> ZHPTRD: 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. + !! ZHPTRD: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33262,12 +33262,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whptrf( uplo, n, ap, ipiv, info ) - !> ZHPTRF: 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. + !! ZHPTRF: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33612,9 +33612,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whptri( uplo, n, ap, ipiv, work, info ) - !> ZHPTRI: 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 ZHPTRF. + !! ZHPTRI: 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 ZHPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33831,9 +33831,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> ZHPTRS: 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 ZHPTRF. + !! ZHPTRS: 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 ZHPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34072,12 +34072,12 @@ module stdlib_linalg_lapack_w subroutine stdlib_whsein( side, eigsrc, initv, select, n, h, ldh, w, vl,ldvl, vr, ldvr, mm, & - !> ZHSEIN: 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. + !! ZHSEIN: 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. m, work, rwork, ifaill,ifailr, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34246,14 +34246,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_whseqr( job, compz, n, ilo, ihi, h, ldh, w, z, ldz,work, lwork, info ) - !> ZHSEQR: 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. + !! ZHSEQR: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34391,19 +34391,19 @@ module stdlib_linalg_lapack_w subroutine stdlib_wla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34586,8 +34586,8 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wla_gbrcond_c( trans, n, kl, ku, ab,ldab, afb, ldafb, ipiv,c, & - !> ZLA_GBRCOND_C: Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. + !! ZLA_GBRCOND_C: Computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. capply, info, work,rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34734,12 +34734,12 @@ module stdlib_linalg_lapack_w pure real(qp) function stdlib_wla_gbrpvgrw( n, kl, ku, ncols, ab,ldab, afb, ldafb ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34779,19 +34779,19 @@ module stdlib_linalg_lapack_w subroutine stdlib_wla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34968,8 +34968,8 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wla_gercond_c( trans, n, a, lda, af,ldaf, ipiv, c, capply,info, & - !> ZLA_GERCOND_C: computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. + !! ZLA_GERCOND_C: computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. work, rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35109,12 +35109,12 @@ module stdlib_linalg_lapack_w pure real(qp) function stdlib_wla_gerpvgrw( n, ncols, a, lda, af,ldaf ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35153,18 +35153,18 @@ module stdlib_linalg_lapack_w subroutine stdlib_wla_heamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35347,8 +35347,8 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wla_hercond_c( uplo, n, a, lda, af,ldaf, ipiv, c, capply,info, work,& - !> ZLA_HERCOND_C: computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. + !! ZLA_HERCOND_C: computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35497,12 +35497,12 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wla_herpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35686,11 +35686,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wla_lin_berr( n, nz, nrhs, res, ayb, berr ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35732,8 +35732,8 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wla_porcond_c( uplo, n, a, lda, af,ldaf, c, capply, info,work, & - !> ZLA_PORCOND_C: Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector + !! ZLA_PORCOND_C: Computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35882,12 +35882,12 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wla_porpvgrw( uplo, ncols, a, lda, af,ldaf, work ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35975,18 +35975,18 @@ module stdlib_linalg_lapack_w subroutine stdlib_wla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36170,8 +36170,8 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wla_syrcond_c( uplo, n, a, lda, af,ldaf, ipiv, c, capply,info, work,& - !> ZLA_SYRCOND_C: Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. + !! ZLA_SYRCOND_C: Computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36321,12 +36321,12 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wla_syrpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36510,9 +36510,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wla_wwaddw( n, x, y, w ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36537,13 +36537,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) - !> ZLABRD: 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 ZGEBRD + !! ZLABRD: 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 ZGEBRD ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36687,7 +36687,7 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlacgv( n, x, incx ) - !> ZLACGV: conjugates a complex vector of length N. + !! ZLACGV: conjugates a complex vector of length N. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36718,8 +36718,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlacn2( n, v, x, est, kase, isave ) - !> ZLACN2: estimates the 1-norm of a square, complex matrix A. - !> Reverse communication is used for evaluating matrix-vector products. + !! ZLACN2: estimates the 1-norm of a square, complex matrix A. + !! Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36845,8 +36845,8 @@ module stdlib_linalg_lapack_w subroutine stdlib_wlacon( n, v, x, est, kase ) - !> ZLACON: estimates the 1-norm of a square, complex matrix A. - !> Reverse communication is used for evaluating matrix-vector products. + !! ZLACON: estimates the 1-norm of a square, complex matrix A. + !! Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36972,8 +36972,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlacp2( uplo, m, n, a, lda, b, ldb ) - !> ZLACP2: copies all or part of a real two-dimensional matrix A to a - !> complex matrix B. + !! ZLACP2: copies all or part of a real two-dimensional matrix A to a + !! complex matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37013,8 +37013,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlacpy( uplo, m, n, a, lda, b, ldb ) - !> ZLACPY: copies all or part of a two-dimensional matrix A to another - !> matrix B. + !! ZLACPY: copies all or part of a two-dimensional matrix A to another + !! matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37054,10 +37054,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlacrm( m, n, a, lda, b, ldb, c, ldc, rwork ) - !> ZLACRM: 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. + !! ZLACRM: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37108,10 +37108,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlacrt( n, cx, incx, cy, incy, c, s ) - !> ZLACRT: 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. + !! ZLACRT: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37152,9 +37152,9 @@ module stdlib_linalg_lapack_w pure complex(qp) function stdlib_wladiv( x, y ) - !> ZLADIV: := X / Y, where X and Y are complex. The computation of X / Y - !> will not overflow on an intermediary step unless the results - !> overflows. + !! ZLADIV: := X / Y, where X and Y are complex. The computation of X / Y + !! will not overflow on an intermediary step unless the results + !! overflows. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37174,10 +37174,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaed0( qsiz, n, d, e, q, ldq, qstore, ldqs, rwork,iwork, info ) - !> Using the divide and conquer method, ZLAED0: 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. + !! Using the divide and conquer method, ZLAED0: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37352,30 +37352,30 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaed7( n, cutpnt, qsiz, tlvls, curlvl, curpbm, d, q,ldq, rho, indxq, & - !> ZLAED7: 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 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 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. + !! ZLAED7: 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 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 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. qstore, qptr, prmptr, perm,givptr, givcol, givnum, work, rwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37479,12 +37479,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaed8( k, n, qsiz, q, ldq, d, rho, cutpnt, z, dlamda,q2, ldq2, w, & - !> ZLAED8: 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. + !! ZLAED8: 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. indxp, indx, indxq, perm, givptr,givcol, givnum, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37682,9 +37682,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaein( rightv, noinit, n, h, ldh, w, v, b, ldb, rwork,eps3, smlnum, & - !> ZLAEIN: uses inverse iteration to find a right or left eigenvector - !> corresponding to the eigenvalue W of a complex upper Hessenberg - !> matrix H. + !! ZLAEIN: uses inverse iteration to find a right or left eigenvector + !! corresponding to the eigenvalue W of a complex upper Hessenberg + !! matrix H. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37826,15 +37826,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaesy( a, b, c, rt1, rt2, evscal, cs1, sn1 ) - !> ZLAESY: 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 ] + !! ZLAESY: 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 ] ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37916,14 +37916,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaev2( a, b, c, rt1, rt2, cs1, sn1 ) - !> ZLAEV2: computes the eigendecomposition of a 2-by-2 Hermitian matrix - !> [ A B ] - !> [ CONJG(B) C ]. - !> On return, RT1 is the eigenvalue of larger absolute value, RT2 is the - !> eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right - !> eigenvector for RT1, giving the decomposition - !> [ CS1 CONJG(SN1) ] [ A B ] [ CS1 -CONJG(SN1) ] = [ RT1 0 ] - !> [-SN1 CS1 ] [ CONJG(B) C ] [ SN1 CS1 ] [ 0 RT2 ]. + !! ZLAEV2: computes the eigendecomposition of a 2-by-2 Hermitian matrix + !! [ A B ] + !! [ CONJG(B) C ]. + !! On return, RT1 is the eigenvalue of larger absolute value, RT2 is the + !! eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right + !! eigenvector for RT1, giving the decomposition + !! [ CS1 CONJG(SN1) ] [ A B ] [ CS1 -CONJG(SN1) ] = [ RT1 0 ] + !! [-SN1 CS1 ] [ CONJG(B) C ] [ SN1 CS1 ] [ 0 RT2 ]. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37953,11 +37953,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlag2c( m, n, a, lda, sa, ldsa, info ) - !> ZLAG2C: converts a COMPLEX*16 matrix, SA, to a COMPLEX matrix, A. - !> RMAX is the overflow for the SINGLE PRECISION arithmetic - !> ZLAG2C checks that all the entries of A are between -RMAX and - !> RMAX. If not the conversion is aborted and a flag is raised. - !> This is an auxiliary routine so there is no argument checking. + !! ZLAG2C: converts a COMPLEX*16 matrix, SA, to a COMPLEX matrix, A. + !! RMAX is the overflow for the SINGLE PRECISION arithmetic + !! ZLAG2C checks that all the entries of A are between -RMAX and + !! RMAX. If not the conversion is aborted and a flag is raised. + !! This is an auxiliary routine so there is no argument checking. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37992,30 +37992,30 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) - !> ZLAGS2: computes 2-by-2 unitary matrices U, V and Q, such - !> that if ( UPPER ) then - !> U**H *A*Q = U**H *( A1 A2 )*Q = ( x 0 ) - !> ( 0 A3 ) ( x x ) - !> and - !> V**H*B*Q = V**H *( B1 B2 )*Q = ( x 0 ) - !> ( 0 B3 ) ( x x ) - !> or if ( .NOT.UPPER ) then - !> U**H *A*Q = U**H *( A1 0 )*Q = ( x x ) - !> ( A2 A3 ) ( 0 x ) - !> and - !> V**H *B*Q = V**H *( B1 0 )*Q = ( x x ) - !> ( B2 B3 ) ( 0 x ) - !> where - !> U = ( CSU SNU ), V = ( CSV SNV ), - !> ( -SNU**H CSU ) ( -SNV**H CSV ) - !> Q = ( CSQ SNQ ) - !> ( -SNQ**H CSQ ) - !> The rows of the transformed A and B are parallel. Moreover, if the - !> input 2-by-2 matrix A is not zero, then the transformed (1,1) entry - !> of A is not zero. If the input matrices A and B are both not zero, - !> then the transformed (2,2) element of B is not zero, except when the - !> first rows of input A and B are parallel and the second rows are - !> zero. + !! ZLAGS2: computes 2-by-2 unitary matrices U, V and Q, such + !! that if ( UPPER ) then + !! U**H *A*Q = U**H *( A1 A2 )*Q = ( x 0 ) + !! ( 0 A3 ) ( x x ) + !! and + !! V**H*B*Q = V**H *( B1 B2 )*Q = ( x 0 ) + !! ( 0 B3 ) ( x x ) + !! or if ( .NOT.UPPER ) then + !! U**H *A*Q = U**H *( A1 0 )*Q = ( x x ) + !! ( A2 A3 ) ( 0 x ) + !! and + !! V**H *B*Q = V**H *( B1 0 )*Q = ( x x ) + !! ( B2 B3 ) ( 0 x ) + !! where + !! U = ( CSU SNU ), V = ( CSV SNV ), + !! ( -SNU**H CSU ) ( -SNV**H CSV ) + !! Q = ( CSQ SNQ ) + !! ( -SNQ**H CSQ ) + !! The rows of the transformed A and B are parallel. Moreover, if the + !! input 2-by-2 matrix A is not zero, then the transformed (1,1) entry + !! of A is not zero. If the input matrices A and B are both not zero, + !! then the transformed (2,2) element of B is not zero, except when the + !! first rows of input A and B are parallel and the second rows are + !! zero. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38179,11 +38179,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) - !> ZLAGTM: 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. + !! ZLAGTM: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38315,19 +38315,19 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlahef( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) - !> ZLAHEF: 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. - !> ZLAHEF is an auxiliary routine called by ZHETRF. It uses blocked code - !> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or - !> A22 (if UPLO = 'L'). + !! ZLAHEF: 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. + !! ZLAHEF is an auxiliary routine called by ZHETRF. It uses blocked code + !! (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or + !! A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38854,16 +38854,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlahef_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) - !> DLAHEF_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. + !! DLAHEF_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39098,18 +39098,18 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlahef_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) - !> ZLAHEF_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. - !> ZLAHEF_RK is an auxiliary routine called by ZHETRF_RK. It uses - !> blocked code (calling Level 3 BLAS) to update the submatrix - !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). + !! ZLAHEF_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. + !! ZLAHEF_RK is an auxiliary routine called by ZHETRF_RK. It uses + !! blocked code (calling Level 3 BLAS) to update the submatrix + !! A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39738,19 +39738,19 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlahef_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) - !> ZLAHEF_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. - !> ZLAHEF_ROOK is an auxiliary routine called by ZHETRF_ROOK. It uses - !> blocked code (calling Level 3 BLAS) to update the submatrix - !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). + !! ZLAHEF_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. + !! ZLAHEF_ROOK is an auxiliary routine called by ZHETRF_ROOK. It uses + !! blocked code (calling Level 3 BLAS) to update the submatrix + !! A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -40410,10 +40410,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, info & - !> ZLAHQR: 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. + !! ZLAHQR: 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. ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40696,12 +40696,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) - !> ZLAHR2: reduces the first NB columns of A complex general n-BY-(n-k+1) - !> matrix A so that elements below the k-th subdiagonal are zero. The - !> reduction is performed by an unitary similarity transformation - !> Q**H * A * Q. The routine returns the matrices V and T which determine - !> Q as a block reflector I - V*T*V**H, and also the matrix Y = A * V * T. - !> This is an auxiliary routine called by ZGEHRD. + !! ZLAHR2: reduces the first NB columns of A complex general n-BY-(n-k+1) + !! matrix A so that elements below the k-th subdiagonal are zero. The + !! reduction is performed by an unitary similarity transformation + !! Q**H * A * Q. The routine returns the matrices V and T which determine + !! Q as a block reflector I - V*T*V**H, and also the matrix Y = A * V * T. + !! This is an auxiliary routine called by ZGEHRD. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -40786,26 +40786,26 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaic1( job, j, x, sest, w, gamma, sestpr, s, c ) - !> ZLAIC1: 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 ZLAIC1 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. + !! ZLAIC1: 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 ZLAIC1 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41002,26 +41002,26 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, & - !> ZLALS0: 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). + !! ZLALS0: 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). givcol, ldgcol, givnum, ldgnum,poles, difl, difr, z, k, c, s, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41247,15 +41247,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, difl,& - !> ZLALSA: 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, ZLALSA applies the inverse of the left singular vector - !> matrix of an upper bidiagonal matrix to the right hand side; and if - !> ICOMPQ = 1, ZLALSA applies the right singular vector matrix to the - !> right hand side. The singular vector matrices were generated in - !> compact form by ZLALSA. + !! ZLALSA: 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, ZLALSA applies the inverse of the left singular vector + !! matrix of an upper bidiagonal matrix to the right hand side; and if + !! ICOMPQ = 1, ZLALSA applies the right singular vector matrix to the + !! right hand side. The singular vector matrices were generated in + !! compact form by ZLALSA. difr, z, poles, givptr,givcol, ldgcol, perm, givnum, c, s, rwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41550,20 +41550,20 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, rwork, & - !> ZLALSD: 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. + !! ZLALSD: 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. iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41961,13 +41961,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & - !> ZLAMSWLQ: 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 short wide LQ - !> factorization (ZLASWLQ) + !! ZLAMSWLQ: 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 short wide LQ + !! factorization (ZLASWLQ) lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42119,13 +42119,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & - !> ZLAMTSQR: 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 (ZLATSQR) + !! ZLAMTSQR: 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 (ZLATSQR) lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42281,9 +42281,9 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wlangb( norm, n, kl, ku, ab, ldab,work ) - !> ZLANGB: 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. + !! ZLANGB: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42356,9 +42356,9 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wlange( norm, m, n, a, lda, work ) - !> ZLANGE: 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. + !! ZLANGE: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42428,9 +42428,9 @@ module stdlib_linalg_lapack_w pure real(qp) function stdlib_wlangt( norm, n, dl, d, du ) - !> ZLANGT: 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. + !! ZLANGT: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42504,9 +42504,9 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wlanhb( norm, uplo, n, k, ab, ldab,work ) - !> ZLANHB: 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. + !! ZLANHB: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42623,9 +42623,9 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wlanhe( norm, uplo, n, a, lda, work ) - !> ZLANHE: 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. + !! ZLANHE: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42733,9 +42733,9 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wlanhf( norm, transr, uplo, n, a, work ) - !> ZLANHF: 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. + !! ZLANHF: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43953,9 +43953,9 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wlanhp( norm, uplo, n, ap, work ) - !> ZLANHP: 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. + !! ZLANHP: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44081,9 +44081,9 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wlanhs( norm, n, a, lda, work ) - !> ZLANHS: 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. + !! ZLANHS: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44153,9 +44153,9 @@ module stdlib_linalg_lapack_w pure real(qp) function stdlib_wlanht( norm, n, d, e ) - !> ZLANHT: 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. + !! ZLANHT: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44216,9 +44216,9 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wlansb( norm, uplo, n, k, ab, ldab,work ) - !> ZLANSB: 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. + !! ZLANSB: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44321,9 +44321,9 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wlansp( norm, uplo, n, ap, work ) - !> ZLANSP: 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. + !! ZLANSP: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44454,9 +44454,9 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wlansy( norm, uplo, n, a, lda, work ) - !> ZLANSY: 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. + !! ZLANSY: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44550,9 +44550,9 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wlantb( norm, uplo, diag, n, k, ab,ldab, work ) - !> ZLANTB: 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. + !! ZLANTB: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44743,9 +44743,9 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wlantp( norm, uplo, diag, n, ap, work ) - !> ZLANTP: 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. + !! ZLANTP: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44949,9 +44949,9 @@ module stdlib_linalg_lapack_w real(qp) function stdlib_wlantr( norm, uplo, diag, m, n, a, lda,work ) - !> ZLANTR: 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. + !! ZLANTR: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45135,12 +45135,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlapll( n, x, incx, y, incy, ssmin ) - !> 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. + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45179,12 +45179,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlapmr( forwrd, m, n, x, ldx, k ) - !> ZLAPMR: 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. + !! ZLAPMR: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45247,12 +45247,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlapmt( forwrd, m, n, x, ldx, k ) - !> ZLAPMT: 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. + !! ZLAPMT: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45315,9 +45315,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) - !> ZLAQGB: 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. + !! ZLAQGB: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45385,8 +45385,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed ) - !> ZLAQGE: equilibrates a general M by N matrix A using the row and - !> column scaling factors in the vectors R and C. + !! ZLAQGE: equilibrates a general M by N matrix A using the row and + !! column scaling factors in the vectors R and C. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45451,8 +45451,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqhb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) - !> ZLAQHB: equilibrates a Hermitian band matrix A - !> using the scaling factors in the vector S. + !! ZLAQHB: equilibrates a Hermitian band matrix A + !! using the scaling factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45513,8 +45513,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqhe( uplo, n, a, lda, s, scond, amax, equed ) - !> ZLAQHE: equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. + !! ZLAQHE: equilibrates a Hermitian matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45575,8 +45575,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqhp( uplo, n, ap, s, scond, amax, equed ) - !> ZLAQHP: equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. + !! ZLAQHP: equilibrates a Hermitian matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45641,9 +45641,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqp2( m, n, offset, a, lda, jpvt, tau, vn1, vn2,work ) - !> ZLAQP2: computes a QR factorization with column pivoting of - !> the block A(OFFSET+1:M,1:N). - !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. + !! ZLAQP2: computes a QR factorization with column pivoting of + !! the block A(OFFSET+1:M,1:N). + !! The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45721,14 +45721,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & - !> ZLAQPS: 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. + !! ZLAQPS: 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. ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45864,14 +45864,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& - !> ZLAQR0: 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. + !! ZLAQR0: 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. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46211,12 +46211,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqr1( n, h, ldh, s1, s2, v ) - !> Given a 2-by-2 or 3-by-3 matrix H, ZLAQR1: 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. + !! Given a 2-by-2 or 3-by-3 matrix H, ZLAQR1: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46274,17 +46274,17 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & - !> ZLAQR2: is identical to ZLAQR3 except that it avoids - !> recursion by calling ZLAHQR instead of ZLAQR4. - !> Aggressive early deflation: - !> ZLAQR2 accepts as input an upper Hessenberg matrix - !> H and performs an unitary similarity transformation - !> designed to detect and deflate fully converged eigenvalues from - !> a trailing principal submatrix. On output H has been over- - !> written by a new Hessenberg matrix that is a perturbation of - !> an unitary similarity transformation of H. It is to be - !> hoped that the final version of H has many zero subdiagonal - !> entries. + !! ZLAQR2: is identical to ZLAQR3 except that it avoids + !! recursion by calling ZLAHQR instead of ZLAQR4. + !! Aggressive early deflation: + !! ZLAQR2 accepts as input an upper Hessenberg matrix + !! H and performs an unitary similarity transformation + !! designed to detect and deflate fully converged eigenvalues from + !! a trailing principal submatrix. On output H has been over- + !! written by a new Hessenberg matrix that is a perturbation of + !! an unitary similarity transformation of H. It is to be + !! hoped that the final version of H has many zero subdiagonal + !! entries. ns, nd, sh, v, ldv, nh, t, ldt,nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46488,15 +46488,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & - !> Aggressive early deflation: - !> ZLAQR3: accepts as input an upper Hessenberg matrix - !> H and performs an unitary similarity transformation - !> designed to detect and deflate fully converged eigenvalues from - !> a trailing principal submatrix. On output H has been over- - !> written by a new Hessenberg matrix that is a perturbation of - !> an unitary similarity transformation of H. It is to be - !> hoped that the final version of H has many zero subdiagonal - !> entries. + !! Aggressive early deflation: + !! ZLAQR3: accepts as input an upper Hessenberg matrix + !! H and performs an unitary similarity transformation + !! designed to detect and deflate fully converged eigenvalues from + !! a trailing principal submatrix. On output H has been over- + !! written by a new Hessenberg matrix that is a perturbation of + !! an unitary similarity transformation of H. It is to be + !! hoped that the final version of H has many zero subdiagonal + !! entries. ns, nd, sh, v, ldv, nh, t, ldt,nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46710,20 +46710,20 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqr4( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& - !> ZLAQR4: implements one level of recursion for ZLAQR0. - !> It is a complete implementation of the small bulge multi-shift - !> QR algorithm. It may be called by ZLAQR0 and, for large enough - !> deflation window size, it may be called by ZLAQR3. This - !> subroutine is identical to ZLAQR0 except that it calls ZLAQR2 - !> instead of ZLAQR3. - !> ZLAQR4 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. + !! ZLAQR4: implements one level of recursion for ZLAQR0. + !! It is a complete implementation of the small bulge multi-shift + !! QR algorithm. It may be called by ZLAQR0 and, for large enough + !! deflation window size, it may be called by ZLAQR3. This + !! subroutine is identical to ZLAQR0 except that it calls ZLAQR2 + !! instead of ZLAQR3. + !! ZLAQR4 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. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47058,8 +47058,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts, s,h, ldh, iloz, & - !> ZLAQR5:, called by ZLAQR0, performs a - !> single small-bulge multi-shift QR sweep. + !! ZLAQR5:, called by ZLAQR0, performs a + !! single small-bulge multi-shift QR sweep. ihiz, z, ldz, v, ldv, u, ldu, nv,wv, ldwv, nh, wh, ldwh ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47456,8 +47456,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) - !> ZLAQSB: equilibrates a symmetric band matrix A using the scaling - !> factors in the vector S. + !! ZLAQSB: equilibrates a symmetric band matrix A using the scaling + !! factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47516,8 +47516,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqsp( uplo, n, ap, s, scond, amax, equed ) - !> ZLAQSP: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. + !! ZLAQSP: equilibrates a symmetric matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47578,8 +47578,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqsy( uplo, n, a, lda, s, scond, amax, equed ) - !> ZLAQSY: equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. + !! ZLAQSY: equilibrates a symmetric matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47636,46 +47636,46 @@ module stdlib_linalg_lapack_w recursive subroutine stdlib_wlaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alpha, & - !> ZLAQZ0: computes the eigenvalues of a real 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 real matrix pair (A,B): - !> A = Q1*H*Z1**H, B = Q1*T*Z1**H, - !> as computed by ZGGHRD. - !> 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 ZGGHRD 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" + !! ZLAQZ0: computes the eigenvalues of a real 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 real matrix pair (A,B): + !! A = Q1*H*Z1**H, B = Q1*T*Z1**H, + !! as computed by ZGGHRD. + !! 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 ZGGHRD 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" beta, q, ldq, z,ldz, work, lwork, rwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -47989,7 +47989,7 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqz1( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, qstart, & - !> ZLAQZ1: chases a 1x1 shift bulge in a matrix pencil down a single position + !! ZLAQZ1: chases a 1x1 shift bulge in a matrix pencil down a single position q, ldq, nz, zstart, z, ldz ) ! arguments logical(lk), intent( in ) :: ilq, ilz @@ -48043,7 +48043,7 @@ module stdlib_linalg_lapack_w recursive subroutine stdlib_wlaqz2( ilschur, ilq, ilz, n, ilo, ihi, nw,a, lda, b, ldb, q, & - !> ZLAQZ2: performs AED + !! ZLAQZ2: performs AED ldq, z, ldz, ns,nd, alpha, beta, qc, ldqc, zc, ldzc,work, lwork, rwork, rec, info ) ! arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -48232,7 +48232,7 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaqz3( ilschur, ilq, ilz, n, ilo, ihi, nshifts,nblock_qesired, alpha,& - !> ZLAQZ3: Executes a single multishift QZ sweep + !! ZLAQZ3: Executes a single multishift QZ sweep beta, a, lda, b, ldb,q, ldq, z, ldz, qc, ldqc, zc, ldzc, work,lwork, info ) ! function arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -48472,21 +48472,21 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & - !> ZLAR1V: 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. + !! ZLAR1V: 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. negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48695,13 +48695,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlar2v( n, x, y, z, incx, c, s, incc ) - !> ZLAR2V: 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) ) + !! ZLAR2V: 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) ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48749,10 +48749,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlarcm( m, n, a, lda, b, ldb, c, ldc, rwork ) - !> ZLARCM: 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. + !! ZLARCM: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48803,14 +48803,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlarf( side, m, n, v, incv, tau, c, ldc, work ) - !> ZLARF: 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, supply conjg(tau) instead - !> tau. + !! ZLARF: 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, supply conjg(tau) instead + !! tau. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48883,8 +48883,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, ldc, & - !> ZLARFB: 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. + !! ZLARFB: 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. work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49211,13 +49211,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) - !> ZLARFB_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. + !! ZLARFB_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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49350,19 +49350,19 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlarfg( n, alpha, x, incx, tau ) - !> ZLARFG: 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 . + !! ZLARFG: 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 . ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49424,18 +49424,18 @@ module stdlib_linalg_lapack_w subroutine stdlib_wlarfgp( n, alpha, x, incx, tau ) - !> ZLARFGP: 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. + !! ZLARFGP: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49560,16 +49560,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlarft( direct, storev, n, k, v, ldv, tau, t, ldt ) - !> ZLARFT: 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 + !! ZLARFT: 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 ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49687,13 +49687,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlarfx( side, m, n, v, tau, c, ldc, work ) - !> ZLARFX: 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 - !> This version uses inline code if H has order < 11. + !! ZLARFX: 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 + !! This version uses inline code if H has order < 11. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50192,12 +50192,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlarfy( uplo, n, v, incv, tau, c, ldc, work ) - !> ZLARFY: 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. + !! ZLARFY: 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. ! -- lapack test routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50226,16 +50226,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlargv( n, x, incx, y, incy, c, incc ) - !> ZLARGV: 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 ZLARTG, - !> but differ from the BLAS1 routine ZROTG): - !> 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. + !! ZLARGV: 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 ZLARTG, + !! but differ from the BLAS1 routine ZROTG): + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50380,8 +50380,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlarnv( idist, iseed, n, x ) - !> ZLARNV: returns a vector of n random complex numbers from a uniform or - !> normal distribution. + !! ZLARNV: returns a vector of n random complex numbers from a uniform or + !! normal distribution. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50445,9 +50445,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, & - !> ZLARRV: 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 DLARRE. + !! ZLARRV: 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 DLARRE. rtol2, w, werr, wgap,iblock, indexw, gers, z, ldz, isuppz,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51095,30 +51095,28 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlartg( f, g, c, s, r ) - !> ! - !> - !> ZLARTG: 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 DLARTG. - !> 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 ZROTG, 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=>dp stands for quad precision from LA_CONSTANTS module. + !! ZLARTG: 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 DLARTG. + !! 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 ZROTG, 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=>dp stands for quad precision from LA_CONSTANTS module. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51215,10 +51213,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlartv( n, x, incx, y, incy, c, s, incc ) - !> ZLARTV: 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) ) + !! ZLARTV: 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) ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51252,15 +51250,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlarz( side, m, n, l, v, incv, tau, c, ldc, work ) - !> ZLARZ: 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 ZTZRZF. + !! ZLARZ: 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 ZTZRZF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51311,9 +51309,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & - !> ZLARZB: 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. + !! ZLARZB: 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. ldc, work, ldwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51413,18 +51411,18 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) - !> ZLARZT: 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. + !! ZLARZT: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51477,11 +51475,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) - !> ZLASCL: 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. + !! ZLASCL: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51647,8 +51645,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaset( uplo, m, n, alpha, beta, a, lda ) - !> ZLASET: initializes a 2-D array A to BETA on the diagonal and - !> ALPHA on the offdiagonals. + !! ZLASET: initializes a 2-D array A to BETA on the diagonal and + !! ALPHA on the offdiagonals. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51703,57 +51701,57 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlasr( side, pivot, direct, m, n, c, s, a, lda ) - !> ZLASR: 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. + !! ZLASR: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51963,26 +51961,24 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlassq( n, x, incx, scl, sumsq ) - !> ! - !> - !> ZLASSQ: 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. + !! ZLASSQ: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52089,16 +52085,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) - !> ZLASWLQ: computes a blocked Tall-Skinny LQ factorization of - !> a complexx 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. + !! ZLASWLQ: computes a blocked Tall-Skinny LQ factorization of + !! a complexx 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -52173,8 +52169,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaswp( n, a, lda, k1, k2, ipiv, incx ) - !> ZLASWP: performs a series of row interchanges on the matrix A. - !> One row interchange is initiated for each of rows K1 through K2 of A. + !! ZLASWP: performs a series of row interchanges on the matrix A. + !! One row interchange is initiated for each of rows K1 through K2 of A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52240,19 +52236,19 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) - !> ZLASYF: 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. - !> ZLASYF is an auxiliary routine called by ZSYTRF. It uses blocked code - !> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or - !> A22 (if UPLO = 'L'). + !! ZLASYF: 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. + !! ZLASYF is an auxiliary routine called by ZSYTRF. It uses blocked code + !! (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or + !! A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52680,16 +52676,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52916,18 +52912,18 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) - !> ZLASYF_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. - !> ZLASYF_RK is an auxiliary routine called by ZSYTRF_RK. It uses - !> blocked code (calling Level 3 BLAS) to update the submatrix - !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). + !! ZLASYF_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. + !! ZLASYF_RK is an auxiliary routine called by ZSYTRF_RK. It uses + !! blocked code (calling Level 3 BLAS) to update the submatrix + !! A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53362,18 +53358,18 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) - !> ZLASYF_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. - !> ZLASYF_ROOK is an auxiliary routine called by ZSYTRF_ROOK. It uses - !> blocked code (calling Level 3 BLAS) to update the submatrix - !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). + !! ZLASYF_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. + !! ZLASYF_ROOK is an auxiliary routine called by ZSYTRF_ROOK. It uses + !! blocked code (calling Level 3 BLAS) to update the submatrix + !! A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53828,12 +53824,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlat2c( uplo, n, a, lda, sa, ldsa, info ) - !> ZLAT2C: converts a COMPLEX*16 triangular matrix, SA, to a COMPLEX - !> triangular matrix, A. - !> RMAX is the overflow for the SINGLE PRECISION arithmetic - !> ZLAT2C checks that all the entries of A are between -RMAX and - !> RMAX. If not the conversion is aborted and a flag is raised. - !> This is an auxiliary routine so there is no argument checking. + !! ZLAT2C: converts a COMPLEX*16 triangular matrix, SA, to a COMPLEX + !! triangular matrix, A. + !! RMAX is the overflow for the SINGLE PRECISION arithmetic + !! ZLAT2C checks that all the entries of A are between -RMAX and + !! RMAX. If not the conversion is aborted and a flag is raised. + !! This is an auxiliary routine so there is no argument checking. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53885,16 +53881,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & - !> ZLATBS: 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 ZTBSV 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. + !! ZLATBS: 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 ZTBSV 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. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54441,14 +54437,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) - !> ZLATDF: 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 ZGETC2. On entry RHS = f holds the - !> contribution from earlier solved sub-systems, and on return RHS = x. - !> The factorization of Z returned by ZGETC2 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. + !! ZLATDF: 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 ZGETC2. On entry RHS = f holds the + !! contribution from earlier solved sub-systems, and on return RHS = x. + !! The factorization of Z returned by ZGETC2 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54555,17 +54551,17 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) - !> ZLATPS: 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 ZTPSV 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. + !! ZLATPS: 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 ZTPSV 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55106,15 +55102,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) - !> ZLATRD: reduces NB rows and columns of a complex Hermitian matrix A to - !> Hermitian tridiagonal form by a unitary similarity - !> transformation Q**H * A * Q, and returns the matrices V and W which are - !> needed to apply the transformation to the unreduced part of A. - !> If UPLO = 'U', ZLATRD reduces the last NB rows and columns of a - !> matrix, of which the upper triangle is supplied; - !> if UPLO = 'L', ZLATRD reduces the first NB rows and columns of a - !> matrix, of which the lower triangle is supplied. - !> This is an auxiliary routine called by ZHETRD. + !! ZLATRD: reduces NB rows and columns of a complex Hermitian matrix A to + !! Hermitian tridiagonal form by a unitary similarity + !! transformation Q**H * A * Q, and returns the matrices V and W which are + !! needed to apply the transformation to the unreduced part of A. + !! If UPLO = 'U', ZLATRD reduces the last NB rows and columns of a + !! matrix, of which the upper triangle is supplied; + !! if UPLO = 'L', ZLATRD reduces the first NB rows and columns of a + !! matrix, of which the lower triangle is supplied. + !! This is an auxiliary routine called by ZHETRD. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55222,16 +55218,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) - !> ZLATRS: 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. Here A is an upper or lower - !> triangular matrix, 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 - !> ZTRSV 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. + !! ZLATRS: 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. Here A is an upper or lower + !! triangular matrix, 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 + !! ZTRSV 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55751,10 +55747,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlatrz( m, n, l, a, lda, tau, work ) - !> ZLATRZ: factors the M-by-(M+L) complex upper trapezoidal matrix - !> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z by means - !> of unitary transformations, where Z is an (M+L)-by-(M+L) unitary - !> matrix and, R and A1 are M-by-M upper triangular matrices. + !! ZLATRZ: factors the M-by-(M+L) complex upper trapezoidal matrix + !! [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z by means + !! of unitary transformations, where Z is an (M+L)-by-(M+L) unitary + !! matrix and, R and A1 are M-by-M upper triangular matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55797,17 +55793,17 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) - !> ZLATSQR: computes a blocked Tall-Skinny QR factorization of - !> a complex M-by-N matrix A for M >= N: - !> A = Q * ( R ), - !> ( 0 ) - !> where: - !> Q is a M-by-M orthogonal matrix, stored on exit in an implicit - !> form in the elements below the diagonal of the array A and in - !> the elements of the array T; - !> R is an upper-triangular N-by-N matrix, stored on exit in - !> the elements on and above the diagonal of the array A. - !> 0 is a (M-N)-by-N zero matrix, and is not stored. + !! ZLATSQR: computes a blocked Tall-Skinny QR factorization of + !! a complex M-by-N matrix A for M >= N: + !! A = Q * ( R ), + !! ( 0 ) + !! where: + !! Q is a M-by-M orthogonal matrix, stored on exit in an implicit + !! form in the elements below the diagonal of the array A and in + !! the elements of the array T; + !! R is an upper-triangular N-by-N matrix, stored on exit in + !! the elements on and above the diagonal of the array A. + !! 0 is a (M-N)-by-N zero matrix, and is not stored. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -55882,39 +55878,39 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlaunhr_col_getrfnp( m, n, a, lda, d, info ) - !> ZLAUNHR_COL_GETRFNP: computes the modified LU factorization without - !> pivoting of a complex 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 ZUNHR_COL. In ZUNHR_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 ZLAUNHR_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. + !! ZLAUNHR_COL_GETRFNP: computes the modified LU factorization without + !! pivoting of a complex 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 ZUNHR_COL. In ZUNHR_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 ZLAUNHR_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55976,54 +55972,54 @@ module stdlib_linalg_lapack_w pure recursive subroutine stdlib_wlaunhr_col_getrfnp2( m, n, a, lda, d, info ) - !> ZLAUNHR_COL_GETRFNP2: computes the modified LU factorization without - !> pivoting of a complex 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 ZUNHR_COL. In ZUNHR_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]. - !> ZLAUNHR_COL_GETRFNP2 is called to factorize a block by the blocked - !> routine ZLAUNHR_COL_GETRFNP, which uses blocked code calling - !> Level 3 BLAS to update the submatrix. However, ZLAUNHR_COL_GETRFNP2 - !> is self-sufficient and can be used without ZLAUNHR_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. + !! ZLAUNHR_COL_GETRFNP2: computes the modified LU factorization without + !! pivoting of a complex 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 ZUNHR_COL. In ZUNHR_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]. + !! ZLAUNHR_COL_GETRFNP2 is called to factorize a block by the blocked + !! routine ZLAUNHR_COL_GETRFNP, which uses blocked code calling + !! Level 3 BLAS to update the submatrix. However, ZLAUNHR_COL_GETRFNP2 + !! is self-sufficient and can be used without ZLAUNHR_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56112,14 +56108,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlauu2( uplo, n, a, lda, info ) - !> ZLAUU2: computes the product U * U**H or L**H * L, where the triangular - !> factor U or L is stored in the upper or lower triangular part of - !> the array A. - !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, - !> overwriting the factor U in A. - !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, - !> overwriting the factor L in A. - !> This is the unblocked form of the algorithm, calling Level 2 BLAS. + !! ZLAUU2: computes the product U * U**H or L**H * L, where the triangular + !! factor U or L is stored in the upper or lower triangular part of + !! the array A. + !! If UPLO = 'U' or 'u' then the upper triangle of the result is stored, + !! overwriting the factor U in A. + !! If UPLO = 'L' or 'l' then the lower triangle of the result is stored, + !! overwriting the factor L in A. + !! This is the unblocked form of the algorithm, calling Level 2 BLAS. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56190,14 +56186,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wlauum( uplo, n, a, lda, info ) - !> ZLAUUM: computes the product U * U**H or L**H * L, where the triangular - !> factor U or L is stored in the upper or lower triangular part of - !> the array A. - !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, - !> overwriting the factor U in A. - !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, - !> overwriting the factor L in A. - !> This is the blocked form of the algorithm, calling Level 3 BLAS. + !! ZLAUUM: computes the product U * U**H or L**H * L, where the triangular + !! factor U or L is stored in the upper or lower triangular part of + !! the array A. + !! If UPLO = 'U' or 'u' then the upper triangle of the result is stored, + !! overwriting the factor U in A. + !! If UPLO = 'L' or 'l' then the lower triangle of the result is stored, + !! overwriting the factor L in A. + !! This is the blocked form of the algorithm, calling Level 3 BLAS. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56274,12 +56270,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,rwork, info ) - !> ZPBCON: estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite band matrix using - !> the Cholesky factorization A = U**H*U or A = L*L**H computed by - !> ZPBTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZPBCON: estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite band matrix using + !! the Cholesky factorization A = U**H*U or A = L*L**H computed by + !! ZPBTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56378,14 +56374,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) - !> ZPBEQU: computes row and column scalings intended to equilibrate a - !> Hermitian positive definite band matrix A and reduce its condition - !> number (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. + !! ZPBEQU: computes row and column scalings intended to equilibrate a + !! Hermitian positive definite band matrix A and reduce its condition + !! number (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56465,10 +56461,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & - !> ZPBRFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite - !> and banded, and provides error bounds and backward error estimates - !> for the solution. + !! ZPBRFS: improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite + !! and banded, and provides error bounds and backward error estimates + !! for the solution. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56663,15 +56659,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpbstf( uplo, n, kd, ab, ldab, info ) - !> ZPBSTF: computes a split Cholesky factorization of a complex - !> Hermitian positive definite band matrix A. - !> This routine is designed to be used in conjunction with ZHBGST. - !> The factorization has the form A = S**H*S where S is a band matrix - !> of the same bandwidth as A and the following structure: - !> S = ( U ) - !> ( M L ) - !> where U is upper triangular of order m = (n+kd)/2, and L is lower - !> triangular of order n-m. + !! ZPBSTF: computes a split Cholesky factorization of a complex + !! Hermitian positive definite band matrix A. + !! This routine is designed to be used in conjunction with ZHBGST. + !! The factorization has the form A = S**H*S where S is a band matrix + !! of the same bandwidth as A and the following structure: + !! S = ( U ) + !! ( M L ) + !! where U is upper triangular of order m = (n+kd)/2, and L is lower + !! triangular of order n-m. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56797,17 +56793,17 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) - !> ZPBSV: computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite band matrix and X - !> and B are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular band matrix, and L is a lower - !> triangular band matrix, with the same number of superdiagonals or - !> subdiagonals as A. The factored form of A is then used to solve the - !> system of equations A * X = B. + !! ZPBSV: computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite band matrix and X + !! and B are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular band matrix, and L is a lower + !! triangular band matrix, with the same number of superdiagonals or + !! subdiagonals as A. The factored form of A is then used to solve the + !! system of equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56851,13 +56847,13 @@ module stdlib_linalg_lapack_w subroutine stdlib_wpbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & - !> ZPBSVX: uses the Cholesky factorization A = U**H*U or A = L*L**H to - !> compute the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite band matrix and X - !> and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZPBSVX: uses the Cholesky factorization A = U**H*U or A = L*L**H to + !! compute the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite band matrix and X + !! and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57008,14 +57004,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpbtf2( uplo, n, kd, ab, ldab, info ) - !> ZPBTF2: computes the Cholesky factorization of a complex Hermitian - !> positive definite band matrix A. - !> The factorization has the form - !> A = U**H * U , if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix, U**H is the conjugate transpose - !> of U, and L is lower triangular. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! ZPBTF2: computes the Cholesky factorization of a complex Hermitian + !! positive definite band matrix A. + !! The factorization has the form + !! A = U**H * U , if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix, U**H is the conjugate transpose + !! of U, and L is lower triangular. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57103,12 +57099,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpbtrf( uplo, n, kd, ab, ldab, info ) - !> ZPBTRF: computes the Cholesky factorization of a complex Hermitian - !> positive definite band matrix A. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. + !! ZPBTRF: computes the Cholesky factorization of a complex Hermitian + !! positive definite band matrix A. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57303,9 +57299,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) - !> ZPBTRS: solves a system of linear equations A*X = B with a Hermitian - !> positive definite band matrix A using the Cholesky factorization - !> A = U**H *U or A = L*L**H computed by ZPBTRF. + !! ZPBTRS: solves a system of linear equations A*X = B with a Hermitian + !! positive definite band matrix A using the Cholesky factorization + !! A = U**H *U or A = L*L**H computed by ZPBTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57371,13 +57367,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpftrf( transr, uplo, n, a, info ) - !> ZPFTRF: computes the Cholesky factorization of a complex Hermitian - !> positive definite matrix A. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the block version of the algorithm, calling Level 3 BLAS. + !! ZPFTRF: computes the Cholesky factorization of a complex Hermitian + !! positive definite matrix A. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the block version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57547,9 +57543,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpftri( transr, uplo, n, a, info ) - !> ZPFTRI: computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by ZPFTRF. + !! ZPFTRI: computes the inverse of a complex Hermitian positive definite + !! matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !! computed by ZPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57706,9 +57702,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpftrs( transr, uplo, n, nrhs, a, b, ldb, info ) - !> ZPFTRS: solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A using the Cholesky factorization - !> A = U**H*U or A = L*L**H computed by ZPFTRF. + !! ZPFTRS: solves a system of linear equations A*X = B with a Hermitian + !! positive definite matrix A using the Cholesky factorization + !! A = U**H*U or A = L*L**H computed by ZPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57760,11 +57756,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpocon( uplo, n, a, lda, anorm, rcond, work, rwork,info ) - !> ZPOCON: estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite matrix using the - !> Cholesky factorization A = U**H*U or A = L*L**H computed by ZPOTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZPOCON: estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite matrix using the + !! Cholesky factorization A = U**H*U or A = L*L**H computed by ZPOTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57860,14 +57856,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpoequ( n, a, lda, s, scond, amax, info ) - !> ZPOEQU: computes row and column scalings intended to equilibrate a - !> Hermitian positive definite matrix A and reduce its condition number - !> (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. + !! ZPOEQU: computes row and column scalings intended to equilibrate a + !! Hermitian positive definite matrix A and reduce its condition number + !! (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57934,19 +57930,19 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpoequb( n, a, lda, s, scond, amax, info ) - !> ZPOEQUB: computes row and column scalings intended to equilibrate a - !> Hermitian positive definite matrix A and reduce its condition number - !> (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. - !> This routine differs from ZPOEQU 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 diagonal entries are no longer approximately 1 but lie - !> between sqrt(radix) and 1/sqrt(radix). + !! ZPOEQUB: computes row and column scalings intended to equilibrate a + !! Hermitian positive definite matrix A and reduce its condition number + !! (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. + !! This routine differs from ZPOEQU 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 diagonal entries are no longer approximately 1 but lie + !! between sqrt(radix) and 1/sqrt(radix). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58016,10 +58012,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & - !> ZPORFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite, - !> and provides error bounds and backward error estimates for the - !> solution. + !! ZPORFS: improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite, + !! and provides error bounds and backward error estimates for the + !! solution. work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58209,16 +58205,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wposv( uplo, n, nrhs, a, lda, b, ldb, info ) - !> ZPOSV: computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**H* U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is a lower triangular - !> matrix. The factored form of A is then used to solve the system of - !> equations A * X = B. + !! ZPOSV: computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**H* U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is a lower triangular + !! matrix. The factored form of A is then used to solve the system of + !! equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58260,13 +58256,13 @@ module stdlib_linalg_lapack_w subroutine stdlib_wposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & - !> ZPOSVX: uses the Cholesky factorization A = U**H*U or A = L*L**H to - !> compute the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZPOSVX: uses the Cholesky factorization A = U**H*U or A = L*L**H to + !! compute the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. rcond, ferr, berr, work,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58404,13 +58400,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpotf2( uplo, n, a, lda, info ) - !> ZPOTF2: computes the Cholesky factorization of a complex Hermitian - !> positive definite matrix A. - !> The factorization has the form - !> A = U**H * U , if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! ZPOTF2: computes the Cholesky factorization of a complex Hermitian + !! positive definite matrix A. + !! The factorization has the form + !! A = U**H * U , if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58498,13 +58494,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpotrf( uplo, n, a, lda, info ) - !> ZPOTRF: computes the Cholesky factorization of a complex Hermitian - !> positive definite matrix A. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the block version of the algorithm, calling Level 3 BLAS. + !! ZPOTRF: computes the Cholesky factorization of a complex Hermitian + !! positive definite matrix A. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the block version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58593,19 +58589,19 @@ module stdlib_linalg_lapack_w pure recursive subroutine stdlib_wpotrf2( uplo, n, a, lda, info ) - !> ZPOTRF2: computes the Cholesky factorization of a Hermitian - !> positive definite matrix A using the recursive algorithm. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> 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 = n/2 - !> [ A21 | A22 ] n2 = n-n1 - !> The subroutine calls itself to factor A11. Update and scale A21 - !> or A12, update A22 then call itself to factor A22. + !! ZPOTRF2: computes the Cholesky factorization of a Hermitian + !! positive definite matrix A using the recursive algorithm. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! 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 = n/2 + !! [ A21 | A22 ] n2 = n-n1 + !! The subroutine calls itself to factor A11. Update and scale A21 + !! or A12, update A22 then call itself to factor A22. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58694,9 +58690,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpotri( uplo, n, a, lda, info ) - !> ZPOTRI: computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by ZPOTRF. + !! ZPOTRI: computes the inverse of a complex Hermitian positive definite + !! matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !! computed by ZPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58735,9 +58731,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpotrs( uplo, n, nrhs, a, lda, b, ldb, info ) - !> ZPOTRS: solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A using the Cholesky factorization - !> A = U**H * U or A = L * L**H computed by ZPOTRF. + !! ZPOTRS: solves a system of linear equations A*X = B with a Hermitian + !! positive definite matrix A using the Cholesky factorization + !! A = U**H * U or A = L * L**H computed by ZPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58797,12 +58793,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wppcon( uplo, n, ap, anorm, rcond, work, rwork, info ) - !> ZPPCON: estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite packed matrix using - !> the Cholesky factorization A = U**H*U or A = L*L**H computed by - !> ZPPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZPPCON: estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite packed matrix using + !! the Cholesky factorization A = U**H*U or A = L*L**H computed by + !! ZPPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58896,14 +58892,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wppequ( uplo, n, ap, s, scond, amax, info ) - !> ZPPEQU: computes row and column scalings intended to equilibrate a - !> Hermitian positive definite matrix A in packed storage and reduce - !> its condition number (with respect to the two-norm). S contains the - !> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix - !> B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal. - !> This choice of S puts the condition number of B within a factor N of - !> the smallest possible condition number over all possible diagonal - !> scalings. + !! ZPPEQU: computes row and column scalings intended to equilibrate a + !! Hermitian positive definite matrix A in packed storage and reduce + !! its condition number (with respect to the two-norm). S contains the + !! scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix + !! B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal. + !! This choice of S puts the condition number of B within a factor N of + !! the smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58989,10 +58985,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & - !> ZPPRFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite - !> and packed, and provides error bounds and backward error estimates - !> for the solution. + !! ZPPRFS: improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite + !! and packed, and provides error bounds and backward error estimates + !! for the solution. rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59185,16 +59181,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wppsv( uplo, n, nrhs, ap, b, ldb, info ) - !> ZPPSV: computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix stored in - !> packed format and X and B are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is a lower triangular - !> matrix. The factored form of A is then used to solve the system of - !> equations A * X = B. + !! ZPPSV: computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix stored in + !! packed format and X and B are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is a lower triangular + !! matrix. The factored form of A is then used to solve the system of + !! equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59234,13 +59230,13 @@ module stdlib_linalg_lapack_w subroutine stdlib_wppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& - !> ZPPSVX: uses the Cholesky factorization A = U**H * U or A = L * L**H to - !> compute the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix stored in - !> packed format and X and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZPPSVX: uses the Cholesky factorization A = U**H * U or A = L * L**H to + !! compute the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix stored in + !! packed format and X and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59374,12 +59370,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpptrf( uplo, n, ap, info ) - !> ZPPTRF: computes the Cholesky factorization of a complex Hermitian - !> positive definite matrix A stored in packed format. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. + !! ZPPTRF: computes the Cholesky factorization of a complex Hermitian + !! positive definite matrix A stored in packed format. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59460,9 +59456,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpptri( uplo, n, ap, info ) - !> ZPPTRI: computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by ZPPTRF. + !! ZPPTRI: computes the inverse of a complex Hermitian positive definite + !! matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !! computed by ZPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59524,9 +59520,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpptrs( uplo, n, nrhs, ap, b, ldb, info ) - !> ZPPTRS: solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A in packed storage using the Cholesky - !> factorization A = U**H * U or A = L * L**H computed by ZPPTRF. + !! ZPPTRS: solves a system of linear equations A*X = B with a Hermitian + !! positive definite matrix A in packed storage using the Cholesky + !! factorization A = U**H * U or A = L * L**H computed by ZPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59588,15 +59584,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpstf2( uplo, n, a, lda, piv, rank, tol, work, info ) - !> ZPSTF2: computes the Cholesky factorization with complete - !> pivoting of a complex Hermitian positive semidefinite matrix A. - !> The factorization has the form - !> P**T * A * P = U**H * U , if UPLO = 'U', - !> P**T * A * P = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular, and - !> P is stored as vector PIV. - !> This algorithm does not attempt to check that A is positive - !> semidefinite. This version of the algorithm calls level 2 BLAS. + !! ZPSTF2: computes the Cholesky factorization with complete + !! pivoting of a complex Hermitian positive semidefinite matrix A. + !! The factorization has the form + !! P**T * A * P = U**H * U , if UPLO = 'U', + !! P**T * A * P = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular, and + !! P is stored as vector PIV. + !! This algorithm does not attempt to check that A is positive + !! semidefinite. This version of the algorithm calls level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59782,15 +59778,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) - !> ZPSTRF: computes the Cholesky factorization with complete - !> pivoting of a complex Hermitian positive semidefinite matrix A. - !> The factorization has the form - !> P**T * A * P = U**H * U , if UPLO = 'U', - !> P**T * A * P = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular, and - !> P is stored as vector PIV. - !> This algorithm does not attempt to check that A is positive - !> semidefinite. This version of the algorithm calls level 3 BLAS. + !! ZPSTRF: computes the Cholesky factorization with complete + !! pivoting of a complex Hermitian positive semidefinite matrix A. + !! The factorization has the form + !! P**T * A * P = U**H * U , if UPLO = 'U', + !! P**T * A * P = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular, and + !! P is stored as vector PIV. + !! This algorithm does not attempt to check that A is positive + !! semidefinite. This version of the algorithm calls level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60008,13 +60004,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wptcon( n, d, e, anorm, rcond, rwork, info ) - !> ZPTCON: computes the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite tridiagonal matrix - !> using the factorization A = L*D*L**H or A = U**H*D*U computed by - !> ZPTTRF. - !> Norm(inv(A)) is computed by a direct method, and the reciprocal of - !> the condition number is computed as - !> RCOND = 1 / (ANORM * norm(inv(A))). + !! ZPTCON: computes the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite tridiagonal matrix + !! using the factorization A = L*D*L**H or A = U**H*D*U computed by + !! ZPTTRF. + !! Norm(inv(A)) is computed by a direct method, and the reciprocal of + !! the condition number is computed as + !! RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60082,21 +60078,21 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpteqr( compz, n, d, e, z, ldz, work, info ) - !> ZPTEQR: computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric positive definite tridiagonal matrix by first factoring the - !> matrix using DPTTRF and then calling ZBDSQR to compute the singular - !> values of the bidiagonal factor. - !> This routine computes the eigenvalues of the positive definite - !> tridiagonal matrix to high relative accuracy. This means that if the - !> eigenvalues range over many orders of magnitude in size, then the - !> small eigenvalues and corresponding eigenvectors will be computed - !> more accurately than, for example, with the standard QR method. - !> The eigenvectors of a full or band positive definite Hermitian matrix - !> can also be found if ZHETRD, ZHPTRD, or ZHBTRD has been used to - !> reduce this matrix to tridiagonal form. (The reduction to - !> tridiagonal form, however, may preclude the possibility of obtaining - !> high relative accuracy in the small eigenvalues of the original - !> matrix, if these eigenvalues range over many orders of magnitude.) + !! ZPTEQR: computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric positive definite tridiagonal matrix by first factoring the + !! matrix using DPTTRF and then calling ZBDSQR to compute the singular + !! values of the bidiagonal factor. + !! This routine computes the eigenvalues of the positive definite + !! tridiagonal matrix to high relative accuracy. This means that if the + !! eigenvalues range over many orders of magnitude in size, then the + !! small eigenvalues and corresponding eigenvectors will be computed + !! more accurately than, for example, with the standard QR method. + !! The eigenvectors of a full or band positive definite Hermitian matrix + !! can also be found if ZHETRD, ZHPTRD, or ZHBTRD has been used to + !! reduce this matrix to tridiagonal form. (The reduction to + !! tridiagonal form, however, may preclude the possibility of obtaining + !! high relative accuracy in the small eigenvalues of the original + !! matrix, if these eigenvalues range over many orders of magnitude.) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60177,10 +60173,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wptrfs( uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx,ferr, berr, work, & - !> ZPTRFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite - !> and tridiagonal, and provides error bounds and backward error - !> estimates for the solution. + !! ZPTRFS: improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite + !! and tridiagonal, and provides error bounds and backward error + !! estimates for the solution. rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60395,11 +60391,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wptsv( n, nrhs, d, e, b, ldb, info ) - !> ZPTSV: computes the solution to a complex system of linear equations - !> A*X = B, where A is an N-by-N Hermitian positive definite tridiagonal - !> matrix, and X and B are N-by-NRHS matrices. - !> A is factored as A = L*D*L**H, and the factored form of A is then - !> used to solve the system of equations. + !! ZPTSV: computes the solution to a complex system of linear equations + !! A*X = B, where A is an N-by-N Hermitian positive definite tridiagonal + !! matrix, and X and B are N-by-NRHS matrices. + !! A is factored as A = L*D*L**H, and the factored form of A is then + !! used to solve the system of equations. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60437,12 +60433,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& - !> ZPTSVX: uses the factorization A = L*D*L**H to compute the solution - !> to a complex system of linear equations A*X = B, where A is an - !> N-by-N Hermitian positive definite tridiagonal matrix and X and B - !> are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZPTSVX: uses the factorization A = L*D*L**H to compute the solution + !! to a complex system of linear equations A*X = B, where A is an + !! N-by-N Hermitian positive definite tridiagonal matrix and X and B + !! are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60514,9 +60510,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpttrf( n, d, e, info ) - !> ZPTTRF: computes the L*D*L**H factorization of a complex Hermitian - !> positive definite tridiagonal matrix A. The factorization may also - !> be regarded as having the form A = U**H *D*U. + !! ZPTTRF: computes the L*D*L**H factorization of a complex Hermitian + !! positive definite tridiagonal matrix A. The factorization may also + !! be regarded as having the form A = U**H *D*U. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60613,12 +60609,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wpttrs( uplo, n, nrhs, d, e, b, ldb, info ) - !> ZPTTRS: solves a tridiagonal system of the form - !> A * X = B - !> using the factorization A = U**H *D* U or A = L*D*L**H computed by ZPTTRF. - !> D is a diagonal matrix specified in the vector D, U (or L) is a unit - !> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in - !> the vector E, and X and B are N by NRHS matrices. + !! ZPTTRS: solves a tridiagonal system of the form + !! A * X = B + !! using the factorization A = U**H *D* U or A = L*D*L**H computed by ZPTTRF. + !! D is a diagonal matrix specified in the vector D, U (or L) is a unit + !! bidiagonal matrix whose superdiagonal (subdiagonal) is specified in + !! the vector E, and X and B are N by NRHS matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60680,12 +60676,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wptts2( iuplo, n, nrhs, d, e, b, ldb ) - !> ZPTTS2: solves a tridiagonal system of the form - !> A * X = B - !> using the factorization A = U**H *D*U or A = L*D*L**H computed by ZPTTRF. - !> D is a diagonal matrix specified in the vector D, U (or L) is a unit - !> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in - !> the vector E, and X and B are N by NRHS matrices. + !! ZPTTS2: solves a tridiagonal system of the form + !! A * X = B + !! using the factorization A = U**H *D*U or A = L*D*L**H computed by ZPTTRF. + !! D is a diagonal matrix specified in the vector D, U (or L) is a unit + !! bidiagonal matrix whose superdiagonal (subdiagonal) is specified in + !! the vector E, and X and B are N by NRHS matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60780,8 +60776,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wrot( n, cx, incx, cy, incy, c, s ) - !> ZROT: applies a plane rotation, where the cos (C) is real and the - !> sin (S) is complex, and the vectors CX and CY are complex. + !! ZROT: applies a plane rotation, where the cos (C) is real and the + !! sin (S) is complex, and the vectors CX and CY are complex. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60825,11 +60821,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wspcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) - !> ZSPCON: estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex symmetric packed matrix A using the - !> factorization A = U*D*U**T or A = L*D*L**T computed by ZSPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZSPCON: estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex symmetric packed matrix A using the + !! factorization A = U*D*U**T or A = L*D*L**T computed by ZSPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -60906,10 +60902,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wspmv( uplo, n, alpha, ap, x, incx, beta, y, incy ) - !> ZSPMV: performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix, supplied in packed form. + !! ZSPMV: performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix, supplied in packed form. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61064,10 +61060,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wspr( uplo, n, alpha, x, incx, ap ) - !> ZSPR: performs the symmetric rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a complex scalar, x is an n element vector and A is an - !> n by n symmetric matrix, supplied in packed form. + !! ZSPR: performs the symmetric rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a complex scalar, x is an n element vector and A is an + !! n by n symmetric matrix, supplied in packed form. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61184,10 +61180,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& - !> ZSPRFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite - !> and packed, and provides error bounds and backward error estimates - !> for the solution. + !! ZSPRFS: improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric indefinite + !! and packed, and provides error bounds and backward error estimates + !! for the solution. rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61381,17 +61377,17 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> ZSPSV: computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric 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**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, D is symmetric 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. + !! ZSPSV: computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric 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**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, D is symmetric 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61432,12 +61428,12 @@ module stdlib_linalg_lapack_w subroutine stdlib_wspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & - !> ZSPSVX: uses the diagonal pivoting factorization A = U*D*U**T or - !> A = L*D*L**T to compute the solution to a complex system of linear - !> equations A * X = B, where A is an N-by-N symmetric matrix stored - !> in packed format and X and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZSPSVX: uses the diagonal pivoting factorization A = U*D*U**T or + !! A = L*D*L**T to compute the solution to a complex system of linear + !! equations A * X = B, where A is an N-by-N symmetric matrix stored + !! in packed format and X and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61510,13 +61506,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsptrf( uplo, n, ap, ipiv, info ) - !> ZSPTRF: computes the factorization of a complex symmetric matrix A - !> stored in packed format using the Bunch-Kaufman diagonal pivoting - !> method: - !> 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 symmetric and block diagonal with - !> 1-by-1 and 2-by-2 diagonal blocks. + !! ZSPTRF: computes the factorization of a complex symmetric matrix A + !! stored in packed format using the Bunch-Kaufman diagonal pivoting + !! method: + !! 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 symmetric and block diagonal with + !! 1-by-1 and 2-by-2 diagonal blocks. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61839,9 +61835,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsptri( uplo, n, ap, ipiv, work, info ) - !> ZSPTRI: computes the inverse of a complex symmetric indefinite matrix - !> A in packed storage using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by ZSPTRF. + !! ZSPTRI: computes the inverse of a complex symmetric indefinite matrix + !! A in packed storage using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by ZSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62050,9 +62046,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> ZSPTRS: solves a system of linear equations A*X = B with a complex - !> symmetric matrix A stored in packed format using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by ZSPTRF. + !! ZSPTRS: solves a system of linear equations A*X = B with a complex + !! symmetric matrix A stored in packed format using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by ZSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -62270,17 +62266,17 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wstedc( compz, n, d, e, z, ldz, work, lwork, rwork,lrwork, iwork, & - !> ZSTEDC: computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric tridiagonal matrix using the divide and conquer method. - !> The eigenvectors of a full or band complex Hermitian matrix can also - !> be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this - !> matrix to tridiagonal 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 DLAED3 for details. + !! ZSTEDC: computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric tridiagonal matrix using the divide and conquer method. + !! The eigenvectors of a full or band complex Hermitian matrix can also + !! be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this + !! matrix to tridiagonal 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 DLAED3 for details. liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62484,22 +62480,22 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> ZSTEGR: computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has - !> a well defined set of pairwise different real eigenvalues, the corresponding - !> real eigenvectors are pairwise orthogonal. - !> The spectrum may be computed either completely or partially by specifying - !> either an interval (VL,VU] or a range of indices IL:IU for the desired - !> eigenvalues. - !> ZSTEGR is a compatibility wrapper around the improved ZSTEMR routine. - !> See ZSTEMR for further details. - !> One important change is that the ABSTOL parameter no longer provides any - !> benefit and hence is no longer used. - !> Note : ZSTEGR and ZSTEMR work only on machines which follow - !> IEEE-754 floating-point standard in their handling of infinities and - !> NaNs. Normal execution may create these exceptiona values and hence - !> may abort due to a floating point exception in environments which - !> do not conform to the IEEE-754 standard. + !! ZSTEGR: computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Any such unreduced matrix has + !! a well defined set of pairwise different real eigenvalues, the corresponding + !! real eigenvectors are pairwise orthogonal. + !! The spectrum may be computed either completely or partially by specifying + !! either an interval (VL,VU] or a range of indices IL:IU for the desired + !! eigenvalues. + !! ZSTEGR is a compatibility wrapper around the improved ZSTEMR routine. + !! See ZSTEMR for further details. + !! One important change is that the ABSTOL parameter no longer provides any + !! benefit and hence is no longer used. + !! Note : ZSTEGR and ZSTEMR work only on machines which follow + !! IEEE-754 floating-point standard in their handling of infinities and + !! NaNs. Normal execution may create these exceptiona values and hence + !! may abort due to a floating point exception in environments which + !! do not conform to the IEEE-754 standard. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62526,15 +62522,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & - !> ZSTEIN: computes the eigenvectors of a real symmetric tridiagonal - !> matrix T corresponding to specified eigenvalues, using inverse - !> iteration. - !> The maximum number of iterations allowed for each eigenvector is - !> specified by an internal parameter MAXITS (currently set to 5). - !> Although the eigenvectors are real, they are stored in a complex - !> array, which may be passed to ZUNMTR or ZUPMTR for back - !> transformation to the eigenvectors of a complex Hermitian matrix - !> which was reduced to tridiagonal form. + !! ZSTEIN: computes the eigenvectors of a real symmetric tridiagonal + !! matrix T corresponding to specified eigenvalues, using inverse + !! iteration. + !! The maximum number of iterations allowed for each eigenvector is + !! specified by an internal parameter MAXITS (currently set to 5). + !! Although the eigenvectors are real, they are stored in a complex + !! array, which may be passed to ZUNMTR or ZUPMTR for back + !! transformation to the eigenvectors of a complex Hermitian matrix + !! which was reduced to tridiagonal form. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62736,65 +62732,65 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & - !> ZSTEMR: computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has - !> a well defined set of pairwise different real eigenvalues, the corresponding - !> real eigenvectors are pairwise orthogonal. - !> The spectrum may be computed either completely or partially by specifying - !> either an interval (VL,VU] or a range of indices IL:IU for the desired - !> eigenvalues. - !> Depending on the number of desired eigenvalues, these are computed either - !> by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are - !> computed by the use of various suitable L D L^T factorizations near clusters - !> of close eigenvalues (referred to as RRRs, Relatively Robust - !> Representations). An informal sketch of the algorithm 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. - !> For more details, see: - !> - 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. - !> Further Details - !> 1.ZSTEMR works only on machines which follow IEEE-754 - !> floating-point standard in their handling of infinities and NaNs. - !> This permits the use of efficient inner loops avoiding a check for - !> zero divisors. - !> 2. LAPACK routines can be used to reduce a complex Hermitean matrix to - !> real symmetric tridiagonal form. - !> (Any complex Hermitean tridiagonal matrix has real values on its diagonal - !> and potentially complex numbers on its off-diagonals. By applying a - !> similarity transform with an appropriate diagonal matrix - !> diag(1,e^{i \phy_1}, ... , e^{i \phy_{n-1}}), the complex Hermitean - !> matrix can be transformed into a real symmetric matrix and complex - !> arithmetic can be entirely avoided.) - !> While the eigenvectors of the real symmetric tridiagonal matrix are real, - !> the eigenvectors of original complex Hermitean matrix have complex entries - !> in general. - !> Since LAPACK drivers overwrite the matrix data with the eigenvectors, - !> ZSTEMR accepts complex workspace to facilitate interoperability - !> with ZUNMTR or ZUPMTR. + !! ZSTEMR: computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Any such unreduced matrix has + !! a well defined set of pairwise different real eigenvalues, the corresponding + !! real eigenvectors are pairwise orthogonal. + !! The spectrum may be computed either completely or partially by specifying + !! either an interval (VL,VU] or a range of indices IL:IU for the desired + !! eigenvalues. + !! Depending on the number of desired eigenvalues, these are computed either + !! by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are + !! computed by the use of various suitable L D L^T factorizations near clusters + !! of close eigenvalues (referred to as RRRs, Relatively Robust + !! Representations). An informal sketch of the algorithm 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. + !! For more details, see: + !! - 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. + !! Further Details + !! 1.ZSTEMR works only on machines which follow IEEE-754 + !! floating-point standard in their handling of infinities and NaNs. + !! This permits the use of efficient inner loops avoiding a check for + !! zero divisors. + !! 2. LAPACK routines can be used to reduce a complex Hermitean matrix to + !! real symmetric tridiagonal form. + !! (Any complex Hermitean tridiagonal matrix has real values on its diagonal + !! and potentially complex numbers on its off-diagonals. By applying a + !! similarity transform with an appropriate diagonal matrix + !! diag(1,e^{i \phy_1}, ... , e^{i \phy_{n-1}}), the complex Hermitean + !! matrix can be transformed into a real symmetric matrix and complex + !! arithmetic can be entirely avoided.) + !! While the eigenvectors of the real symmetric tridiagonal matrix are real, + !! the eigenvectors of original complex Hermitean matrix have complex entries + !! in general. + !! Since LAPACK drivers overwrite the matrix data with the eigenvectors, + !! ZSTEMR accepts complex workspace to facilitate interoperability + !! with ZUNMTR or ZUPMTR. isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63170,11 +63166,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsteqr( compz, n, d, e, z, ldz, work, info ) - !> ZSTEQR: computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric tridiagonal matrix using the implicit QL or QR method. - !> The eigenvectors of a full or band complex Hermitian matrix can also - !> be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this - !> matrix to tridiagonal form. + !! ZSTEQR: computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric tridiagonal matrix using the implicit QL or QR method. + !! The eigenvectors of a full or band complex Hermitian matrix can also + !! be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this + !! matrix to tridiagonal form. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63490,11 +63486,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsycon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) - !> ZSYCON: estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex symmetric matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by ZSYTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZSYCON: estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex symmetric matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by ZSYTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63571,11 +63567,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) - !> ZSYCON_ROOK: estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex symmetric matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by ZSYTRF_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))). + !! ZSYCON_ROOK: estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex symmetric matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by ZSYTRF_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))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63653,9 +63649,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsyconv( uplo, way, n, a, lda, ipiv, e, info ) - !> ZSYCONV: converts A given by ZHETRF into L and D or vice-versa. - !> Get nondiagonal elements of D (returned in workspace) and - !> apply or reverse permutation done in TRF. + !! ZSYCONV: converts A given by ZHETRF into L and D or vice-versa. + !! Get nondiagonal elements of D (returned in workspace) and + !! apply or reverse permutation done in TRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63858,23 +63854,23 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsyconvf( uplo, way, n, a, lda, e, ipiv, info ) - !> If parameter WAY = 'C': - !> ZSYCONVF: converts the factorization output format used in - !> ZSYTRF provided on entry in parameter A into the factorization - !> output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored - !> on exit in parameters A and E. It also converts in place details of - !> the intechanges stored in IPIV from the format used in ZSYTRF into - !> the format used in ZSYTRF_RK (or ZSYTRF_BK). - !> If parameter WAY = 'R': - !> ZSYCONVF performs the conversion in reverse direction, i.e. - !> converts the factorization output format used in ZSYTRF_RK - !> (or ZSYTRF_BK) provided on entry in parameters A and E into - !> the factorization output format used in ZSYTRF that is stored - !> on exit in parameter A. It also converts in place details of - !> the intechanges stored in IPIV from the format used in ZSYTRF_RK - !> (or ZSYTRF_BK) into the format used in ZSYTRF. - !> ZSYCONVF can also convert in Hermitian matrix case, i.e. between - !> formats used in ZHETRF and ZHETRF_RK (or ZHETRF_BK). + !! If parameter WAY = 'C': + !! ZSYCONVF: converts the factorization output format used in + !! ZSYTRF provided on entry in parameter A into the factorization + !! output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored + !! on exit in parameters A and E. It also converts in place details of + !! the intechanges stored in IPIV from the format used in ZSYTRF into + !! the format used in ZSYTRF_RK (or ZSYTRF_BK). + !! If parameter WAY = 'R': + !! ZSYCONVF performs the conversion in reverse direction, i.e. + !! converts the factorization output format used in ZSYTRF_RK + !! (or ZSYTRF_BK) provided on entry in parameters A and E into + !! the factorization output format used in ZSYTRF that is stored + !! on exit in parameter A. It also converts in place details of + !! the intechanges stored in IPIV from the format used in ZSYTRF_RK + !! (or ZSYTRF_BK) into the format used in ZSYTRF. + !! ZSYCONVF can also convert in Hermitian matrix case, i.e. between + !! formats used in ZHETRF and ZHETRF_RK (or ZHETRF_BK). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64115,21 +64111,21 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) - !> If parameter WAY = 'C': - !> ZSYCONVF_ROOK: converts the factorization output format used in - !> ZSYTRF_ROOK provided on entry in parameter A into the factorization - !> output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored - !> on exit in parameters A and E. IPIV format for ZSYTRF_ROOK and - !> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted. - !> If parameter WAY = 'R': - !> ZSYCONVF_ROOK performs the conversion in reverse direction, i.e. - !> converts the factorization output format used in ZSYTRF_RK - !> (or ZSYTRF_BK) provided on entry in parameters A and E into - !> the factorization output format used in ZSYTRF_ROOK that is stored - !> on exit in parameter A. IPIV format for ZSYTRF_ROOK and - !> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted. - !> ZSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between - !> formats used in ZHETRF_ROOK and ZHETRF_RK (or ZHETRF_BK). + !! If parameter WAY = 'C': + !! ZSYCONVF_ROOK: converts the factorization output format used in + !! ZSYTRF_ROOK provided on entry in parameter A into the factorization + !! output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored + !! on exit in parameters A and E. IPIV format for ZSYTRF_ROOK and + !! ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted. + !! If parameter WAY = 'R': + !! ZSYCONVF_ROOK performs the conversion in reverse direction, i.e. + !! converts the factorization output format used in ZSYTRF_RK + !! (or ZSYTRF_BK) provided on entry in parameters A and E into + !! the factorization output format used in ZSYTRF_ROOK that is stored + !! on exit in parameter A. IPIV format for ZSYTRF_ROOK and + !! ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted. + !! ZSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between + !! formats used in ZHETRF_ROOK and ZHETRF_RK (or ZHETRF_BK). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64370,13 +64366,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsyequb( uplo, n, a, lda, s, scond, amax, work, info ) - !> ZSYEQUB: computes row and column scalings intended to equilibrate a - !> symmetric 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. + !! ZSYEQUB: computes row and column scalings intended to equilibrate a + !! symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64552,10 +64548,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsymv( uplo, n, alpha, a, lda, x, incx, beta, y, incy ) - !> ZSYMV: performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix. + !! ZSYMV: performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64706,10 +64702,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsyr( uplo, n, alpha, x, incx, a, lda ) - !> ZSYR: performs the symmetric rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a complex scalar, x is an n element vector and A is an - !> n by n symmetric matrix. + !! ZSYR: performs the symmetric rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a complex scalar, x is an n element vector and A is an + !! n by n symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64810,9 +64806,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & - !> ZSYRFS: improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite, and - !> provides error bounds and backward error estimates for the solution. + !! ZSYRFS: improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric indefinite, and + !! provides error bounds and backward error estimates for the solution. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65003,17 +64999,17 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> ZSYSV: computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> The 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 symmetric 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. + !! ZSYSV: computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! The 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 symmetric 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65081,16 +65077,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> ZSYSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> Aasen's algorithm is used to factor A as - !> A = U**T * T * U, if UPLO = 'U', or - !> A = L * T * L**T, if UPLO = 'L', - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and T is symmetric tridiagonal. The factored - !> form of A is then used to solve the system of equations A * X = B. + !! ZSYSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! Aasen's algorithm is used to factor A as + !! A = U**T * T * U, if UPLO = 'U', or + !! A = L * T * L**T, if UPLO = 'L', + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and T is symmetric tridiagonal. The factored + !! form of A is then used to solve the system of equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65153,20 +65149,20 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) - !> ZSYSV_RK: computes the solution to a complex system of linear - !> equations A * X = B, where A is an N-by-N symmetric 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**T)*(P**T), if UPLO = 'U', or - !> A = P*L*D*(L**T)*(P**T), if UPLO = 'L', - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric and block - !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. - !> ZSYTRF_RK is called to compute the factorization of a complex - !> symmetric matrix. The factored form of A is then used to solve - !> the system of equations A * X = B by calling BLAS3 routine ZSYTRS_3. + !! ZSYSV_RK: computes the solution to a complex system of linear + !! equations A * X = B, where A is an N-by-N symmetric 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**T)*(P**T), if UPLO = 'U', or + !! A = P*L*D*(L**T)*(P**T), if UPLO = 'L', + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric and block + !! diagonal with 1-by-1 and 2-by-2 diagonal blocks. + !! ZSYTRF_RK is called to compute the factorization of a complex + !! symmetric matrix. The factored form of A is then used to solve + !! the system of equations A * X = B by calling BLAS3 routine ZSYTRS_3. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65230,22 +65226,22 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> ZSYSV_ROOK: computes the solution to a complex system of linear - !> equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> The 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 symmetric and block diagonal with - !> 1-by-1 and 2-by-2 diagonal blocks. - !> ZSYTRF_ROOK is called to compute the factorization of a complex - !> symmetric 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 ZSYTRS_ROOK. + !! ZSYSV_ROOK: computes the solution to a complex system of linear + !! equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! The 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 symmetric and block diagonal with + !! 1-by-1 and 2-by-2 diagonal blocks. + !! ZSYTRF_ROOK is called to compute the factorization of a complex + !! symmetric 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 ZSYTRS_ROOK. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65309,12 +65305,12 @@ module stdlib_linalg_lapack_w subroutine stdlib_wsysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & - !> ZSYSVX: uses the diagonal pivoting factorization to compute the - !> solution to a complex system of linear equations A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZSYSVX: uses the diagonal pivoting factorization to compute the + !! solution to a complex system of linear equations A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ferr, berr, work, lwork,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65406,8 +65402,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsyswapr( uplo, n, a, lda, i1, i2) - !> ZSYSWAPR: applies an elementary permutation on the rows and the columns of - !> a symmetric matrix. + !! ZSYSWAPR: applies an elementary permutation on the rows and the columns of + !! a symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65474,13 +65470,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsytf2( uplo, n, a, lda, ipiv, info ) - !> ZSYTF2: computes the factorization of a complex symmetric matrix A - !> using the Bunch-Kaufman diagonal pivoting method: - !> 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, U**T is the transpose of U, and D is symmetric 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. + !! ZSYTF2: computes the factorization of a complex symmetric matrix A + !! using the Bunch-Kaufman diagonal pivoting method: + !! 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, U**T is the transpose of U, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -65765,15 +65761,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsytf2_rk( uplo, n, a, lda, e, ipiv, info ) - !> ZSYTF2_RK: computes the factorization of a complex symmetric matrix A - !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric 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. + !! ZSYTF2_RK: computes the factorization of a complex symmetric matrix A + !! using the bounded Bunch-Kaufman (rook) diagonal pivoting method: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -66222,13 +66218,13 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsytf2_rook( uplo, n, a, lda, ipiv, info ) - !> ZSYTF2_ROOK: computes the factorization of a complex symmetric matrix A - !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: - !> 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, U**T is the transpose of U, and D is symmetric 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. + !! ZSYTF2_ROOK: computes the factorization of a complex symmetric matrix A + !! using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: + !! 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, U**T is the transpose of U, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -66638,14 +66634,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsytrf( uplo, n, a, lda, ipiv, work, lwork, info ) - !> ZSYTRF: computes the factorization of a complex symmetric matrix A - !> using the Bunch-Kaufman 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 symmetric 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. + !! ZSYTRF: computes the factorization of a complex symmetric matrix A + !! using the Bunch-Kaufman 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 symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -66764,12 +66760,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) - !> ZSYTRF_AA: computes the factorization of a complex symmetric matrix A - !> using the Aasen's algorithm. The form of the factorization is - !> A = U**T*T*U or A = L*T*L**T - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and T is a complex symmetric tridiagonal matrix. - !> This is the blocked version of the algorithm, calling Level 3 BLAS. + !! ZSYTRF_AA: computes the factorization of a complex symmetric matrix A + !! using the Aasen's algorithm. The form of the factorization is + !! A = U**T*T*U or A = L*T*L**T + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and T is a complex symmetric tridiagonal matrix. + !! This is the blocked version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -66989,15 +66985,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) - !> ZSYTRF_RK: computes the factorization of a complex symmetric matrix A - !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric 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. + !! ZSYTRF_RK: computes the factorization of a complex symmetric matrix A + !! using the bounded Bunch-Kaufman (rook) diagonal pivoting method: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67155,14 +67151,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) - !> ZSYTRF_ROOK: computes the factorization of a complex symmetric 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 symmetric 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. + !! ZSYTRF_ROOK: computes the factorization of a complex symmetric 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 symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67283,9 +67279,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsytri( uplo, n, a, lda, ipiv, work, info ) - !> ZSYTRI: computes the inverse of a complex symmetric indefinite matrix - !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by - !> ZSYTRF. + !! ZSYTRI: computes the inverse of a complex symmetric indefinite matrix + !! A using the factorization A = U*D*U**T or A = L*D*L**T computed by + !! ZSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67471,9 +67467,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsytri_rook( uplo, n, a, lda, ipiv, work, info ) - !> ZSYTRI_ROOK: computes the inverse of a complex symmetric - !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T - !> computed by ZSYTRF_ROOK. + !! ZSYTRI_ROOK: computes the inverse of a complex symmetric + !! matrix A using the factorization A = U*D*U**T or A = L*D*L**T + !! computed by ZSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67699,9 +67695,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) - !> ZSYTRS: solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by ZSYTRF. + !! ZSYTRS: solves a system of linear equations A*X = B with a complex + !! symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by ZSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67909,9 +67905,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) - !> ZSYTRS2: solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by ZSYTRF and converted by ZSYCONV. + !! ZSYTRS2: solves a system of linear equations A*X = B with a complex + !! symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by ZSYTRF and converted by ZSYCONV. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -68087,15 +68083,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) - !> ZSYTRS_3: solves a system of linear equations A * X = B with a complex - !> symmetric matrix A using the factorization computed - !> by ZSYTRF_RK or ZSYTRF_BK: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric and block - !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. - !> This algorithm is using Level 3 BLAS. + !! ZSYTRS_3: solves a system of linear equations A * X = B with a complex + !! symmetric matrix A using the factorization computed + !! by ZSYTRF_RK or ZSYTRF_BK: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric and block + !! diagonal with 1-by-1 and 2-by-2 diagonal blocks. + !! This algorithm is using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -68244,9 +68240,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) - !> ZSYTRS_AA: solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U**T*T*U or - !> A = L*T*L**T computed by ZSYTRF_AA. + !! ZSYTRS_AA: solves a system of linear equations A*X = B with a complex + !! symmetric matrix A using the factorization A = U**T*T*U or + !! A = L*T*L**T computed by ZSYTRF_AA. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68363,9 +68359,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wsytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) - !> ZSYTRS_ROOK: solves a system of linear equations A*X = B with - !> a complex symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by ZSYTRF_ROOK. + !! ZSYTRS_ROOK: solves a system of linear equations A*X = B with + !! a complex symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by ZSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -68585,12 +68581,12 @@ module stdlib_linalg_lapack_w subroutine stdlib_wtbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,rwork, info ) - !> ZTBCON: estimates the reciprocal of the condition number of a - !> triangular band matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! ZTBCON: estimates the reciprocal of the condition number of a + !! triangular band matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68694,12 +68690,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& - !> ZTBRFS: provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular band - !> coefficient matrix. - !> The solution matrix X must be computed by ZTBTRS or some other - !> means before entering this routine. ZTBRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! ZTBRFS: provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular band + !! coefficient matrix. + !! The solution matrix X must be computed by ZTBTRS or some other + !! means before entering this routine. ZTBRFS does not do iterative + !! refinement because doing so cannot improve the backward error. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68937,10 +68933,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) - !> ZTBTRS: solves a triangular system of the form - !> A * X = B, A**T * X = B, or A**H * X = B, - !> where A is a triangular band matrix of order N, and B is an - !> N-by-NRHS matrix. A check is made to verify that A is nonsingular. + !! ZTBTRS: solves a triangular system of the form + !! A * X = B, A**T * X = B, or A**H * X = B, + !! where A is a triangular band matrix of order N, and B is an + !! N-by-NRHS matrix. A check is made to verify that A is nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69010,14 +69006,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) - !> Level 3 BLAS like routine for A in RFP Format. - !> ZTFSM: solves the matrix equation - !> op( A )*X = alpha*B or X*op( A ) = alpha*B - !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**H. - !> A is in Rectangular Full Packed (RFP) Format. - !> The matrix X is overwritten on B. + !! Level 3 BLAS like routine for A in RFP Format. + !! ZTFSM: solves the matrix equation + !! op( A )*X = alpha*B or X*op( A ) = alpha*B + !! where alpha is a scalar, X and B are m by n matrices, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**H. + !! A is in Rectangular Full Packed (RFP) Format. + !! The matrix X is overwritten on B. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69512,9 +69508,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtftri( transr, uplo, diag, n, a, info ) - !> ZTFTRI: computes the inverse of a triangular matrix A stored in RFP - !> format. - !> This is a Level 3 BLAS version of the algorithm. + !! ZTFTRI: computes the inverse of a triangular matrix A stored in RFP + !! format. + !! This is a Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -69695,8 +69691,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtfttp( transr, uplo, n, arf, ap, info ) - !> ZTFTTP: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard packed format (TP). + !! ZTFTTP: copies a triangular matrix A from rectangular full packed + !! format (TF) to standard packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -69954,8 +69950,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtfttr( transr, uplo, n, arf, a, lda, info ) - !> ZTFTTR: copies a triangular matrix A from rectangular full packed - !> format (TF) to standard full format (TR). + !! ZTFTTR: copies a triangular matrix A from rectangular full packed + !! format (TF) to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -70204,24 +70200,24 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & - !> ZTGEVC: computes some or all of the right and/or left eigenvectors of - !> a pair of complex matrices (S,P), where S and P are upper triangular. - !> Matrix pairs of this type are produced by the generalized Schur - !> factorization of a complex matrix pair (A,B): - !> A = Q*S*Z**H, B = Q*P*Z**H - !> as computed by ZGGHRD + ZHGEQZ. - !> The right eigenvector x and the left eigenvector y of (S,P) - !> corresponding to an eigenvalue w are defined by: - !> S*x = w*P*x, (y**H)*S = w*(y**H)*P, - !> where y**H denotes the conjugate tranpose of y. - !> The eigenvalues are not input to this routine, but are computed - !> directly from the diagonal elements of S and P. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of (S,P), or the products Z*X and/or Q*Y, - !> where Z and Q are input matrices. - !> If Q and Z are the unitary factors from the generalized Schur - !> factorization of a matrix pair (A,B), then Z*X and Q*Y - !> are the matrices of right and left eigenvectors of (A,B). + !! ZTGEVC: computes some or all of the right and/or left eigenvectors of + !! a pair of complex matrices (S,P), where S and P are upper triangular. + !! Matrix pairs of this type are produced by the generalized Schur + !! factorization of a complex matrix pair (A,B): + !! A = Q*S*Z**H, B = Q*P*Z**H + !! as computed by ZGGHRD + ZHGEQZ. + !! The right eigenvector x and the left eigenvector y of (S,P) + !! corresponding to an eigenvalue w are defined by: + !! S*x = w*P*x, (y**H)*S = w*(y**H)*P, + !! where y**H denotes the conjugate tranpose of y. + !! The eigenvalues are not input to this routine, but are computed + !! directly from the diagonal elements of S and P. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of (S,P), or the products Z*X and/or Q*Y, + !! where Z and Q are input matrices. + !! If Q and Z are the unitary factors from the generalized Schur + !! factorization of a matrix pair (A,B), then Z*X and Q*Y + !! are the matrices of right and left eigenvectors of (A,B). mm, m, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70617,15 +70613,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, info ) - !> ZTGEX2: swaps adjacent diagonal 1 by 1 blocks (A11,B11) and (A22,B22) - !> in an upper triangular matrix pair (A, B) by an unitary equivalence - !> transformation. - !> (A, B) must be in generalized Schur canonical form, that is, A and - !> B are both upper triangular. - !> Optionally, the matrices Q and Z of generalized Schur vectors are - !> updated. - !> Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H - !> Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H + !! ZTGEX2: swaps adjacent diagonal 1 by 1 blocks (A11,B11) and (A22,B22) + !! in an upper triangular matrix pair (A, B) by an unitary equivalence + !! transformation. + !! (A, B) must be in generalized Schur canonical form, that is, A and + !! B are both upper triangular. + !! Optionally, the matrices Q and Z of generalized Schur vectors are + !! updated. + !! Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H + !! Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70759,16 +70755,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & - !> ZTGEXC: reorders the generalized Schur decomposition of a complex - !> matrix pair (A,B), using an unitary equivalence transformation - !> (A, B) := Q * (A, B) * Z**H, so that the diagonal block of (A, B) with - !> row index IFST is moved to row ILST. - !> (A, B) must be in generalized Schur canonical form, that is, A and - !> B are both upper triangular. - !> Optionally, the matrices Q and Z of generalized Schur vectors are - !> updated. - !> Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H - !> Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H + !! ZTGEXC: reorders the generalized Schur decomposition of a complex + !! matrix pair (A,B), using an unitary equivalence transformation + !! (A, B) := Q * (A, B) * Z**H, so that the diagonal block of (A, B) with + !! row index IFST is moved to row ILST. + !! (A, B) must be in generalized Schur canonical form, that is, A and + !! B are both upper triangular. + !! Optionally, the matrices Q and Z of generalized Schur vectors are + !! updated. + !! Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H + !! Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70843,24 +70839,24 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alpha, beta, q, & - !> ZTGSEN: reorders the generalized Schur decomposition of a complex - !> matrix pair (A, B) (in terms of an unitary equivalence trans- - !> formation Q**H * (A, B) * Z), so that a selected cluster of eigenvalues - !> appears in the leading diagonal blocks of the pair (A,B). The leading - !> columns of Q and Z form unitary bases of the corresponding left and - !> right eigenspaces (deflating subspaces). (A, B) must be in - !> generalized Schur canonical form, that is, A and B are both upper - !> triangular. - !> ZTGSEN also computes the generalized eigenvalues - !> w(j)= ALPHA(j) / BETA(j) - !> of the reordered matrix pair (A, B). - !> Optionally, the routine computes estimates of reciprocal condition - !> numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11), - !> (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s) - !> between the matrix pairs (A11, B11) and (A22,B22) that correspond to - !> the selected cluster and the eigenvalues outside the cluster, resp., - !> and norms of "projections" onto left and right eigenspaces w.r.t. - !> the selected cluster in the (1,1)-block. + !! ZTGSEN: reorders the generalized Schur decomposition of a complex + !! matrix pair (A, B) (in terms of an unitary equivalence trans- + !! formation Q**H * (A, B) * Z), so that a selected cluster of eigenvalues + !! appears in the leading diagonal blocks of the pair (A,B). The leading + !! columns of Q and Z form unitary bases of the corresponding left and + !! right eigenspaces (deflating subspaces). (A, B) must be in + !! generalized Schur canonical form, that is, A and B are both upper + !! triangular. + !! ZTGSEN also computes the generalized eigenvalues + !! w(j)= ALPHA(j) / BETA(j) + !! of the reordered matrix pair (A, B). + !! Optionally, the routine computes estimates of reciprocal condition + !! numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11), + !! (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s) + !! between the matrix pairs (A11, B11) and (A22,B22) that correspond to + !! the selected cluster and the eigenvalues outside the cluster, resp., + !! and norms of "projections" onto left and right eigenspaces w.r.t. + !! the selected cluster in the (1,1)-block. ldq, z, ldz, m, pl, pr, dif,work, lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71122,68 +71118,68 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & - !> ZTGSJA: computes the generalized singular value decomposition (GSVD) - !> of two complex upper triangular (or trapezoidal) matrices A and B. - !> On entry, it is assumed that matrices A and B have the following - !> forms, which may be obtained by the preprocessing subroutine ZGGSVP - !> from a general M-by-N matrix A and P-by-N matrix B: - !> N-K-L K L - !> A = K ( 0 A12 A13 ) if M-K-L >= 0; - !> L ( 0 0 A23 ) - !> M-K-L ( 0 0 0 ) - !> N-K-L K L - !> A = K ( 0 A12 A13 ) if M-K-L < 0; - !> M-K ( 0 0 A23 ) - !> N-K-L K L - !> B = L ( 0 0 B13 ) - !> P-L ( 0 0 0 ) - !> where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular - !> upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, - !> otherwise A23 is (M-K)-by-L upper trapezoidal. - !> On exit, - !> U**H *A*Q = D1*( 0 R ), V**H *B*Q = D2*( 0 R ), - !> where U, V and Q are unitary matrices. - !> R is a nonsingular upper triangular matrix, and D1 - !> and D2 are ``diagonal'' matrices, which are of the following - !> structures: - !> If M-K-L >= 0, - !> K L - !> D1 = K ( I 0 ) - !> L ( 0 C ) - !> M-K-L ( 0 0 ) - !> K L - !> D2 = L ( 0 S ) - !> P-L ( 0 0 ) - !> N-K-L K L - !> ( 0 R ) = K ( 0 R11 R12 ) K - !> L ( 0 0 R22 ) L - !> where - !> C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), - !> S = diag( BETA(K+1), ... , BETA(K+L) ), - !> C**2 + S**2 = I. - !> R is stored in A(1:K+L,N-K-L+1:N) on exit. - !> If M-K-L < 0, - !> K M-K K+L-M - !> D1 = K ( I 0 0 ) - !> M-K ( 0 C 0 ) - !> K M-K K+L-M - !> D2 = M-K ( 0 S 0 ) - !> K+L-M ( 0 0 I ) - !> P-L ( 0 0 0 ) - !> N-K-L K M-K K+L-M - !> ( 0 R ) = K ( 0 R11 R12 R13 ) - !> M-K ( 0 0 R22 R23 ) - !> K+L-M ( 0 0 0 R33 ) - !> where - !> C = diag( ALPHA(K+1), ... , ALPHA(M) ), - !> S = diag( BETA(K+1), ... , BETA(M) ), - !> C**2 + S**2 = I. - !> R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored - !> ( 0 R22 R23 ) - !> in B(M-K+1:L,N+M-K-L+1:N) on exit. - !> The computation of the unitary transformation matrices U, V or Q - !> is optional. These matrices may either be formed explicitly, or they - !> may be postmultiplied into input matrices U1, V1, or Q1. + !! ZTGSJA: computes the generalized singular value decomposition (GSVD) + !! of two complex upper triangular (or trapezoidal) matrices A and B. + !! On entry, it is assumed that matrices A and B have the following + !! forms, which may be obtained by the preprocessing subroutine ZGGSVP + !! from a general M-by-N matrix A and P-by-N matrix B: + !! N-K-L K L + !! A = K ( 0 A12 A13 ) if M-K-L >= 0; + !! L ( 0 0 A23 ) + !! M-K-L ( 0 0 0 ) + !! N-K-L K L + !! A = K ( 0 A12 A13 ) if M-K-L < 0; + !! M-K ( 0 0 A23 ) + !! N-K-L K L + !! B = L ( 0 0 B13 ) + !! P-L ( 0 0 0 ) + !! where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular + !! upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, + !! otherwise A23 is (M-K)-by-L upper trapezoidal. + !! On exit, + !! U**H *A*Q = D1*( 0 R ), V**H *B*Q = D2*( 0 R ), + !! where U, V and Q are unitary matrices. + !! R is a nonsingular upper triangular matrix, and D1 + !! and D2 are ``diagonal'' matrices, which are of the following + !! structures: + !! If M-K-L >= 0, + !! K L + !! D1 = K ( I 0 ) + !! L ( 0 C ) + !! M-K-L ( 0 0 ) + !! K L + !! D2 = L ( 0 S ) + !! P-L ( 0 0 ) + !! N-K-L K L + !! ( 0 R ) = K ( 0 R11 R12 ) K + !! L ( 0 0 R22 ) L + !! where + !! C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), + !! S = diag( BETA(K+1), ... , BETA(K+L) ), + !! C**2 + S**2 = I. + !! R is stored in A(1:K+L,N-K-L+1:N) on exit. + !! If M-K-L < 0, + !! K M-K K+L-M + !! D1 = K ( I 0 0 ) + !! M-K ( 0 C 0 ) + !! K M-K K+L-M + !! D2 = M-K ( 0 S 0 ) + !! K+L-M ( 0 0 I ) + !! P-L ( 0 0 0 ) + !! N-K-L K M-K K+L-M + !! ( 0 R ) = K ( 0 R11 R12 R13 ) + !! M-K ( 0 0 R22 R23 ) + !! K+L-M ( 0 0 0 R33 ) + !! where + !! C = diag( ALPHA(K+1), ... , ALPHA(M) ), + !! S = diag( BETA(K+1), ... , BETA(M) ), + !! C**2 + S**2 = I. + !! R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored + !! ( 0 R22 R23 ) + !! in B(M-K+1:L,N+M-K-L+1:N) on exit. + !! The computation of the unitary transformation matrices U, V or Q + !! is optional. These matrices may either be formed explicitly, or they + !! may be postmultiplied into input matrices U1, V1, or Q1. alpha, beta, u, ldu, v, ldv,q, ldq, work, ncycle, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71371,10 +71367,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & - !> ZTGSNA: estimates reciprocal condition numbers for specified - !> eigenvalues and/or eigenvectors of a matrix pair (A, B). - !> (A, B) must be in generalized Schur canonical form, that is, A and - !> B are both upper triangular. + !! ZTGSNA: estimates reciprocal condition numbers for specified + !! eigenvalues and/or eigenvectors of a matrix pair (A, B). + !! (A, B) must be in generalized Schur canonical form, that is, A and + !! B are both upper triangular. dif, mm, m, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71528,31 +71524,31 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & - !> ZTGSY2: solves the generalized Sylvester equation - !> A * R - L * B = scale * C (1) - !> D * R - L * E = scale * F - !> using Level 1 and 2 BLAS, where R and L are unknown M-by-N matrices, - !> (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M, - !> N-by-N and M-by-N, respectively. A, B, D and E are upper triangular - !> (i.e., (A,D) and (B,E) in generalized Schur form). - !> The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output - !> scaling factor chosen to avoid overflow. - !> In matrix notation solving equation (1) corresponds to solve - !> Zx = scale * b, where Z is defined as - !> Z = [ kron(In, A) -kron(B**H, Im) ] (2) - !> [ kron(In, D) -kron(E**H, Im) ], - !> Ik is the identity matrix of size k and X**H is the conjuguate transpose of X. - !> kron(X, Y) is the Kronecker product between the matrices X and Y. - !> If TRANS = 'C', y in the conjugate transposed system Z**H*y = scale*b - !> is solved for, which is equivalent to solve for R and L in - !> A**H * R + D**H * L = scale * C (3) - !> R * B**H + L * E**H = scale * -F - !> This case is used to compute an estimate of Dif[(A, D), (B, E)] = - !> = sigma_min(Z) using reverse communication with ZLACON. - !> ZTGSY2 also (IJOB >= 1) contributes to the computation in ZTGSYL - !> of an upper bound on the separation between to matrix pairs. Then - !> the input (A, D), (B, E) are sub-pencils of two matrix pairs in - !> ZTGSYL. + !! ZTGSY2: solves the generalized Sylvester equation + !! A * R - L * B = scale * C (1) + !! D * R - L * E = scale * F + !! using Level 1 and 2 BLAS, where R and L are unknown M-by-N matrices, + !! (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M, + !! N-by-N and M-by-N, respectively. A, B, D and E are upper triangular + !! (i.e., (A,D) and (B,E) in generalized Schur form). + !! The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output + !! scaling factor chosen to avoid overflow. + !! In matrix notation solving equation (1) corresponds to solve + !! Zx = scale * b, where Z is defined as + !! Z = [ kron(In, A) -kron(B**H, Im) ] (2) + !! [ kron(In, D) -kron(E**H, Im) ], + !! Ik is the identity matrix of size k and X**H is the conjuguate transpose of X. + !! kron(X, Y) is the Kronecker product between the matrices X and Y. + !! If TRANS = 'C', y in the conjugate transposed system Z**H*y = scale*b + !! is solved for, which is equivalent to solve for R and L in + !! A**H * R + D**H * L = scale * C (3) + !! R * B**H + L * E**H = scale * -F + !! This case is used to compute an estimate of Dif[(A, D), (B, E)] = + !! = sigma_min(Z) using reverse communication with ZLACON. + !! ZTGSY2 also (IJOB >= 1) contributes to the computation in ZTGSYL + !! of an upper bound on the separation between to matrix pairs. Then + !! the input (A, D), (B, E) are sub-pencils of two matrix pairs in + !! ZTGSYL. ldf, scale, rdsum, rdscal,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71718,33 +71714,33 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & - !> ZTGSYL: solves the generalized Sylvester equation: - !> A * R - L * B = scale * C (1) - !> D * R - L * E = scale * F - !> where R and L are unknown m-by-n matrices, (A, D), (B, E) and - !> (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n, - !> respectively, with complex entries. A, B, D and E are upper - !> triangular (i.e., (A,D) and (B,E) in generalized Schur form). - !> The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 - !> is an output scaling factor chosen to avoid overflow. - !> In matrix notation (1) is equivalent to solve Zx = scale*b, where Z - !> is defined as - !> Z = [ kron(In, A) -kron(B**H, Im) ] (2) - !> [ kron(In, D) -kron(E**H, Im) ], - !> Here Ix is the identity matrix of size x and X**H is the conjugate - !> transpose of X. Kron(X, Y) is the Kronecker product between the - !> matrices X and Y. - !> If TRANS = 'C', y in the conjugate transposed system Z**H *y = scale*b - !> is solved for, which is equivalent to solve for R and L in - !> A**H * R + D**H * L = scale * C (3) - !> R * B**H + L * E**H = scale * -F - !> This case (TRANS = 'C') is used to compute an one-norm-based estimate - !> of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D) - !> and (B,E), using ZLACON. - !> If IJOB >= 1, ZTGSYL computes a Frobenius norm-based estimate of - !> Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the - !> reciprocal of the smallest singular value of Z. - !> This is a level-3 BLAS algorithm. + !! ZTGSYL: solves the generalized Sylvester equation: + !! A * R - L * B = scale * C (1) + !! D * R - L * E = scale * F + !! where R and L are unknown m-by-n matrices, (A, D), (B, E) and + !! (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n, + !! respectively, with complex entries. A, B, D and E are upper + !! triangular (i.e., (A,D) and (B,E) in generalized Schur form). + !! The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 + !! is an output scaling factor chosen to avoid overflow. + !! In matrix notation (1) is equivalent to solve Zx = scale*b, where Z + !! is defined as + !! Z = [ kron(In, A) -kron(B**H, Im) ] (2) + !! [ kron(In, D) -kron(E**H, Im) ], + !! Here Ix is the identity matrix of size x and X**H is the conjugate + !! transpose of X. Kron(X, Y) is the Kronecker product between the + !! matrices X and Y. + !! If TRANS = 'C', y in the conjugate transposed system Z**H *y = scale*b + !! is solved for, which is equivalent to solve for R and L in + !! A**H * R + D**H * L = scale * C (3) + !! R * B**H + L * E**H = scale * -F + !! This case (TRANS = 'C') is used to compute an one-norm-based estimate + !! of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D) + !! and (B,E), using ZLACON. + !! If IJOB >= 1, ZTGSYL computes a Frobenius norm-based estimate of + !! Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the + !! reciprocal of the smallest singular value of Z. + !! This is a level-3 BLAS algorithm. ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72068,12 +72064,12 @@ module stdlib_linalg_lapack_w subroutine stdlib_wtpcon( norm, uplo, diag, n, ap, rcond, work, rwork,info ) - !> ZTPCON: estimates the reciprocal of the condition number of a packed - !> triangular matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! ZTPCON: estimates the reciprocal of the condition number of a packed + !! triangular matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72172,10 +72168,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) - !> ZTPLQT: computes a blocked LQ factorization of a complex - !> "triangular-pentagonal" matrix C, which is composed of a - !> triangular block A and pentagonal block B, using the compact - !> WY representation for Q. + !! ZTPLQT: computes a blocked LQ factorization of a complex + !! "triangular-pentagonal" matrix C, which is composed of a + !! triangular block A and pentagonal block B, using the compact + !! WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72234,9 +72230,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) - !> ZTPLQT2: computes a LQ a factorization of a complex "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. + !! ZTPLQT2: computes a LQ a factorization of a complex "triangular-pentagonal" + !! matrix C, which is composed of a triangular block A and pentagonal block B, + !! using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72350,9 +72346,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, ldb, & - !> ZTPMLQT: applies a complex unitary matrix Q obtained from a - !> "triangular-pentagonal" complex block reflector H to a general - !> complex matrix C, which consists of two blocks A and B. + !! ZTPMLQT: applies a complex unitary matrix Q obtained from a + !! "triangular-pentagonal" complex block reflector H to a general + !! complex matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72468,9 +72464,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, ldb, & - !> ZTPMQRT: applies a complex orthogonal matrix Q obtained from a - !> "triangular-pentagonal" complex block reflector H to a general - !> complex matrix C, which consists of two blocks A and B. + !! ZTPMQRT: applies a complex orthogonal matrix Q obtained from a + !! "triangular-pentagonal" complex block reflector H to a general + !! complex matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72588,10 +72584,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) - !> ZTPQRT: computes a blocked QR factorization of a complex - !> "triangular-pentagonal" matrix C, which is composed of a - !> triangular block A and pentagonal block B, using the compact - !> WY representation for Q. + !! ZTPQRT: computes a blocked QR factorization of a complex + !! "triangular-pentagonal" matrix C, which is composed of a + !! triangular block A and pentagonal block B, using the compact + !! WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72650,9 +72646,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) - !> ZTPQRT2: computes a QR factorization of a complex "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. + !! ZTPQRT2: computes a QR factorization of a complex "triangular-pentagonal" + !! matrix C, which is composed of a triangular block A and pentagonal block B, + !! using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72741,9 +72737,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & - !> ZTPRFB: applies a complex "triangular-pentagonal" block reflector H or its - !> conjugate transpose H**H to a complex matrix C, which is composed of two - !> blocks A and B, either from the left or right. + !! ZTPRFB: applies a complex "triangular-pentagonal" block reflector H or its + !! conjugate transpose H**H to a complex matrix C, which is composed of two + !! blocks A and B, either from the left or right. lda, b, ldb, work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73161,12 +73157,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & - !> ZTPRFS: provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular packed - !> coefficient matrix. - !> The solution matrix X must be computed by ZTPTRS or some other - !> means before entering this routine. ZTPRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! ZTPRFS: provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular packed + !! coefficient matrix. + !! The solution matrix X must be computed by ZTPTRS or some other + !! means before entering this routine. ZTPRFS does not do iterative + !! refinement because doing so cannot improve the backward error. work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73412,8 +73408,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtptri( uplo, diag, n, ap, info ) - !> ZTPTRI: computes the inverse of a complex upper or lower triangular - !> matrix A stored in packed format. + !! ZTPTRI: computes the inverse of a complex upper or lower triangular + !! matrix A stored in packed format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73502,11 +73498,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) - !> ZTPTRS: solves a triangular system of the form - !> A * X = B, A**T * X = B, or A**H * X = B, - !> where A is a triangular matrix of order N stored in packed format, - !> and B is an N-by-NRHS matrix. A check is made to verify that A is - !> nonsingular. + !! ZTPTRS: solves a triangular system of the form + !! A * X = B, A**T * X = B, or A**H * X = B, + !! where A is a triangular matrix of order N stored in packed format, + !! and B is an N-by-NRHS matrix. A check is made to verify that A is + !! nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73575,8 +73571,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtpttf( transr, uplo, n, ap, arf, info ) - !> ZTPTTF: copies a triangular matrix A from standard packed format (TP) - !> to rectangular full packed format (TF). + !! ZTPTTF: copies a triangular matrix A from standard packed format (TP) + !! to rectangular full packed format (TF). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73833,8 +73829,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtpttr( uplo, n, ap, a, lda, info ) - !> ZTPTTR: copies a triangular matrix A from standard packed format (TP) - !> to standard full format (TR). + !! ZTPTTR: copies a triangular matrix A from standard packed format (TP) + !! to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73887,12 +73883,12 @@ module stdlib_linalg_lapack_w subroutine stdlib_wtrcon( norm, uplo, diag, n, a, lda, rcond, work,rwork, info ) - !> ZTRCON: estimates the reciprocal of the condition number of a - !> triangular matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! ZTRCON: estimates the reciprocal of the condition number of a + !! triangular matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -73993,21 +73989,21 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & - !> ZTREVC: computes some or all of the right and/or left eigenvectors of - !> a complex upper triangular matrix T. - !> Matrices of this type are produced by the Schur factorization of - !> a complex general matrix: A = Q*T*Q**H, as computed by ZHSEQR. - !> The right eigenvector x and the left eigenvector y of T corresponding - !> to an eigenvalue w are defined by: - !> T*x = w*x, (y**H)*T = w*(y**H) - !> where y**H denotes the conjugate transpose of the vector y. - !> The eigenvalues are not input to this routine, but are read directly - !> from the diagonal of T. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an - !> input matrix. If Q is the unitary factor that reduces a matrix A to - !> Schur form T, then Q*X and Q*Y are the matrices of right and left - !> eigenvectors of A. + !! ZTREVC: computes some or all of the right and/or left eigenvectors of + !! a complex upper triangular matrix T. + !! Matrices of this type are produced by the Schur factorization of + !! a complex general matrix: A = Q*T*Q**H, as computed by ZHSEQR. + !! The right eigenvector x and the left eigenvector y of T corresponding + !! to an eigenvalue w are defined by: + !! T*x = w*x, (y**H)*T = w*(y**H) + !! where y**H denotes the conjugate transpose of the vector y. + !! The eigenvalues are not input to this routine, but are read directly + !! from the diagonal of T. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an + !! input matrix. If Q is the unitary factor that reduces a matrix A to + !! Schur form T, then Q*X and Q*Y are the matrices of right and left + !! eigenvectors of A. work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74193,22 +74189,22 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtrevc3( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & - !> ZTREVC3: computes some or all of the right and/or left eigenvectors of - !> a complex upper triangular matrix T. - !> Matrices of this type are produced by the Schur factorization of - !> a complex general matrix: A = Q*T*Q**H, as computed by ZHSEQR. - !> The right eigenvector x and the left eigenvector y of T corresponding - !> to an eigenvalue w are defined by: - !> T*x = w*x, (y**H)*T = w*(y**H) - !> where y**H denotes the conjugate transpose of the vector y. - !> The eigenvalues are not input to this routine, but are read directly - !> from the diagonal of T. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an - !> input matrix. If Q is the unitary factor that reduces a matrix A to - !> Schur form T, then Q*X and Q*Y are the matrices of right and left - !> eigenvectors of A. - !> This uses a Level 3 BLAS version of the back transformation. + !! ZTREVC3: computes some or all of the right and/or left eigenvectors of + !! a complex upper triangular matrix T. + !! Matrices of this type are produced by the Schur factorization of + !! a complex general matrix: A = Q*T*Q**H, as computed by ZHSEQR. + !! The right eigenvector x and the left eigenvector y of T corresponding + !! to an eigenvalue w are defined by: + !! T*x = w*x, (y**H)*T = w*(y**H) + !! where y**H denotes the conjugate transpose of the vector y. + !! The eigenvalues are not input to this routine, but are read directly + !! from the diagonal of T. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an + !! input matrix. If Q is the unitary factor that reduces a matrix A to + !! Schur form T, then Q*X and Q*Y are the matrices of right and left + !! eigenvectors of A. + !! This uses a Level 3 BLAS version of the back transformation. work, lwork, rwork, lrwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74490,12 +74486,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtrexc( compq, n, t, ldt, q, ldq, ifst, ilst, info ) - !> ZTREXC: reorders the Schur factorization of a complex matrix - !> A = Q*T*Q**H, so that the diagonal element of T with row index IFST - !> is moved to row ILST. - !> The Schur form T is reordered by a unitary similarity transformation - !> Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by - !> postmultplying it with Z. + !! ZTREXC: reorders the Schur factorization of a complex matrix + !! A = Q*T*Q**H, so that the diagonal element of T with row index IFST + !! is moved to row ILST. + !! The Schur form T is reordered by a unitary similarity transformation + !! Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by + !! postmultplying it with Z. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -74569,12 +74565,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& - !> ZTRRFS: provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular - !> coefficient matrix. - !> The solution matrix X must be computed by ZTRTRS or some other - !> means before entering this routine. ZTRRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! ZTRRFS: provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular + !! coefficient matrix. + !! The solution matrix X must be computed by ZTRTRS or some other + !! means before entering this routine. ZTRRFS does not do iterative + !! refinement because doing so cannot improve the backward error. work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74810,13 +74806,13 @@ module stdlib_linalg_lapack_w subroutine stdlib_wtrsen( job, compq, select, n, t, ldt, q, ldq, w, m, s,sep, work, lwork, & - !> ZTRSEN: reorders the Schur factorization of a complex matrix - !> A = Q*T*Q**H, so that a selected cluster of eigenvalues appears in - !> the leading positions on the diagonal of the upper triangular matrix - !> T, and the leading columns of Q form an orthonormal basis of the - !> corresponding right invariant subspace. - !> Optionally the routine computes the reciprocal condition numbers of - !> the cluster of eigenvalues and/or the invariant subspace. + !! ZTRSEN: reorders the Schur factorization of a complex matrix + !! A = Q*T*Q**H, so that a selected cluster of eigenvalues appears in + !! the leading positions on the diagonal of the upper triangular matrix + !! T, and the leading columns of Q form an orthonormal basis of the + !! corresponding right invariant subspace. + !! Optionally the routine computes the reciprocal condition numbers of + !! the cluster of eigenvalues and/or the invariant subspace. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74947,9 +74943,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtrsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm,& - !> ZTRSNA: estimates reciprocal condition numbers for specified - !> eigenvalues and/or right eigenvectors of a complex upper triangular - !> matrix T (or of any matrix Q*T*Q**H with Q unitary). + !! ZTRSNA: estimates reciprocal condition numbers for specified + !! eigenvalues and/or right eigenvectors of a complex upper triangular + !! matrix T (or of any matrix Q*T*Q**H with Q unitary). m, work, ldwork, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75096,13 +75092,13 @@ module stdlib_linalg_lapack_w subroutine stdlib_wtrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) - !> ZTRSYL: solves the complex Sylvester matrix equation: - !> op(A)*X + X*op(B) = scale*C or - !> op(A)*X - X*op(B) = scale*C, - !> where op(A) = A or A**H, and A and B are both upper triangular. A is - !> M-by-M and B is N-by-N; the right hand side C and the solution X are - !> M-by-N; and scale is an output scale factor, set <= 1 to avoid - !> overflow in X. + !! ZTRSYL: solves the complex Sylvester matrix equation: + !! op(A)*X + X*op(B) = scale*C or + !! op(A)*X - X*op(B) = scale*C, + !! where op(A) = A or A**H, and A and B are both upper triangular. A is + !! M-by-M and B is N-by-N; the right hand side C and the solution X are + !! M-by-N; and scale is an output scale factor, set <= 1 to avoid + !! overflow in X. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75322,9 +75318,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtrti2( uplo, diag, n, a, lda, info ) - !> ZTRTI2: computes the inverse of a complex upper or lower triangular - !> matrix. - !> This is the Level 2 BLAS version of the algorithm. + !! ZTRTI2: computes the inverse of a complex upper or lower triangular + !! matrix. + !! This is the Level 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -75396,9 +75392,9 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtrtri( uplo, diag, n, a, lda, info ) - !> ZTRTRI: computes the inverse of a complex upper or lower triangular - !> matrix A. - !> This is the Level 3 BLAS version of the algorithm. + !! ZTRTRI: computes the inverse of a complex upper or lower triangular + !! matrix A. + !! This is the Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -75483,10 +75479,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) - !> ZTRTRS: solves a triangular system of the form - !> A * X = B, A**T * X = B, or A**H * X = B, - !> where A is a triangular matrix of order N, and B is an N-by-NRHS - !> matrix. A check is made to verify that A is nonsingular. + !! ZTRTRS: solves a triangular system of the form + !! A * X = B, A**T * X = B, or A**H * X = B, + !! where A is a triangular matrix of order N, and B is an N-by-NRHS + !! matrix. A check is made to verify that A is nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -75543,8 +75539,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtrttf( transr, uplo, n, a, lda, arf, info ) - !> ZTRTTF: copies a triangular matrix A from standard full format (TR) - !> to rectangular full packed format (TF) . + !! ZTRTTF: copies a triangular matrix A from standard full format (TR) + !! to rectangular full packed format (TF) . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -75792,8 +75788,8 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtrttp( uplo, n, a, lda, ap, info ) - !> ZTRTTP: copies a triangular matrix A from full format (TR) to standard - !> packed format (TP). + !! ZTRTTP: copies a triangular matrix A from full format (TR) to standard + !! packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -75846,12 +75842,12 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wtzrzf( m, n, a, lda, tau, work, lwork, info ) - !> ZTZRZF: reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A - !> to upper triangular form by means of unitary transformations. - !> The upper trapezoidal matrix A is factored as - !> A = ( R 0 ) * Z, - !> where Z is an N-by-N unitary matrix and R is an M-by-M upper - !> triangular matrix. + !! ZTZRZF: reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A + !! to upper triangular form by means of unitary transformations. + !! The upper trapezoidal matrix A is factored as + !! A = ( R 0 ) * Z, + !! where Z is an N-by-N unitary matrix and R is an M-by-M upper + !! triangular matrix. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -75962,22 +75958,22 @@ module stdlib_linalg_lapack_w subroutine stdlib_wunbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & - !> ZUNBDB: simultaneously bidiagonalizes the blocks of an M-by-M - !> partitioned unitary matrix X: - !> [ B11 | B12 0 0 ] - !> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**H - !> X = [-----------] = [---------] [----------------] [---------] . - !> [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] - !> [ 0 | 0 0 I ] - !> X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is - !> not the case, then X must be transposed and/or permuted. This can be - !> done in constant time using the TRANS and SIGNS options. See ZUNCSD - !> for details.) - !> The unitary matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- - !> (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are - !> represented implicitly by Householder vectors. - !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! ZUNBDB: simultaneously bidiagonalizes the blocks of an M-by-M + !! partitioned unitary matrix X: + !! [ B11 | B12 0 0 ] + !! [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**H + !! X = [-----------] = [---------] [----------------] [---------] . + !! [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] + !! [ 0 | 0 0 I ] + !! X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is + !! not the case, then X must be transposed and/or permuted. This can be + !! done in constant time using the TRANS and SIGNS options. See ZUNCSD + !! for details.) + !! The unitary matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- + !! (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are + !! represented implicitly by Householder vectors. + !! B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented + !! implicitly by angles THETA, PHI. ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76285,21 +76281,21 @@ module stdlib_linalg_lapack_w subroutine stdlib_wunbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> ZUNBDB1: simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, - !> M-P, or M-Q. Routines ZUNBDB2, ZUNBDB3, and ZUNBDB4 handle cases in - !> which Q is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! ZUNBDB1: simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, + !! M-P, or M-Q. Routines ZUNBDB2, ZUNBDB3, and ZUNBDB4 handle cases in + !! which Q is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by + !! angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76390,21 +76386,21 @@ module stdlib_linalg_lapack_w subroutine stdlib_wunbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> ZUNBDB2: simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, - !> Q, or M-Q. Routines ZUNBDB1, ZUNBDB3, and ZUNBDB4 handle cases in - !> which P is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! ZUNBDB2: simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, + !! Q, or M-Q. Routines ZUNBDB1, ZUNBDB3, and ZUNBDB4 handle cases in + !! which P is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are P-by-P bidiagonal matrices represented implicitly by + !! angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76505,21 +76501,21 @@ module stdlib_linalg_lapack_w subroutine stdlib_wunbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> ZUNBDB3: simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, - !> Q, or M-Q. Routines ZUNBDB1, ZUNBDB2, and ZUNBDB4 handle cases in - !> which M-P is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! ZUNBDB3: simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, + !! Q, or M-Q. Routines ZUNBDB1, ZUNBDB2, and ZUNBDB4 handle cases in + !! which M-P is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76619,21 +76615,21 @@ module stdlib_linalg_lapack_w subroutine stdlib_wunbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> ZUNBDB4: simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, - !> M-P, or Q. Routines ZUNBDB1, ZUNBDB2, and ZUNBDB3 handle cases in - !> which M-Q is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! ZUNBDB4: simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, + !! M-P, or Q. Routines ZUNBDB1, ZUNBDB2, and ZUNBDB3 handle cases in + !! which M-Q is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76768,17 +76764,17 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & - !> ZUNBDB5: orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then some other vector from the orthogonal complement - !> is returned. This vector is chosen in an arbitrary but deterministic - !> way. + !! ZUNBDB5: orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then some other vector from the orthogonal complement + !! is returned. This vector is chosen in an arbitrary but deterministic + !! way. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76867,15 +76863,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & - !> ZUNBDB6: orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then the zero vector is returned. + !! ZUNBDB6: orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then the zero vector is returned. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76995,19 +76991,19 @@ module stdlib_linalg_lapack_w recursive subroutine stdlib_wuncsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & - !> ZUNCSD: computes the CS decomposition of an M-by-M partitioned - !> unitary matrix X: - !> [ I 0 0 | 0 0 0 ] - !> [ 0 C 0 | 0 -S 0 ] - !> [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**H - !> X = [-----------] = [---------] [---------------------] [---------] . - !> [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] - !> [ 0 S 0 | 0 C 0 ] - !> [ 0 0 I | 0 0 0 ] - !> X11 is P-by-Q. The unitary matrices U1, U2, V1, and V2 are P-by-P, - !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are - !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in - !> which R = MIN(P,M-P,Q,M-Q). + !! ZUNCSD: computes the CS decomposition of an M-by-M partitioned + !! unitary matrix X: + !! [ I 0 0 | 0 0 0 ] + !! [ 0 C 0 | 0 -S 0 ] + !! [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**H + !! X = [-----------] = [---------] [---------------------] [---------] . + !! [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] + !! [ 0 S 0 | 0 C 0 ] + !! [ 0 0 I | 0 0 0 ] + !! X11 is P-by-Q. The unitary matrices U1, U2, V1, and V2 are P-by-P, + !! (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are + !! R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in + !! which R = MIN(P,M-P,Q,M-Q). ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, ldv1t, v2t,ldv2t, & work, lwork, rwork, lrwork,iwork, info ) ! -- lapack computational routine -- @@ -77285,21 +77281,21 @@ module stdlib_linalg_lapack_w subroutine stdlib_wuncsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & - !> ZUNCSD2BY1: computes the CS decomposition of an M-by-Q matrix X with - !> orthonormal columns that has been partitioned into a 2-by-1 block - !> structure: - !> [ I1 0 0 ] - !> [ 0 C 0 ] - !> [ X11 ] [ U1 | ] [ 0 0 0 ] - !> X = [-----] = [---------] [----------] V1**T . - !> [ X21 ] [ | U2 ] [ 0 0 0 ] - !> [ 0 S 0 ] - !> [ 0 0 I2] - !> X11 is P-by-Q. The unitary matrices U1, U2, and V1 are P-by-P, - !> (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R - !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which - !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a - !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). + !! ZUNCSD2BY1: computes the CS decomposition of an M-by-Q matrix X with + !! orthonormal columns that has been partitioned into a 2-by-1 block + !! structure: + !! [ I1 0 0 ] + !! [ 0 C 0 ] + !! [ X11 ] [ U1 | ] [ 0 0 0 ] + !! X = [-----] = [---------] [----------] V1**T . + !! [ X21 ] [ | U2 ] [ 0 0 0 ] + !! [ 0 S 0 ] + !! [ 0 0 I2] + !! X11 is P-by-Q. The unitary matrices U1, U2, and V1 are P-by-P, + !! (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R + !! nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which + !! R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a + !! K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, rwork, lrwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77722,11 +77718,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wung2l( m, n, k, a, lda, tau, work, info ) - !> ZUNG2L: generates an m by n complex matrix Q with orthonormal columns, - !> which is defined as the last n columns of a product of k elementary - !> reflectors of order m - !> Q = H(k) . . . H(2) H(1) - !> as returned by ZGEQLF. + !! ZUNG2L: generates an m by n complex matrix Q with orthonormal columns, + !! which is defined as the last n columns of a product of k elementary + !! reflectors of order m + !! Q = H(k) . . . H(2) H(1) + !! as returned by ZGEQLF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -77786,11 +77782,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wung2r( m, n, k, a, lda, tau, work, info ) - !> ZUNG2R: generates an m by n complex matrix Q with orthonormal columns, - !> which is defined as the first n columns of a product of k elementary - !> reflectors of order m - !> Q = H(1) H(2) . . . H(k) - !> as returned by ZGEQRF. + !! ZUNG2R: generates an m by n complex matrix Q with orthonormal columns, + !! which is defined as the first n columns of a product of k elementary + !! reflectors of order m + !! Q = H(1) H(2) . . . H(k) + !! as returned by ZGEQRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -77851,22 +77847,22 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wungbr( vect, m, n, k, a, lda, tau, work, lwork, info ) - !> ZUNGBR: generates one of the complex unitary matrices Q or P**H - !> determined by ZGEBRD when reducing a complex matrix A to bidiagonal - !> form: A = Q * B * P**H. Q and P**H are defined as products of - !> elementary reflectors H(i) or G(i) respectively. - !> If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q - !> is of order M: - !> if m >= k, Q = H(1) H(2) . . . H(k) and ZUNGBR returns the first n - !> columns of Q, where m >= n >= k; - !> if m < k, Q = H(1) H(2) . . . H(m-1) and ZUNGBR returns Q as an - !> M-by-M matrix. - !> If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**H - !> is of order N: - !> if k < n, P**H = G(k) . . . G(2) G(1) and ZUNGBR returns the first m - !> rows of P**H, where n >= m >= k; - !> if k >= n, P**H = G(n-1) . . . G(2) G(1) and ZUNGBR returns P**H as - !> an N-by-N matrix. + !! ZUNGBR: generates one of the complex unitary matrices Q or P**H + !! determined by ZGEBRD when reducing a complex matrix A to bidiagonal + !! form: A = Q * B * P**H. Q and P**H are defined as products of + !! elementary reflectors H(i) or G(i) respectively. + !! If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q + !! is of order M: + !! if m >= k, Q = H(1) H(2) . . . H(k) and ZUNGBR returns the first n + !! columns of Q, where m >= n >= k; + !! if m < k, Q = H(1) H(2) . . . H(m-1) and ZUNGBR returns Q as an + !! M-by-M matrix. + !! If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**H + !! is of order N: + !! if k < n, P**H = G(k) . . . G(2) G(1) and ZUNGBR returns the first m + !! rows of P**H, where n >= m >= k; + !! if k >= n, P**H = G(n-1) . . . G(2) G(1) and ZUNGBR returns P**H as + !! an N-by-N matrix. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78000,10 +77996,10 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) - !> ZUNGHR: generates a complex unitary matrix Q which is defined as the - !> product of IHI-ILO elementary reflectors of order N, as returned by - !> ZGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! ZUNGHR: generates a complex unitary matrix Q which is defined as the + !! product of IHI-ILO elementary reflectors of order N, as returned by + !! ZGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78090,11 +78086,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wungl2( m, n, k, a, lda, tau, work, info ) - !> ZUNGL2: generates an m-by-n complex matrix Q with orthonormal rows, - !> which is defined as the first m rows of a product of k elementary - !> reflectors of order n - !> Q = H(k)**H . . . H(2)**H H(1)**H - !> as returned by ZGELQF. + !! ZUNGL2: generates an m-by-n complex matrix Q with orthonormal rows, + !! which is defined as the first m rows of a product of k elementary + !! reflectors of order n + !! Q = H(k)**H . . . H(2)**H H(1)**H + !! as returned by ZGELQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78161,11 +78157,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunglq( m, n, k, a, lda, tau, work, lwork, info ) - !> ZUNGLQ: generates an M-by-N complex matrix Q with orthonormal rows, - !> which is defined as the first M rows of a product of K elementary - !> reflectors of order N - !> Q = H(k)**H . . . H(2)**H H(1)**H - !> as returned by ZGELQF. + !! ZUNGLQ: generates an M-by-N complex matrix Q with orthonormal rows, + !! which is defined as the first M rows of a product of K elementary + !! reflectors of order N + !! Q = H(k)**H . . . H(2)**H H(1)**H + !! as returned by ZGELQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78277,11 +78273,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wungql( m, n, k, a, lda, tau, work, lwork, info ) - !> ZUNGQL: generates an M-by-N complex matrix Q with orthonormal columns, - !> which is defined as the last N columns of a product of K elementary - !> reflectors of order M - !> Q = H(k) . . . H(2) H(1) - !> as returned by ZGEQLF. + !! ZUNGQL: generates an M-by-N complex matrix Q with orthonormal columns, + !! which is defined as the last N columns of a product of K elementary + !! reflectors of order M + !! Q = H(k) . . . H(2) H(1) + !! as returned by ZGEQLF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78398,11 +78394,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wungqr( m, n, k, a, lda, tau, work, lwork, info ) - !> ZUNGQR: generates an M-by-N complex matrix Q with orthonormal columns, - !> which is defined as the first N columns of a product of K elementary - !> reflectors of order M - !> Q = H(1) H(2) . . . H(k) - !> as returned by ZGEQRF. + !! ZUNGQR: generates an M-by-N complex matrix Q with orthonormal columns, + !! which is defined as the first N columns of a product of K elementary + !! reflectors of order M + !! Q = H(1) H(2) . . . H(k) + !! as returned by ZGEQRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78514,11 +78510,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wungr2( m, n, k, a, lda, tau, work, info ) - !> ZUNGR2: generates an m by n complex matrix Q with orthonormal rows, - !> which is defined as the last m rows of a product of k elementary - !> reflectors of order n - !> Q = H(1)**H H(2)**H . . . H(k)**H - !> as returned by ZGERQF. + !! ZUNGR2: generates an m by n complex matrix Q with orthonormal rows, + !! which is defined as the last m rows of a product of k elementary + !! reflectors of order n + !! Q = H(1)**H H(2)**H . . . H(k)**H + !! as returned by ZGERQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78582,11 +78578,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wungrq( m, n, k, a, lda, tau, work, lwork, info ) - !> ZUNGRQ: generates an M-by-N complex matrix Q with orthonormal rows, - !> which is defined as the last M rows of a product of K elementary - !> reflectors of order N - !> Q = H(1)**H H(2)**H . . . H(k)**H - !> as returned by ZGERQF. + !! ZUNGRQ: generates an M-by-N complex matrix Q with orthonormal rows, + !! which is defined as the last M rows of a product of K elementary + !! reflectors of order N + !! Q = H(1)**H H(2)**H . . . H(k)**H + !! as returned by ZGERQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78704,11 +78700,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wungtr( uplo, n, a, lda, tau, work, lwork, info ) - !> ZUNGTR: generates a complex unitary matrix Q which is defined as the - !> product of n-1 elementary reflectors of order N, as returned by - !> ZHETRD: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! ZUNGTR: generates a complex unitary matrix Q which is defined as the + !! product of n-1 elementary reflectors of order N, as returned by + !! ZHETRD: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78805,11 +78801,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wungtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) - !> ZUNGTSQR: generates an M-by-N complex matrix Q_out with orthonormal - !> columns, which are the first N columns of a product of comlpex unitary - !> matrices of order M which are returned by ZLATSQR - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> See the documentation for ZLATSQR. + !! ZUNGTSQR: generates an M-by-N complex matrix Q_out with orthonormal + !! columns, which are the first N columns of a product of comlpex unitary + !! matrices of order M which are returned by ZLATSQR + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! See the documentation for ZLATSQR. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78903,21 +78899,21 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wungtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) - !> ZUNGTSQR_ROW: generates an M-by-N complex matrix Q_out with - !> orthonormal columns from the output of ZLATSQR. These N orthonormal - !> columns are the first N columns of a product of complex unitary - !> matrices Q(k)_in of order M, which are returned by ZLATSQR in - !> a special format. - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> The input matrices Q(k)_in are stored in row and column blocks in A. - !> See the documentation of ZLATSQR for more details on the format of - !> Q(k)_in, where each Q(k)_in is represented by block Householder - !> transformations. This routine calls an auxiliary routine ZLARFB_GETT, - !> where the computation is performed on each individual block. The - !> algorithm first sweeps NB-sized column blocks from the right to left - !> starting in the bottom row block and continues to the top row block - !> (hence _ROW in the routine name). This sweep is in reverse order of - !> the order in which ZLATSQR generates the output blocks. + !! ZUNGTSQR_ROW: generates an M-by-N complex matrix Q_out with + !! orthonormal columns from the output of ZLATSQR. These N orthonormal + !! columns are the first N columns of a product of complex unitary + !! matrices Q(k)_in of order M, which are returned by ZLATSQR in + !! a special format. + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! The input matrices Q(k)_in are stored in row and column blocks in A. + !! See the documentation of ZLATSQR for more details on the format of + !! Q(k)_in, where each Q(k)_in is represented by block Householder + !! transformations. This routine calls an auxiliary routine ZLARFB_GETT, + !! where the computation is performed on each individual block. The + !! algorithm first sweeps NB-sized column blocks from the right to left + !! starting in the bottom row block and continues to the top row block + !! (hence _ROW in the routine name). This sweep is in reverse order of + !! the order in which ZLATSQR generates the output blocks. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79046,15 +79042,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunhr_col( m, n, nb, a, lda, t, ldt, d, info ) - !> ZUNHR_COL: takes an M-by-N complex matrix Q_in with orthonormal columns - !> as input, stored in A, and performs Householder Reconstruction (HR), - !> i.e. reconstructs Householder vectors V(i) implicitly representing - !> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, - !> where S is an N-by-N diagonal matrix with diagonal entries - !> equal to +1 or -1. The Householder vectors (columns V(i) of V) are - !> stored in A on output, and the diagonal entries of S are stored in D. - !> Block reflectors are also returned in T - !> (same output format as ZGEQRT). + !! ZUNHR_COL: takes an M-by-N complex matrix Q_in with orthonormal columns + !! as input, stored in A, and performs Householder Reconstruction (HR), + !! i.e. reconstructs Householder vectors V(i) implicitly representing + !! another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, + !! where S is an N-by-N diagonal matrix with diagonal entries + !! equal to +1 or -1. The Householder vectors (columns V(i) of V) are + !! stored in A on output, and the diagonal entries of S are stored in D. + !! Block reflectors are also returned in T + !! (same output format as ZGEQRT). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79365,16 +79361,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> ZUNM2L: overwrites the general complex m-by-n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by ZGEQLF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! ZUNM2L: overwrites the general complex m-by-n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by ZGEQLF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79464,16 +79460,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> ZUNM2R: overwrites the general complex m-by-n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by ZGEQRF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! ZUNM2R: overwrites the general complex m-by-n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by ZGEQRF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79567,28 +79563,28 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunmbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & - !> If VECT = 'Q', ZUNMBR: 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 - !> If VECT = 'P', ZUNMBR overwrites the general complex M-by-N matrix C - !> with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': P * C C * P - !> TRANS = 'C': P**H * C C * P**H - !> Here Q and P**H are the unitary matrices determined by ZGEBRD when - !> reducing a complex matrix A to bidiagonal form: A = Q * B * P**H. Q - !> and P**H are defined as products of elementary reflectors H(i) and - !> G(i) respectively. - !> Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the - !> order of the unitary matrix Q or P**H that is applied. - !> If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: - !> if nq >= k, Q = H(1) H(2) . . . H(k); - !> if nq < k, Q = H(1) H(2) . . . H(nq-1). - !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: - !> if k < nq, P = G(1) G(2) . . . G(k); - !> if k >= nq, P = G(1) G(2) . . . G(nq-1). + !! If VECT = 'Q', ZUNMBR: 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 + !! If VECT = 'P', ZUNMBR overwrites the general complex M-by-N matrix C + !! with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': P * C C * P + !! TRANS = 'C': P**H * C C * P**H + !! Here Q and P**H are the unitary matrices determined by ZGEBRD when + !! reducing a complex matrix A to bidiagonal form: A = Q * B * P**H. Q + !! and P**H are defined as products of elementary reflectors H(i) and + !! G(i) respectively. + !! Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the + !! order of the unitary matrix Q or P**H that is applied. + !! If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: + !! if nq >= k, Q = H(1) H(2) . . . H(k); + !! if nq < k, Q = H(1) H(2) . . . H(nq-1). + !! If VECT = 'P', A is assumed to have been a K-by-NQ matrix: + !! if k < nq, P = G(1) G(2) . . . G(k); + !! if k >= nq, P = G(1) G(2) . . . G(nq-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79728,14 +79724,14 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunmhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & - !> ZUNMHR: 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 of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> IHI-ILO elementary reflectors, as returned by ZGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! ZUNMHR: 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 of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! IHI-ILO elementary reflectors, as returned by ZGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79827,16 +79823,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> ZUNML2: overwrites the general complex m-by-n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(k)**H . . . H(2)**H H(1)**H - !> as returned by ZGELQF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! ZUNML2: overwrites the general complex m-by-n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(k)**H . . . H(2)**H H(1)**H + !! as returned by ZGELQF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79933,15 +79929,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunmlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> ZUNMLQ: 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(k)**H . . . H(2)**H H(1)**H - !> as returned by ZGELQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! ZUNMLQ: 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(k)**H . . . H(2)**H H(1)**H + !! as returned by ZGELQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80076,15 +80072,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunmql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> ZUNMQL: 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(k) . . . H(2) H(1) - !> as returned by ZGEQLF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! ZUNMQL: 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(k) . . . H(2) H(1) + !! as returned by ZGEQLF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80213,15 +80209,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunmqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> ZUNMQR: 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) - !> as returned by ZGEQRF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! ZUNMQR: 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) + !! as returned by ZGEQRF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80350,16 +80346,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunmr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> ZUNMR2: overwrites the general complex m-by-n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(1)**H H(2)**H . . . H(k)**H - !> as returned by ZGERQF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! ZUNMR2: overwrites the general complex m-by-n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(1)**H H(2)**H . . . H(k)**H + !! as returned by ZGERQF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -80451,16 +80447,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunmr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) - !> ZUNMR3: overwrites the general complex m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by ZTZRZF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! ZUNMR3: overwrites the general complex m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by ZTZRZF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80556,15 +80552,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunmrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> ZUNMRQ: 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 H(2)**H . . . H(k)**H - !> as returned by ZGERQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! ZUNMRQ: 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 H(2)**H . . . H(k)**H + !! as returned by ZGERQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80699,15 +80695,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunmrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & - !> ZUNMRZ: 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) - !> as returned by ZTZRZF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! ZUNMRZ: 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) + !! as returned by ZTZRZF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80854,15 +80850,15 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wunmtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & - !> ZUNMTR: 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 of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by ZHETRD: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! ZUNMTR: 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 of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by ZHETRD: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80970,11 +80966,11 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wupgtr( uplo, n, ap, tau, q, ldq, work, info ) - !> ZUPGTR: generates a complex unitary matrix Q which is defined as the - !> product of n-1 elementary reflectors H(i) of order n, as returned by - !> ZHPTRD using packed storage: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! ZUPGTR: generates a complex unitary matrix Q which is defined as the + !! product of n-1 elementary reflectors H(i) of order n, as returned by + !! ZHPTRD using packed storage: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -81057,16 +81053,16 @@ module stdlib_linalg_lapack_w pure subroutine stdlib_wupmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) - !> ZUPMTR: 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 of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by ZHPTRD using packed - !> storage: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! ZUPMTR: 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 of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by ZHPTRD using packed + !! storage: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- diff --git a/src/stdlib_linalg_lapack_z.fypp b/src/stdlib_linalg_lapack_z.fypp index 1e724c1d6..9c9d6a411 100644 --- a/src/stdlib_linalg_lapack_z.fypp +++ b/src/stdlib_linalg_lapack_z.fypp @@ -508,11 +508,11 @@ module stdlib_linalg_lapack_z #:if WITH_QP pure subroutine stdlib_zlag2w( m, n, sa, ldsa, a, lda, info ) - !> ZLAG2W converts a COMPLEX matrix, SA, to a COMPLEX*16 matrix, A. - !> Note that while it is possible to overflow while converting - !> from double to single, it is not possible to overflow when - !> converting from single to double. - !> This is an auxiliary routine so there is no argument checking. + !! ZLAG2W converts a COMPLEX matrix, SA, to a COMPLEX*16 matrix, A. + !! Note that while it is possible to overflow while converting + !! from double to single, it is not possible to overflow when + !! converting from single to double. + !! This is an auxiliary routine so there is no argument checking. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -538,9 +538,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zdrscl( n, sa, sx, incx ) - !> ZDRSCL multiplies an n-element complex vector x by the real scalar - !> 1/a. This is done without overflow or underflow as long as - !> the final result x/a does not overflow or underflow. + !! ZDRSCL multiplies an n-element complex vector x by the real scalar + !! 1/a. This is done without overflow or underflow as long as + !! the final result x/a does not overflow or underflow. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -592,15 +592,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) - !> ZGBEQU 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. + !! ZGBEQU 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -727,21 +727,21 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgbequb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) - !> ZGBEQUB 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 ZGEEQU 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). + !! ZGBEQUB 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 ZGEEQU 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). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -877,9 +877,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgbtf2( m, n, kl, ku, ab, ldab, ipiv, info ) - !> ZGBTF2 computes an LU factorization of a complex m-by-n band matrix - !> A using partial pivoting with row interchanges. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! ZGBTF2 computes an LU factorization of a complex m-by-n band matrix + !! A using partial pivoting with row interchanges. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -963,9 +963,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgebak( job, side, n, ilo, ihi, scale, m, v, ldv,info ) - !> ZGEBAK forms the right or left eigenvectors of a complex general - !> matrix by backward transformation on the computed eigenvectors of the - !> balanced matrix output by ZGEBAL. + !! ZGEBAK forms the right or left eigenvectors of a complex general + !! matrix by backward transformation on the computed eigenvectors of the + !! balanced matrix output by ZGEBAL. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1060,14 +1060,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgebal( job, n, a, lda, ilo, ihi, scale, info ) - !> ZGEBAL 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. + !! ZGEBAL 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1230,15 +1230,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) - !> ZGEEQU 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. + !! ZGEEQU 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1358,21 +1358,21 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) - !> ZGEEQUB 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 ZGEEQU 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). + !! ZGEEQUB 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 ZGEEQU 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). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1502,11 +1502,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgetc2( n, a, lda, ipiv, jpiv, info ) - !> ZGETC2 computes an LU factorization, using complete pivoting, of the - !> n-by-n matrix A. The factorization has the form A = P * L * U * Q, - !> where P and Q are permutation matrices, L is lower triangular with - !> unit diagonal elements and U is upper triangular. - !> This is a level 1 BLAS version of the algorithm. + !! ZGETC2 computes an LU factorization, using complete pivoting, of the + !! n-by-n matrix A. The factorization has the form A = P * L * U * Q, + !! where P and Q are permutation matrices, L is lower triangular with + !! unit diagonal elements and U is upper triangular. + !! This is a level 1 BLAS version of the algorithm. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1586,14 +1586,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgetf2( m, n, a, lda, ipiv, info ) - !> ZGETF2 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 2 BLAS version of the algorithm. + !! ZGETF2 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 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -1659,10 +1659,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zggbak( job, side, n, ilo, ihi, lscale, rscale, m, v,ldv, info ) - !> ZGGBAK 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 - !> ZGGBAL. + !! ZGGBAK 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 + !! ZGGBAL. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1772,15 +1772,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, info ) - !> ZGGBAL 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. + !! ZGGBAL 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2076,12 +2076,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgtsv( n, nrhs, dl, d, du, b, ldb, info ) - !> ZGTSV 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. + !! ZGTSV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2168,13 +2168,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgttrf( n, dl, d, du, du2, ipiv, info ) - !> ZGTTRF 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. + !! ZGTTRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2264,10 +2264,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgtts2( itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ) - !> ZGTTS2 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 ZGTTRF. + !! ZGTTS2 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 ZGTTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2435,8 +2435,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zheswapr( uplo, n, a, lda, i1, i2) - !> ZHESWAPR applies an elementary permutation on the rows and the columns of - !> a hermitian matrix. + !! ZHESWAPR applies an elementary permutation on the rows and the columns of + !! a hermitian matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2507,13 +2507,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetf2( uplo, n, a, lda, ipiv, info ) - !> ZHETF2 computes the factorization of a complex Hermitian 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, 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. + !! ZHETF2 computes the factorization of a complex Hermitian 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, 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -2833,15 +2833,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetf2_rk( uplo, n, a, lda, e, ipiv, info ) - !> ZHETF2_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. + !! ZHETF2_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3364,13 +3364,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetf2_rook( uplo, n, a, lda, ipiv, info ) - !> ZHETF2_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. + !! ZHETF2_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -3853,9 +3853,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetri( uplo, n, a, lda, ipiv, work, info ) - !> ZHETRI 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 - !> ZHETRF. + !! ZHETRI 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 + !! ZHETRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4057,9 +4057,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetri_rook( uplo, n, a, lda, ipiv, work, info ) - !> ZHETRI_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 - !> ZHETRF_ROOK. + !! ZHETRI_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 + !! ZHETRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4325,15 +4325,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) - !> ZHETRS_3 solves a system of linear equations A * X = B with a complex - !> Hermitian matrix A using the factorization computed - !> by ZHETRF_RK or ZHETRF_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. + !! ZHETRS_3 solves a system of linear equations A * X = B with a complex + !! Hermitian matrix A using the factorization computed + !! by ZHETRF_RK or ZHETRF_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4485,14 +4485,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) - !> Level 3 BLAS like routine for C in RFP Format. - !> ZHFRK 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. + !! Level 3 BLAS like routine for C in RFP Format. + !! ZHFRK 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4745,13 +4745,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhpgst( itype, uplo, n, ap, bp, info ) - !> ZHPGST 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 ZPPTRF. + !! ZHPGST 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 ZPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -4874,12 +4874,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhptrf( uplo, n, ap, ipiv, info ) - !> ZHPTRF 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. + !! ZHPTRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5224,9 +5224,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhptri( uplo, n, ap, ipiv, work, info ) - !> ZHPTRI 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 ZHPTRF. + !! ZHPTRI 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 ZHPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5443,19 +5443,19 @@ module stdlib_linalg_lapack_z subroutine stdlib_zla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5638,12 +5638,12 @@ module stdlib_linalg_lapack_z pure real(dp) function stdlib_zla_gbrpvgrw( n, kl, ku, ncols, ab,ldab, afb, ldafb ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5683,19 +5683,19 @@ module stdlib_linalg_lapack_z subroutine stdlib_zla_geamv( trans, m, n, alpha, a, lda, x, incx, beta,y, incy ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5872,12 +5872,12 @@ module stdlib_linalg_lapack_z pure real(dp) function stdlib_zla_gerpvgrw( n, ncols, a, lda, af,ldaf ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -5916,18 +5916,18 @@ module stdlib_linalg_lapack_z subroutine stdlib_zla_heamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6110,11 +6110,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zla_lin_berr( n, nz, nrhs, res, ayb, berr ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6156,12 +6156,12 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zla_porpvgrw( uplo, ncols, a, lda, af,ldaf, work ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6249,18 +6249,18 @@ module stdlib_linalg_lapack_z subroutine stdlib_zla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6444,9 +6444,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zla_wwaddw( n, x, y, w ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6471,7 +6471,7 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlacgv( n, x, incx ) - !> ZLACGV conjugates a complex vector of length N. + !! ZLACGV conjugates a complex vector of length N. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6502,8 +6502,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlacn2( n, v, x, est, kase, isave ) - !> ZLACN2 estimates the 1-norm of a square, complex matrix A. - !> Reverse communication is used for evaluating matrix-vector products. + !! ZLACN2 estimates the 1-norm of a square, complex matrix A. + !! Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6629,8 +6629,8 @@ module stdlib_linalg_lapack_z subroutine stdlib_zlacon( n, v, x, est, kase ) - !> ZLACON estimates the 1-norm of a square, complex matrix A. - !> Reverse communication is used for evaluating matrix-vector products. + !! ZLACON estimates the 1-norm of a square, complex matrix A. + !! Reverse communication is used for evaluating matrix-vector products. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6756,8 +6756,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlacp2( uplo, m, n, a, lda, b, ldb ) - !> ZLACP2 copies all or part of a real two-dimensional matrix A to a - !> complex matrix B. + !! ZLACP2 copies all or part of a real two-dimensional matrix A to a + !! complex matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6797,8 +6797,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlacpy( uplo, m, n, a, lda, b, ldb ) - !> ZLACPY copies all or part of a two-dimensional matrix A to another - !> matrix B. + !! ZLACPY copies all or part of a two-dimensional matrix A to another + !! matrix B. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6838,10 +6838,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlacrm( m, n, a, lda, b, ldb, c, ldc, rwork ) - !> ZLACRM 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. + !! ZLACRM 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6892,10 +6892,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlacrt( n, cx, incx, cy, incy, c, s ) - !> ZLACRT 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. + !! ZLACRT 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6936,9 +6936,9 @@ module stdlib_linalg_lapack_z pure complex(dp) function stdlib_zladiv( x, y ) - !> ZLADIV := X / Y, where X and Y are complex. The computation of X / Y - !> will not overflow on an intermediary step unless the results - !> overflows. + !! ZLADIV := X / Y, where X and Y are complex. The computation of X / Y + !! will not overflow on an intermediary step unless the results + !! overflows. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -6958,12 +6958,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaed8( k, n, qsiz, q, ldq, d, rho, cutpnt, z, dlamda,q2, ldq2, w, & - !> ZLAED8 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. + !! ZLAED8 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. indxp, indx, indxq, perm, givptr,givcol, givnum, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7161,15 +7161,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaesy( a, b, c, rt1, rt2, evscal, cs1, sn1 ) - !> ZLAESY 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 ] + !! ZLAESY 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 ] ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7251,14 +7251,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaev2( a, b, c, rt1, rt2, cs1, sn1 ) - !> ZLAEV2 computes the eigendecomposition of a 2-by-2 Hermitian matrix - !> [ A B ] - !> [ CONJG(B) C ]. - !> On return, RT1 is the eigenvalue of larger absolute value, RT2 is the - !> eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right - !> eigenvector for RT1, giving the decomposition - !> [ CS1 CONJG(SN1) ] [ A B ] [ CS1 -CONJG(SN1) ] = [ RT1 0 ] - !> [-SN1 CS1 ] [ CONJG(B) C ] [ SN1 CS1 ] [ 0 RT2 ]. + !! ZLAEV2 computes the eigendecomposition of a 2-by-2 Hermitian matrix + !! [ A B ] + !! [ CONJG(B) C ]. + !! On return, RT1 is the eigenvalue of larger absolute value, RT2 is the + !! eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right + !! eigenvector for RT1, giving the decomposition + !! [ CS1 CONJG(SN1) ] [ A B ] [ CS1 -CONJG(SN1) ] = [ RT1 0 ] + !! [-SN1 CS1 ] [ CONJG(B) C ] [ SN1 CS1 ] [ 0 RT2 ]. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7288,11 +7288,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlag2c( m, n, a, lda, sa, ldsa, info ) - !> ZLAG2C converts a COMPLEX*16 matrix, SA, to a COMPLEX matrix, A. - !> RMAX is the overflow for the SINGLE PRECISION arithmetic - !> ZLAG2C checks that all the entries of A are between -RMAX and - !> RMAX. If not the conversion is aborted and a flag is raised. - !> This is an auxiliary routine so there is no argument checking. + !! ZLAG2C converts a COMPLEX*16 matrix, SA, to a COMPLEX matrix, A. + !! RMAX is the overflow for the SINGLE PRECISION arithmetic + !! ZLAG2C checks that all the entries of A are between -RMAX and + !! RMAX. If not the conversion is aborted and a flag is raised. + !! This is an auxiliary routine so there is no argument checking. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -7327,11 +7327,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlagtm( trans, n, nrhs, alpha, dl, d, du, x, ldx, beta,b, ldb ) - !> ZLAGTM 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. + !! ZLAGTM 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7463,19 +7463,19 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlahef( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) - !> ZLAHEF 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. - !> ZLAHEF is an auxiliary routine called by ZHETRF. It uses blocked code - !> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or - !> A22 (if UPLO = 'L'). + !! ZLAHEF 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. + !! ZLAHEF is an auxiliary routine called by ZHETRF. It uses blocked code + !! (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or + !! A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8002,18 +8002,18 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlahef_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) - !> ZLAHEF_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. - !> ZLAHEF_RK is an auxiliary routine called by ZHETRF_RK. It uses - !> blocked code (calling Level 3 BLAS) to update the submatrix - !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). + !! ZLAHEF_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. + !! ZLAHEF_RK is an auxiliary routine called by ZHETRF_RK. It uses + !! blocked code (calling Level 3 BLAS) to update the submatrix + !! A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -8642,19 +8642,19 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlahef_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) - !> ZLAHEF_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. - !> ZLAHEF_ROOK is an auxiliary routine called by ZHETRF_ROOK. It uses - !> blocked code (calling Level 3 BLAS) to update the submatrix - !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). + !! ZLAHEF_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. + !! ZLAHEF_ROOK is an auxiliary routine called by ZHETRF_ROOK. It uses + !! blocked code (calling Level 3 BLAS) to update the submatrix + !! A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9314,26 +9314,26 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaic1( job, j, x, sest, w, gamma, sestpr, s, c ) - !> ZLAIC1 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 ZLAIC1 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. + !! ZLAIC1 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 ZLAIC1 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9530,12 +9530,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlapmr( forwrd, m, n, x, ldx, k ) - !> ZLAPMR 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. + !! ZLAPMR 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9598,12 +9598,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlapmt( forwrd, m, n, x, ldx, k ) - !> ZLAPMT 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. + !! ZLAPMT 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9666,9 +9666,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqgb( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, equed ) - !> ZLAQGB 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. + !! ZLAQGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -9736,8 +9736,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqge( m, n, a, lda, r, c, rowcnd, colcnd, amax,equed ) - !> ZLAQGE equilibrates a general M by N matrix A using the row and - !> column scaling factors in the vectors R and C. + !! ZLAQGE equilibrates a general M by N matrix A using the row and + !! column scaling factors in the vectors R and C. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9802,8 +9802,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqhb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) - !> ZLAQHB equilibrates a Hermitian band matrix A - !> using the scaling factors in the vector S. + !! ZLAQHB equilibrates a Hermitian band matrix A + !! using the scaling factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9864,8 +9864,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqhe( uplo, n, a, lda, s, scond, amax, equed ) - !> ZLAQHE equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. + !! ZLAQHE equilibrates a Hermitian matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9926,8 +9926,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqhp( uplo, n, ap, s, scond, amax, equed ) - !> ZLAQHP equilibrates a Hermitian matrix A using the scaling factors - !> in the vector S. + !! ZLAQHP equilibrates a Hermitian matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -9992,12 +9992,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqr1( n, h, ldh, s1, s2, v ) - !> Given a 2-by-2 or 3-by-3 matrix H, ZLAQR1: 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. + !! Given a 2-by-2 or 3-by-3 matrix H, ZLAQR1: 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10055,8 +10055,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed ) - !> ZLAQSB equilibrates a symmetric band matrix A using the scaling - !> factors in the vector S. + !! ZLAQSB equilibrates a symmetric band matrix A using the scaling + !! factors in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10115,8 +10115,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqsp( uplo, n, ap, s, scond, amax, equed ) - !> ZLAQSP equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. + !! ZLAQSP equilibrates a symmetric matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10177,8 +10177,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqsy( uplo, n, a, lda, s, scond, amax, equed ) - !> ZLAQSY equilibrates a symmetric matrix A using the scaling factors - !> in the vector S. + !! ZLAQSY equilibrates a symmetric matrix A using the scaling factors + !! in the vector S. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10235,21 +10235,21 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlar1v( n, b1, bn, lambda, d, l, ld, lld,pivmin, gaptol, z, wantnc, & - !> ZLAR1V 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. + !! ZLAR1V 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. negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10458,13 +10458,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlar2v( n, x, y, z, incx, c, s, incc ) - !> ZLAR2V 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) ) + !! ZLAR2V 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) ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10512,10 +10512,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlarcm( m, n, a, lda, b, ldb, c, ldc, rwork ) - !> ZLARCM 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. + !! ZLARCM 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10566,14 +10566,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlarf( side, m, n, v, incv, tau, c, ldc, work ) - !> ZLARF 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, supply conjg(tau) instead - !> tau. + !! ZLARF 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, supply conjg(tau) instead + !! tau. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -10646,8 +10646,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlarfb( side, trans, direct, storev, m, n, k, v, ldv,t, ldt, c, ldc, & - !> ZLARFB 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. + !! ZLARFB 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. work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10974,13 +10974,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlarfb_gett( ident, m, n, k, t, ldt, a, lda, b, ldb,work, ldwork ) - !> ZLARFB_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. + !! ZLARFB_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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -11113,19 +11113,19 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlarfg( n, alpha, x, incx, tau ) - !> ZLARFG 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 . + !! ZLARFG 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 . ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11187,18 +11187,18 @@ module stdlib_linalg_lapack_z subroutine stdlib_zlarfgp( n, alpha, x, incx, tau ) - !> ZLARFGP 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. + !! ZLARFGP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11323,16 +11323,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlarft( direct, storev, n, k, v, ldv, tau, t, ldt ) - !> ZLARFT 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 + !! ZLARFT 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 ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11450,13 +11450,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlarfx( side, m, n, v, tau, c, ldc, work ) - !> ZLARFX 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 - !> This version uses inline code if H has order < 11. + !! ZLARFX 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 + !! This version uses inline code if H has order < 11. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11955,12 +11955,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlarfy( uplo, n, v, incv, tau, c, ldc, work ) - !> ZLARFY 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. + !! ZLARFY 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. ! -- lapack test routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -11989,8 +11989,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlarnv( idist, iseed, n, x ) - !> ZLARNV returns a vector of n random complex numbers from a uniform or - !> normal distribution. + !! ZLARNV returns a vector of n random complex numbers from a uniform or + !! normal distribution. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12054,30 +12054,28 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlartg( f, g, c, s, r ) - !> ! - !> - !> ZLARTG 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 DLARTG. - !> 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 ZROTG, 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=>dp stands for double precision from LA_CONSTANTS module. + !! ZLARTG 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 DLARTG. + !! 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 ZROTG, 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=>dp stands for double precision from LA_CONSTANTS module. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12174,10 +12172,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlartv( n, x, incx, y, incy, c, s, incc ) - !> ZLARTV 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) ) + !! ZLARTV 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) ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12211,15 +12209,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlarz( side, m, n, l, v, incv, tau, c, ldc, work ) - !> ZLARZ 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 ZTZRZF. + !! ZLARZ 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 ZTZRZF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12270,9 +12268,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlarzb( side, trans, direct, storev, m, n, k, l, v,ldv, t, ldt, c, & - !> ZLARZB 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. + !! ZLARZB 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. ldc, work, ldwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12372,18 +12370,18 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) - !> ZLARZT 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. + !! ZLARZT 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12436,11 +12434,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlascl( type, kl, ku, cfrom, cto, m, n, a, lda, info ) - !> ZLASCL 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. + !! ZLASCL 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12606,8 +12604,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaset( uplo, m, n, alpha, beta, a, lda ) - !> ZLASET initializes a 2-D array A to BETA on the diagonal and - !> ALPHA on the offdiagonals. + !! ZLASET initializes a 2-D array A to BETA on the diagonal and + !! ALPHA on the offdiagonals. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12662,57 +12660,57 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlasr( side, pivot, direct, m, n, c, s, a, lda ) - !> ZLASR 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. + !! ZLASR 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -12922,26 +12920,24 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlassq( n, x, incx, scl, sumsq ) - !> ! - !> - !> ZLASSQ 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. + !! ZLASSQ 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13048,8 +13044,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaswp( n, a, lda, k1, k2, ipiv, incx ) - !> ZLASWP performs a series of row interchanges on the matrix A. - !> One row interchange is initiated for each of rows K1 through K2 of A. + !! ZLASWP performs a series of row interchanges on the matrix A. + !! One row interchange is initiated for each of rows K1 through K2 of A. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13115,19 +13111,19 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) - !> ZLASYF 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. - !> ZLASYF is an auxiliary routine called by ZSYTRF. It uses blocked code - !> (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or - !> A22 (if UPLO = 'L'). + !! ZLASYF 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. + !! ZLASYF is an auxiliary routine called by ZSYTRF. It uses blocked code + !! (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or + !! A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -13555,18 +13551,18 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlasyf_rk( uplo, n, nb, kb, a, lda, e, ipiv, w, ldw,info ) - !> ZLASYF_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. - !> ZLASYF_RK is an auxiliary routine called by ZSYTRF_RK. It uses - !> blocked code (calling Level 3 BLAS) to update the submatrix - !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). + !! ZLASYF_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. + !! ZLASYF_RK is an auxiliary routine called by ZSYTRF_RK. It uses + !! blocked code (calling Level 3 BLAS) to update the submatrix + !! A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14001,18 +13997,18 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlasyf_rook( uplo, n, nb, kb, a, lda, ipiv, w, ldw,info ) - !> ZLASYF_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. - !> ZLASYF_ROOK is an auxiliary routine called by ZSYTRF_ROOK. It uses - !> blocked code (calling Level 3 BLAS) to update the submatrix - !> A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). + !! ZLASYF_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. + !! ZLASYF_ROOK is an auxiliary routine called by ZSYTRF_ROOK. It uses + !! blocked code (calling Level 3 BLAS) to update the submatrix + !! A11 (if UPLO = 'U') or A22 (if UPLO = 'L'). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14467,12 +14463,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlat2c( uplo, n, a, lda, sa, ldsa, info ) - !> ZLAT2C converts a COMPLEX*16 triangular matrix, SA, to a COMPLEX - !> triangular matrix, A. - !> RMAX is the overflow for the SINGLE PRECISION arithmetic - !> ZLAT2C checks that all the entries of A are between -RMAX and - !> RMAX. If not the conversion is aborted and a flag is raised. - !> This is an auxiliary routine so there is no argument checking. + !! ZLAT2C converts a COMPLEX*16 triangular matrix, SA, to a COMPLEX + !! triangular matrix, A. + !! RMAX is the overflow for the SINGLE PRECISION arithmetic + !! ZLAT2C checks that all the entries of A are between -RMAX and + !! RMAX. If not the conversion is aborted and a flag is raised. + !! This is an auxiliary routine so there is no argument checking. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -14524,16 +14520,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm, & - !> ZLATBS 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 ZTBSV 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. + !! ZLATBS 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 ZTBSV 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. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15080,17 +15076,17 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) - !> ZLATPS 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 ZTPSV 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. + !! ZLATPS 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 ZTPSV 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15631,15 +15627,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) - !> ZLATRD reduces NB rows and columns of a complex Hermitian matrix A to - !> Hermitian tridiagonal form by a unitary similarity - !> transformation Q**H * A * Q, and returns the matrices V and W which are - !> needed to apply the transformation to the unreduced part of A. - !> If UPLO = 'U', ZLATRD reduces the last NB rows and columns of a - !> matrix, of which the upper triangle is supplied; - !> if UPLO = 'L', ZLATRD reduces the first NB rows and columns of a - !> matrix, of which the lower triangle is supplied. - !> This is an auxiliary routine called by ZHETRD. + !! ZLATRD reduces NB rows and columns of a complex Hermitian matrix A to + !! Hermitian tridiagonal form by a unitary similarity + !! transformation Q**H * A * Q, and returns the matrices V and W which are + !! needed to apply the transformation to the unreduced part of A. + !! If UPLO = 'U', ZLATRD reduces the last NB rows and columns of a + !! matrix, of which the upper triangle is supplied; + !! if UPLO = 'L', ZLATRD reduces the first NB rows and columns of a + !! matrix, of which the lower triangle is supplied. + !! This is an auxiliary routine called by ZHETRD. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -15747,16 +15743,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info ) - !> ZLATRS 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. Here A is an upper or lower - !> triangular matrix, 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 - !> ZTRSV 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. + !! ZLATRS 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. Here A is an upper or lower + !! triangular matrix, 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 + !! ZTRSV 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16276,10 +16272,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlatrz( m, n, l, a, lda, tau, work ) - !> ZLATRZ factors the M-by-(M+L) complex upper trapezoidal matrix - !> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z by means - !> of unitary transformations, where Z is an (M+L)-by-(M+L) unitary - !> matrix and, R and A1 are M-by-M upper triangular matrices. + !! ZLATRZ factors the M-by-(M+L) complex upper trapezoidal matrix + !! [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z by means + !! of unitary transformations, where Z is an (M+L)-by-(M+L) unitary + !! matrix and, R and A1 are M-by-M upper triangular matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16322,54 +16318,54 @@ module stdlib_linalg_lapack_z pure recursive subroutine stdlib_zlaunhr_col_getrfnp2( m, n, a, lda, d, info ) - !> ZLAUNHR_COL_GETRFNP2 computes the modified LU factorization without - !> pivoting of a complex 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 ZUNHR_COL. In ZUNHR_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]. - !> ZLAUNHR_COL_GETRFNP2 is called to factorize a block by the blocked - !> routine ZLAUNHR_COL_GETRFNP, which uses blocked code calling - !> Level 3 BLAS to update the submatrix. However, ZLAUNHR_COL_GETRFNP2 - !> is self-sufficient and can be used without ZLAUNHR_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. + !! ZLAUNHR_COL_GETRFNP2 computes the modified LU factorization without + !! pivoting of a complex 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 ZUNHR_COL. In ZUNHR_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]. + !! ZLAUNHR_COL_GETRFNP2 is called to factorize a block by the blocked + !! routine ZLAUNHR_COL_GETRFNP, which uses blocked code calling + !! Level 3 BLAS to update the submatrix. However, ZLAUNHR_COL_GETRFNP2 + !! is self-sufficient and can be used without ZLAUNHR_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16458,14 +16454,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlauu2( uplo, n, a, lda, info ) - !> ZLAUU2 computes the product U * U**H or L**H * L, where the triangular - !> factor U or L is stored in the upper or lower triangular part of - !> the array A. - !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, - !> overwriting the factor U in A. - !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, - !> overwriting the factor L in A. - !> This is the unblocked form of the algorithm, calling Level 2 BLAS. + !! ZLAUU2 computes the product U * U**H or L**H * L, where the triangular + !! factor U or L is stored in the upper or lower triangular part of + !! the array A. + !! If UPLO = 'U' or 'u' then the upper triangle of the result is stored, + !! overwriting the factor U in A. + !! If UPLO = 'L' or 'l' then the lower triangle of the result is stored, + !! overwriting the factor L in A. + !! This is the unblocked form of the algorithm, calling Level 2 BLAS. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16536,14 +16532,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlauum( uplo, n, a, lda, info ) - !> ZLAUUM computes the product U * U**H or L**H * L, where the triangular - !> factor U or L is stored in the upper or lower triangular part of - !> the array A. - !> If UPLO = 'U' or 'u' then the upper triangle of the result is stored, - !> overwriting the factor U in A. - !> If UPLO = 'L' or 'l' then the lower triangle of the result is stored, - !> overwriting the factor L in A. - !> This is the blocked form of the algorithm, calling Level 3 BLAS. + !! ZLAUUM computes the product U * U**H or L**H * L, where the triangular + !! factor U or L is stored in the upper or lower triangular part of + !! the array A. + !! If UPLO = 'U' or 'u' then the upper triangle of the result is stored, + !! overwriting the factor U in A. + !! If UPLO = 'L' or 'l' then the lower triangle of the result is stored, + !! overwriting the factor L in A. + !! This is the blocked form of the algorithm, calling Level 3 BLAS. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16620,12 +16616,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpbcon( uplo, n, kd, ab, ldab, anorm, rcond, work,rwork, info ) - !> ZPBCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite band matrix using - !> the Cholesky factorization A = U**H*U or A = L*L**H computed by - !> ZPBTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZPBCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite band matrix using + !! the Cholesky factorization A = U**H*U or A = L*L**H computed by + !! ZPBTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16724,14 +16720,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) - !> ZPBEQU computes row and column scalings intended to equilibrate a - !> Hermitian positive definite band matrix A and reduce its condition - !> number (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. + !! ZPBEQU computes row and column scalings intended to equilibrate a + !! Hermitian positive definite band matrix A and reduce its condition + !! number (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16811,15 +16807,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpbstf( uplo, n, kd, ab, ldab, info ) - !> ZPBSTF computes a split Cholesky factorization of a complex - !> Hermitian positive definite band matrix A. - !> This routine is designed to be used in conjunction with ZHBGST. - !> The factorization has the form A = S**H*S where S is a band matrix - !> of the same bandwidth as A and the following structure: - !> S = ( U ) - !> ( M L ) - !> where U is upper triangular of order m = (n+kd)/2, and L is lower - !> triangular of order n-m. + !! ZPBSTF computes a split Cholesky factorization of a complex + !! Hermitian positive definite band matrix A. + !! This routine is designed to be used in conjunction with ZHBGST. + !! The factorization has the form A = S**H*S where S is a band matrix + !! of the same bandwidth as A and the following structure: + !! S = ( U ) + !! ( M L ) + !! where U is upper triangular of order m = (n+kd)/2, and L is lower + !! triangular of order n-m. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -16945,14 +16941,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpbtf2( uplo, n, kd, ab, ldab, info ) - !> ZPBTF2 computes the Cholesky factorization of a complex Hermitian - !> positive definite band matrix A. - !> The factorization has the form - !> A = U**H * U , if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix, U**H is the conjugate transpose - !> of U, and L is lower triangular. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! ZPBTF2 computes the Cholesky factorization of a complex Hermitian + !! positive definite band matrix A. + !! The factorization has the form + !! A = U**H * U , if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix, U**H is the conjugate transpose + !! of U, and L is lower triangular. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17040,9 +17036,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpbtrs( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) - !> ZPBTRS solves a system of linear equations A*X = B with a Hermitian - !> positive definite band matrix A using the Cholesky factorization - !> A = U**H *U or A = L*L**H computed by ZPBTRF. + !! ZPBTRS solves a system of linear equations A*X = B with a Hermitian + !! positive definite band matrix A using the Cholesky factorization + !! A = U**H *U or A = L*L**H computed by ZPBTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17108,11 +17104,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpocon( uplo, n, a, lda, anorm, rcond, work, rwork,info ) - !> ZPOCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite matrix using the - !> Cholesky factorization A = U**H*U or A = L*L**H computed by ZPOTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZPOCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite matrix using the + !! Cholesky factorization A = U**H*U or A = L*L**H computed by ZPOTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17208,14 +17204,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpoequ( n, a, lda, s, scond, amax, info ) - !> ZPOEQU computes row and column scalings intended to equilibrate a - !> Hermitian positive definite matrix A and reduce its condition number - !> (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. + !! ZPOEQU computes row and column scalings intended to equilibrate a + !! Hermitian positive definite matrix A and reduce its condition number + !! (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17282,19 +17278,19 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpoequb( n, a, lda, s, scond, amax, info ) - !> ZPOEQUB computes row and column scalings intended to equilibrate a - !> Hermitian positive definite matrix A and reduce its condition number - !> (with respect to the two-norm). S contains the scale factors, - !> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with - !> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This - !> choice of S puts the condition number of B within a factor N of the - !> smallest possible condition number over all possible diagonal - !> scalings. - !> This routine differs from ZPOEQU 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 diagonal entries are no longer approximately 1 but lie - !> between sqrt(radix) and 1/sqrt(radix). + !! ZPOEQUB computes row and column scalings intended to equilibrate a + !! Hermitian positive definite matrix A and reduce its condition number + !! (with respect to the two-norm). S contains the scale factors, + !! S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with + !! elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This + !! choice of S puts the condition number of B within a factor N of the + !! smallest possible condition number over all possible diagonal + !! scalings. + !! This routine differs from ZPOEQU 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 diagonal entries are no longer approximately 1 but lie + !! between sqrt(radix) and 1/sqrt(radix). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17364,13 +17360,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpotf2( uplo, n, a, lda, info ) - !> ZPOTF2 computes the Cholesky factorization of a complex Hermitian - !> positive definite matrix A. - !> The factorization has the form - !> A = U**H * U , if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the unblocked version of the algorithm, calling Level 2 BLAS. + !! ZPOTF2 computes the Cholesky factorization of a complex Hermitian + !! positive definite matrix A. + !! The factorization has the form + !! A = U**H * U , if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the unblocked version of the algorithm, calling Level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17458,19 +17454,19 @@ module stdlib_linalg_lapack_z pure recursive subroutine stdlib_zpotrf2( uplo, n, a, lda, info ) - !> ZPOTRF2 computes the Cholesky factorization of a Hermitian - !> positive definite matrix A using the recursive algorithm. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> 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 = n/2 - !> [ A21 | A22 ] n2 = n-n1 - !> The subroutine calls itself to factor A11. Update and scale A21 - !> or A12, update A22 then call itself to factor A22. + !! ZPOTRF2 computes the Cholesky factorization of a Hermitian + !! positive definite matrix A using the recursive algorithm. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! 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 = n/2 + !! [ A21 | A22 ] n2 = n-n1 + !! The subroutine calls itself to factor A11. Update and scale A21 + !! or A12, update A22 then call itself to factor A22. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17559,9 +17555,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpotrs( uplo, n, nrhs, a, lda, b, ldb, info ) - !> ZPOTRS solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A using the Cholesky factorization - !> A = U**H * U or A = L * L**H computed by ZPOTRF. + !! ZPOTRS solves a system of linear equations A*X = B with a Hermitian + !! positive definite matrix A using the Cholesky factorization + !! A = U**H * U or A = L * L**H computed by ZPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17621,12 +17617,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zppcon( uplo, n, ap, anorm, rcond, work, rwork, info ) - !> ZPPCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite packed matrix using - !> the Cholesky factorization A = U**H*U or A = L*L**H computed by - !> ZPPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZPPCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite packed matrix using + !! the Cholesky factorization A = U**H*U or A = L*L**H computed by + !! ZPPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17720,14 +17716,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zppequ( uplo, n, ap, s, scond, amax, info ) - !> ZPPEQU computes row and column scalings intended to equilibrate a - !> Hermitian positive definite matrix A in packed storage and reduce - !> its condition number (with respect to the two-norm). S contains the - !> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix - !> B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal. - !> This choice of S puts the condition number of B within a factor N of - !> the smallest possible condition number over all possible diagonal - !> scalings. + !! ZPPEQU computes row and column scalings intended to equilibrate a + !! Hermitian positive definite matrix A in packed storage and reduce + !! its condition number (with respect to the two-norm). S contains the + !! scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix + !! B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal. + !! This choice of S puts the condition number of B within a factor N of + !! the smallest possible condition number over all possible diagonal + !! scalings. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17813,12 +17809,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpptrf( uplo, n, ap, info ) - !> ZPPTRF computes the Cholesky factorization of a complex Hermitian - !> positive definite matrix A stored in packed format. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. + !! ZPPTRF computes the Cholesky factorization of a complex Hermitian + !! positive definite matrix A stored in packed format. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17899,9 +17895,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpptrs( uplo, n, nrhs, ap, b, ldb, info ) - !> ZPPTRS solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A in packed storage using the Cholesky - !> factorization A = U**H * U or A = L * L**H computed by ZPPTRF. + !! ZPPTRS solves a system of linear equations A*X = B with a Hermitian + !! positive definite matrix A in packed storage using the Cholesky + !! factorization A = U**H * U or A = L * L**H computed by ZPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -17963,15 +17959,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpstf2( uplo, n, a, lda, piv, rank, tol, work, info ) - !> ZPSTF2 computes the Cholesky factorization with complete - !> pivoting of a complex Hermitian positive semidefinite matrix A. - !> The factorization has the form - !> P**T * A * P = U**H * U , if UPLO = 'U', - !> P**T * A * P = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular, and - !> P is stored as vector PIV. - !> This algorithm does not attempt to check that A is positive - !> semidefinite. This version of the algorithm calls level 2 BLAS. + !! ZPSTF2 computes the Cholesky factorization with complete + !! pivoting of a complex Hermitian positive semidefinite matrix A. + !! The factorization has the form + !! P**T * A * P = U**H * U , if UPLO = 'U', + !! P**T * A * P = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular, and + !! P is stored as vector PIV. + !! This algorithm does not attempt to check that A is positive + !! semidefinite. This version of the algorithm calls level 2 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18157,15 +18153,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) - !> ZPSTRF computes the Cholesky factorization with complete - !> pivoting of a complex Hermitian positive semidefinite matrix A. - !> The factorization has the form - !> P**T * A * P = U**H * U , if UPLO = 'U', - !> P**T * A * P = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular, and - !> P is stored as vector PIV. - !> This algorithm does not attempt to check that A is positive - !> semidefinite. This version of the algorithm calls level 3 BLAS. + !! ZPSTRF computes the Cholesky factorization with complete + !! pivoting of a complex Hermitian positive semidefinite matrix A. + !! The factorization has the form + !! P**T * A * P = U**H * U , if UPLO = 'U', + !! P**T * A * P = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular, and + !! P is stored as vector PIV. + !! This algorithm does not attempt to check that A is positive + !! semidefinite. This version of the algorithm calls level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18383,13 +18379,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zptcon( n, d, e, anorm, rcond, rwork, info ) - !> ZPTCON computes the reciprocal of the condition number (in the - !> 1-norm) of a complex Hermitian positive definite tridiagonal matrix - !> using the factorization A = L*D*L**H or A = U**H*D*U computed by - !> ZPTTRF. - !> Norm(inv(A)) is computed by a direct method, and the reciprocal of - !> the condition number is computed as - !> RCOND = 1 / (ANORM * norm(inv(A))). + !! ZPTCON computes the reciprocal of the condition number (in the + !! 1-norm) of a complex Hermitian positive definite tridiagonal matrix + !! using the factorization A = L*D*L**H or A = U**H*D*U computed by + !! ZPTTRF. + !! Norm(inv(A)) is computed by a direct method, and the reciprocal of + !! the condition number is computed as + !! RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18457,9 +18453,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpttrf( n, d, e, info ) - !> ZPTTRF computes the L*D*L**H factorization of a complex Hermitian - !> positive definite tridiagonal matrix A. The factorization may also - !> be regarded as having the form A = U**H *D*U. + !! ZPTTRF computes the L*D*L**H factorization of a complex Hermitian + !! positive definite tridiagonal matrix A. The factorization may also + !! be regarded as having the form A = U**H *D*U. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18556,12 +18552,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zptts2( iuplo, n, nrhs, d, e, b, ldb ) - !> ZPTTS2 solves a tridiagonal system of the form - !> A * X = B - !> using the factorization A = U**H *D*U or A = L*D*L**H computed by ZPTTRF. - !> D is a diagonal matrix specified in the vector D, U (or L) is a unit - !> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in - !> the vector E, and X and B are N by NRHS matrices. + !! ZPTTS2 solves a tridiagonal system of the form + !! A * X = B + !! using the factorization A = U**H *D*U or A = L*D*L**H computed by ZPTTRF. + !! D is a diagonal matrix specified in the vector D, U (or L) is a unit + !! bidiagonal matrix whose superdiagonal (subdiagonal) is specified in + !! the vector E, and X and B are N by NRHS matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18656,8 +18652,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zrot( n, cx, incx, cy, incy, c, s ) - !> ZROT applies a plane rotation, where the cos (C) is real and the - !> sin (S) is complex, and the vectors CX and CY are complex. + !! ZROT applies a plane rotation, where the cos (C) is real and the + !! sin (S) is complex, and the vectors CX and CY are complex. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18701,10 +18697,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zspmv( uplo, n, alpha, ap, x, incx, beta, y, incy ) - !> ZSPMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix, supplied in packed form. + !! ZSPMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix, supplied in packed form. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18859,10 +18855,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zspr( uplo, n, alpha, x, incx, ap ) - !> ZSPR performs the symmetric rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a complex scalar, x is an n element vector and A is an - !> n by n symmetric matrix, supplied in packed form. + !! ZSPR performs the symmetric rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a complex scalar, x is an n element vector and A is an + !! n by n symmetric matrix, supplied in packed form. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -18979,13 +18975,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsptrf( uplo, n, ap, ipiv, info ) - !> ZSPTRF computes the factorization of a complex symmetric matrix A - !> stored in packed format using the Bunch-Kaufman diagonal pivoting - !> method: - !> 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 symmetric and block diagonal with - !> 1-by-1 and 2-by-2 diagonal blocks. + !! ZSPTRF computes the factorization of a complex symmetric matrix A + !! stored in packed format using the Bunch-Kaufman diagonal pivoting + !! method: + !! 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 symmetric and block diagonal with + !! 1-by-1 and 2-by-2 diagonal blocks. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19308,9 +19304,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsptri( uplo, n, ap, ipiv, work, info ) - !> ZSPTRI computes the inverse of a complex symmetric indefinite matrix - !> A in packed storage using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by ZSPTRF. + !! ZSPTRI computes the inverse of a complex symmetric indefinite matrix + !! A in packed storage using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by ZSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19519,9 +19515,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> ZSPTRS solves a system of linear equations A*X = B with a complex - !> symmetric matrix A stored in packed format using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by ZSPTRF. + !! ZSPTRS solves a system of linear equations A*X = B with a complex + !! symmetric matrix A stored in packed format using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by ZSPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -19739,15 +19735,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & - !> ZSTEIN computes the eigenvectors of a real symmetric tridiagonal - !> matrix T corresponding to specified eigenvalues, using inverse - !> iteration. - !> The maximum number of iterations allowed for each eigenvector is - !> specified by an internal parameter MAXITS (currently set to 5). - !> Although the eigenvectors are real, they are stored in a complex - !> array, which may be passed to ZUNMTR or ZUPMTR for back - !> transformation to the eigenvectors of a complex Hermitian matrix - !> which was reduced to tridiagonal form. + !! ZSTEIN computes the eigenvectors of a real symmetric tridiagonal + !! matrix T corresponding to specified eigenvalues, using inverse + !! iteration. + !! The maximum number of iterations allowed for each eigenvector is + !! specified by an internal parameter MAXITS (currently set to 5). + !! Although the eigenvectors are real, they are stored in a complex + !! array, which may be passed to ZUNMTR or ZUPMTR for back + !! transformation to the eigenvectors of a complex Hermitian matrix + !! which was reduced to tridiagonal form. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19949,11 +19945,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsteqr( compz, n, d, e, z, ldz, work, info ) - !> ZSTEQR computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric tridiagonal matrix using the implicit QL or QR method. - !> The eigenvectors of a full or band complex Hermitian matrix can also - !> be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this - !> matrix to tridiagonal form. + !! ZSTEQR computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric tridiagonal matrix using the implicit QL or QR method. + !! The eigenvectors of a full or band complex Hermitian matrix can also + !! be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this + !! matrix to tridiagonal form. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20269,9 +20265,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsyconv( uplo, way, n, a, lda, ipiv, e, info ) - !> ZSYCONV converts A given by ZHETRF into L and D or vice-versa. - !> Get nondiagonal elements of D (returned in workspace) and - !> apply or reverse permutation done in TRF. + !! ZSYCONV converts A given by ZHETRF into L and D or vice-versa. + !! Get nondiagonal elements of D (returned in workspace) and + !! apply or reverse permutation done in TRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20474,23 +20470,23 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsyconvf( uplo, way, n, a, lda, e, ipiv, info ) - !> If parameter WAY = 'C': - !> ZSYCONVF converts the factorization output format used in - !> ZSYTRF provided on entry in parameter A into the factorization - !> output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored - !> on exit in parameters A and E. It also converts in place details of - !> the intechanges stored in IPIV from the format used in ZSYTRF into - !> the format used in ZSYTRF_RK (or ZSYTRF_BK). - !> If parameter WAY = 'R': - !> ZSYCONVF performs the conversion in reverse direction, i.e. - !> converts the factorization output format used in ZSYTRF_RK - !> (or ZSYTRF_BK) provided on entry in parameters A and E into - !> the factorization output format used in ZSYTRF that is stored - !> on exit in parameter A. It also converts in place details of - !> the intechanges stored in IPIV from the format used in ZSYTRF_RK - !> (or ZSYTRF_BK) into the format used in ZSYTRF. - !> ZSYCONVF can also convert in Hermitian matrix case, i.e. between - !> formats used in ZHETRF and ZHETRF_RK (or ZHETRF_BK). + !! If parameter WAY = 'C': + !! ZSYCONVF converts the factorization output format used in + !! ZSYTRF provided on entry in parameter A into the factorization + !! output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored + !! on exit in parameters A and E. It also converts in place details of + !! the intechanges stored in IPIV from the format used in ZSYTRF into + !! the format used in ZSYTRF_RK (or ZSYTRF_BK). + !! If parameter WAY = 'R': + !! ZSYCONVF performs the conversion in reverse direction, i.e. + !! converts the factorization output format used in ZSYTRF_RK + !! (or ZSYTRF_BK) provided on entry in parameters A and E into + !! the factorization output format used in ZSYTRF that is stored + !! on exit in parameter A. It also converts in place details of + !! the intechanges stored in IPIV from the format used in ZSYTRF_RK + !! (or ZSYTRF_BK) into the format used in ZSYTRF. + !! ZSYCONVF can also convert in Hermitian matrix case, i.e. between + !! formats used in ZHETRF and ZHETRF_RK (or ZHETRF_BK). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20731,21 +20727,21 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) - !> If parameter WAY = 'C': - !> ZSYCONVF_ROOK converts the factorization output format used in - !> ZSYTRF_ROOK provided on entry in parameter A into the factorization - !> output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored - !> on exit in parameters A and E. IPIV format for ZSYTRF_ROOK and - !> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted. - !> If parameter WAY = 'R': - !> ZSYCONVF_ROOK performs the conversion in reverse direction, i.e. - !> converts the factorization output format used in ZSYTRF_RK - !> (or ZSYTRF_BK) provided on entry in parameters A and E into - !> the factorization output format used in ZSYTRF_ROOK that is stored - !> on exit in parameter A. IPIV format for ZSYTRF_ROOK and - !> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted. - !> ZSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between - !> formats used in ZHETRF_ROOK and ZHETRF_RK (or ZHETRF_BK). + !! If parameter WAY = 'C': + !! ZSYCONVF_ROOK converts the factorization output format used in + !! ZSYTRF_ROOK provided on entry in parameter A into the factorization + !! output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored + !! on exit in parameters A and E. IPIV format for ZSYTRF_ROOK and + !! ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted. + !! If parameter WAY = 'R': + !! ZSYCONVF_ROOK performs the conversion in reverse direction, i.e. + !! converts the factorization output format used in ZSYTRF_RK + !! (or ZSYTRF_BK) provided on entry in parameters A and E into + !! the factorization output format used in ZSYTRF_ROOK that is stored + !! on exit in parameter A. IPIV format for ZSYTRF_ROOK and + !! ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted. + !! ZSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between + !! formats used in ZHETRF_ROOK and ZHETRF_RK (or ZHETRF_BK). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -20986,13 +20982,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsyequb( uplo, n, a, lda, s, scond, amax, work, info ) - !> ZSYEQUB computes row and column scalings intended to equilibrate a - !> symmetric 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. + !! ZSYEQUB computes row and column scalings intended to equilibrate a + !! symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21168,10 +21164,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsymv( uplo, n, alpha, a, lda, x, incx, beta, y, incy ) - !> ZSYMV performs the matrix-vector operation - !> y := alpha*A*x + beta*y, - !> where alpha and beta are scalars, x and y are n element vectors and - !> A is an n by n symmetric matrix. + !! ZSYMV performs the matrix-vector operation + !! y := alpha*A*x + beta*y, + !! where alpha and beta are scalars, x and y are n element vectors and + !! A is an n by n symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21322,10 +21318,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsyr( uplo, n, alpha, x, incx, a, lda ) - !> ZSYR performs the symmetric rank 1 operation - !> A := alpha*x*x**H + A, - !> where alpha is a complex scalar, x is an n element vector and A is an - !> n by n symmetric matrix. + !! ZSYR performs the symmetric rank 1 operation + !! A := alpha*x*x**H + A, + !! where alpha is a complex scalar, x is an n element vector and A is an + !! n by n symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21426,8 +21422,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsyswapr( uplo, n, a, lda, i1, i2) - !> ZSYSWAPR applies an elementary permutation on the rows and the columns of - !> a symmetric matrix. + !! ZSYSWAPR applies an elementary permutation on the rows and the columns of + !! a symmetric matrix. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21494,13 +21490,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsytf2( uplo, n, a, lda, ipiv, info ) - !> ZSYTF2 computes the factorization of a complex symmetric matrix A - !> using the Bunch-Kaufman diagonal pivoting method: - !> 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, U**T is the transpose of U, and D is symmetric 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. + !! ZSYTF2 computes the factorization of a complex symmetric matrix A + !! using the Bunch-Kaufman diagonal pivoting method: + !! 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, U**T is the transpose of U, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -21785,15 +21781,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsytf2_rk( uplo, n, a, lda, e, ipiv, info ) - !> ZSYTF2_RK computes the factorization of a complex symmetric matrix A - !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric 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. + !! ZSYTF2_RK computes the factorization of a complex symmetric matrix A + !! using the bounded Bunch-Kaufman (rook) diagonal pivoting method: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22242,13 +22238,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsytf2_rook( uplo, n, a, lda, ipiv, info ) - !> ZSYTF2_ROOK computes the factorization of a complex symmetric matrix A - !> using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: - !> 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, U**T is the transpose of U, and D is symmetric 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. + !! ZSYTF2_ROOK computes the factorization of a complex symmetric matrix A + !! using the bounded Bunch-Kaufman ("rook") diagonal pivoting method: + !! 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, U**T is the transpose of U, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22658,14 +22654,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsytrf( uplo, n, a, lda, ipiv, work, lwork, info ) - !> ZSYTRF computes the factorization of a complex symmetric matrix A - !> using the Bunch-Kaufman 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 symmetric 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. + !! ZSYTRF computes the factorization of a complex symmetric matrix A + !! using the Bunch-Kaufman 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 symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22784,15 +22780,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) - !> ZSYTRF_RK computes the factorization of a complex symmetric matrix A - !> using the bounded Bunch-Kaufman (rook) diagonal pivoting method: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric 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. + !! ZSYTRF_RK computes the factorization of a complex symmetric matrix A + !! using the bounded Bunch-Kaufman (rook) diagonal pivoting method: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -22950,14 +22946,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) - !> ZSYTRF_ROOK computes the factorization of a complex symmetric 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 symmetric 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. + !! ZSYTRF_ROOK computes the factorization of a complex symmetric 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 symmetric 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23078,9 +23074,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsytri( uplo, n, a, lda, ipiv, work, info ) - !> ZSYTRI computes the inverse of a complex symmetric indefinite matrix - !> A using the factorization A = U*D*U**T or A = L*D*L**T computed by - !> ZSYTRF. + !! ZSYTRI computes the inverse of a complex symmetric indefinite matrix + !! A using the factorization A = U*D*U**T or A = L*D*L**T computed by + !! ZSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23266,9 +23262,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsytri_rook( uplo, n, a, lda, ipiv, work, info ) - !> ZSYTRI_ROOK computes the inverse of a complex symmetric - !> matrix A using the factorization A = U*D*U**T or A = L*D*L**T - !> computed by ZSYTRF_ROOK. + !! ZSYTRI_ROOK computes the inverse of a complex symmetric + !! matrix A using the factorization A = U*D*U**T or A = L*D*L**T + !! computed by ZSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23494,9 +23490,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsytrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) - !> ZSYTRS solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by ZSYTRF. + !! ZSYTRS solves a system of linear equations A*X = B with a complex + !! symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by ZSYTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23704,9 +23700,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsytrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) - !> ZSYTRS2 solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by ZSYTRF and converted by ZSYCONV. + !! ZSYTRS2 solves a system of linear equations A*X = B with a complex + !! symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by ZSYTRF and converted by ZSYCONV. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -23882,15 +23878,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsytrs_3( uplo, n, nrhs, a, lda, e, ipiv, b, ldb,info ) - !> ZSYTRS_3 solves a system of linear equations A * X = B with a complex - !> symmetric matrix A using the factorization computed - !> by ZSYTRF_RK or ZSYTRF_BK: - !> A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric and block - !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. - !> This algorithm is using Level 3 BLAS. + !! ZSYTRS_3 solves a system of linear equations A * X = B with a complex + !! symmetric matrix A using the factorization computed + !! by ZSYTRF_RK or ZSYTRF_BK: + !! A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T), + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric and block + !! diagonal with 1-by-1 and 2-by-2 diagonal blocks. + !! This algorithm is using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24039,9 +24035,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsytrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) - !> ZSYTRS_AA solves a system of linear equations A*X = B with a complex - !> symmetric matrix A using the factorization A = U**T*T*U or - !> A = L*T*L**T computed by ZSYTRF_AA. + !! ZSYTRS_AA solves a system of linear equations A*X = B with a complex + !! symmetric matrix A using the factorization A = U**T*T*U or + !! A = L*T*L**T computed by ZSYTRF_AA. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24158,9 +24154,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsytrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) - !> ZSYTRS_ROOK solves a system of linear equations A*X = B with - !> a complex symmetric matrix A using the factorization A = U*D*U**T or - !> A = L*D*L**T computed by ZSYTRF_ROOK. + !! ZSYTRS_ROOK solves a system of linear equations A*X = B with + !! a complex symmetric matrix A using the factorization A = U*D*U**T or + !! A = L*D*L**T computed by ZSYTRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -24380,12 +24376,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztbrfs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, x, ldx, ferr,& - !> ZTBRFS provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular band - !> coefficient matrix. - !> The solution matrix X must be computed by ZTBTRS or some other - !> means before entering this routine. ZTBRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! ZTBRFS provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular band + !! coefficient matrix. + !! The solution matrix X must be computed by ZTBTRS or some other + !! means before entering this routine. ZTBRFS does not do iterative + !! refinement because doing so cannot improve the backward error. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24623,10 +24619,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztbtrs( uplo, trans, diag, n, kd, nrhs, ab, ldab, b,ldb, info ) - !> ZTBTRS solves a triangular system of the form - !> A * X = B, A**T * X = B, or A**H * X = B, - !> where A is a triangular band matrix of order N, and B is an - !> N-by-NRHS matrix. A check is made to verify that A is nonsingular. + !! ZTBTRS solves a triangular system of the form + !! A * X = B, A**T * X = B, or A**H * X = B, + !! where A is a triangular band matrix of order N, and B is an + !! N-by-NRHS matrix. A check is made to verify that A is nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24696,14 +24692,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) - !> Level 3 BLAS like routine for A in RFP Format. - !> ZTFSM solves the matrix equation - !> op( A )*X = alpha*B or X*op( A ) = alpha*B - !> where alpha is a scalar, X and B are m by n matrices, A is a unit, or - !> non-unit, upper or lower triangular matrix and op( A ) is one of - !> op( A ) = A or op( A ) = A**H. - !> A is in Rectangular Full Packed (RFP) Format. - !> The matrix X is overwritten on B. + !! Level 3 BLAS like routine for A in RFP Format. + !! ZTFSM solves the matrix equation + !! op( A )*X = alpha*B or X*op( A ) = alpha*B + !! where alpha is a scalar, X and B are m by n matrices, A is a unit, or + !! non-unit, upper or lower triangular matrix and op( A ) is one of + !! op( A ) = A or op( A ) = A**H. + !! A is in Rectangular Full Packed (RFP) Format. + !! The matrix X is overwritten on B. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25198,8 +25194,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztfttp( transr, uplo, n, arf, ap, info ) - !> ZTFTTP copies a triangular matrix A from rectangular full packed - !> format (TF) to standard packed format (TP). + !! ZTFTTP copies a triangular matrix A from rectangular full packed + !! format (TF) to standard packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25457,8 +25453,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztfttr( transr, uplo, n, arf, a, lda, info ) - !> ZTFTTR copies a triangular matrix A from rectangular full packed - !> format (TF) to standard full format (TR). + !! ZTFTTR copies a triangular matrix A from rectangular full packed + !! format (TF) to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -25707,24 +25703,24 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztgevc( side, howmny, select, n, s, lds, p, ldp, vl,ldvl, vr, ldvr, & - !> ZTGEVC computes some or all of the right and/or left eigenvectors of - !> a pair of complex matrices (S,P), where S and P are upper triangular. - !> Matrix pairs of this type are produced by the generalized Schur - !> factorization of a complex matrix pair (A,B): - !> A = Q*S*Z**H, B = Q*P*Z**H - !> as computed by ZGGHRD + ZHGEQZ. - !> The right eigenvector x and the left eigenvector y of (S,P) - !> corresponding to an eigenvalue w are defined by: - !> S*x = w*P*x, (y**H)*S = w*(y**H)*P, - !> where y**H denotes the conjugate tranpose of y. - !> The eigenvalues are not input to this routine, but are computed - !> directly from the diagonal elements of S and P. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of (S,P), or the products Z*X and/or Q*Y, - !> where Z and Q are input matrices. - !> If Q and Z are the unitary factors from the generalized Schur - !> factorization of a matrix pair (A,B), then Z*X and Q*Y - !> are the matrices of right and left eigenvectors of (A,B). + !! ZTGEVC computes some or all of the right and/or left eigenvectors of + !! a pair of complex matrices (S,P), where S and P are upper triangular. + !! Matrix pairs of this type are produced by the generalized Schur + !! factorization of a complex matrix pair (A,B): + !! A = Q*S*Z**H, B = Q*P*Z**H + !! as computed by ZGGHRD + ZHGEQZ. + !! The right eigenvector x and the left eigenvector y of (S,P) + !! corresponding to an eigenvalue w are defined by: + !! S*x = w*P*x, (y**H)*S = w*(y**H)*P, + !! where y**H denotes the conjugate tranpose of y. + !! The eigenvalues are not input to this routine, but are computed + !! directly from the diagonal elements of S and P. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of (S,P), or the products Z*X and/or Q*Y, + !! where Z and Q are input matrices. + !! If Q and Z are the unitary factors from the generalized Schur + !! factorization of a matrix pair (A,B), then Z*X and Q*Y + !! are the matrices of right and left eigenvectors of (A,B). mm, m, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26120,15 +26116,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, j1, info ) - !> ZTGEX2 swaps adjacent diagonal 1 by 1 blocks (A11,B11) and (A22,B22) - !> in an upper triangular matrix pair (A, B) by an unitary equivalence - !> transformation. - !> (A, B) must be in generalized Schur canonical form, that is, A and - !> B are both upper triangular. - !> Optionally, the matrices Q and Z of generalized Schur vectors are - !> updated. - !> Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H - !> Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H + !! ZTGEX2 swaps adjacent diagonal 1 by 1 blocks (A11,B11) and (A22,B22) + !! in an upper triangular matrix pair (A, B) by an unitary equivalence + !! transformation. + !! (A, B) must be in generalized Schur canonical form, that is, A and + !! B are both upper triangular. + !! Optionally, the matrices Q and Z of generalized Schur vectors are + !! updated. + !! Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H + !! Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26262,16 +26258,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst, & - !> ZTGEXC reorders the generalized Schur decomposition of a complex - !> matrix pair (A,B), using an unitary equivalence transformation - !> (A, B) := Q * (A, B) * Z**H, so that the diagonal block of (A, B) with - !> row index IFST is moved to row ILST. - !> (A, B) must be in generalized Schur canonical form, that is, A and - !> B are both upper triangular. - !> Optionally, the matrices Q and Z of generalized Schur vectors are - !> updated. - !> Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H - !> Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H + !! ZTGEXC reorders the generalized Schur decomposition of a complex + !! matrix pair (A,B), using an unitary equivalence transformation + !! (A, B) := Q * (A, B) * Z**H, so that the diagonal block of (A, B) with + !! row index IFST is moved to row ILST. + !! (A, B) must be in generalized Schur canonical form, that is, A and + !! B are both upper triangular. + !! Optionally, the matrices Q and Z of generalized Schur vectors are + !! updated. + !! Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H + !! Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26346,9 +26342,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztplqt2( m, n, l, a, lda, b, ldb, t, ldt, info ) - !> ZTPLQT2 computes a LQ a factorization of a complex "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. + !! ZTPLQT2 computes a LQ a factorization of a complex "triangular-pentagonal" + !! matrix C, which is composed of a triangular block A and pentagonal block B, + !! using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26462,9 +26458,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztpqrt2( m, n, l, a, lda, b, ldb, t, ldt, info ) - !> ZTPQRT2 computes a QR factorization of a complex "triangular-pentagonal" - !> matrix C, which is composed of a triangular block A and pentagonal block B, - !> using the compact WY representation for Q. + !! ZTPQRT2 computes a QR factorization of a complex "triangular-pentagonal" + !! matrix C, which is composed of a triangular block A and pentagonal block B, + !! using the compact WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -26553,9 +26549,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztprfb( side, trans, direct, storev, m, n, k, l,v, ldv, t, ldt, a, & - !> ZTPRFB applies a complex "triangular-pentagonal" block reflector H or its - !> conjugate transpose H**H to a complex matrix C, which is composed of two - !> blocks A and B, either from the left or right. + !! ZTPRFB applies a complex "triangular-pentagonal" block reflector H or its + !! conjugate transpose H**H to a complex matrix C, which is composed of two + !! blocks A and B, either from the left or right. lda, b, ldb, work, ldwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26973,12 +26969,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztprfs( uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx,ferr, berr, & - !> ZTPRFS provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular packed - !> coefficient matrix. - !> The solution matrix X must be computed by ZTPTRS or some other - !> means before entering this routine. ZTPRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! ZTPRFS provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular packed + !! coefficient matrix. + !! The solution matrix X must be computed by ZTPTRS or some other + !! means before entering this routine. ZTPRFS does not do iterative + !! refinement because doing so cannot improve the backward error. work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27224,8 +27220,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztptri( uplo, diag, n, ap, info ) - !> ZTPTRI computes the inverse of a complex upper or lower triangular - !> matrix A stored in packed format. + !! ZTPTRI computes the inverse of a complex upper or lower triangular + !! matrix A stored in packed format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27314,11 +27310,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztptrs( uplo, trans, diag, n, nrhs, ap, b, ldb, info ) - !> ZTPTRS solves a triangular system of the form - !> A * X = B, A**T * X = B, or A**H * X = B, - !> where A is a triangular matrix of order N stored in packed format, - !> and B is an N-by-NRHS matrix. A check is made to verify that A is - !> nonsingular. + !! ZTPTRS solves a triangular system of the form + !! A * X = B, A**T * X = B, or A**H * X = B, + !! where A is a triangular matrix of order N stored in packed format, + !! and B is an N-by-NRHS matrix. A check is made to verify that A is + !! nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27387,8 +27383,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztpttf( transr, uplo, n, ap, arf, info ) - !> ZTPTTF copies a triangular matrix A from standard packed format (TP) - !> to rectangular full packed format (TF). + !! ZTPTTF copies a triangular matrix A from standard packed format (TP) + !! to rectangular full packed format (TF). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27645,8 +27641,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztpttr( uplo, n, ap, a, lda, info ) - !> ZTPTTR copies a triangular matrix A from standard packed format (TP) - !> to standard full format (TR). + !! ZTPTTR copies a triangular matrix A from standard packed format (TP) + !! to standard full format (TR). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -27699,21 +27695,21 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & - !> ZTREVC computes some or all of the right and/or left eigenvectors of - !> a complex upper triangular matrix T. - !> Matrices of this type are produced by the Schur factorization of - !> a complex general matrix: A = Q*T*Q**H, as computed by ZHSEQR. - !> The right eigenvector x and the left eigenvector y of T corresponding - !> to an eigenvalue w are defined by: - !> T*x = w*x, (y**H)*T = w*(y**H) - !> where y**H denotes the conjugate transpose of the vector y. - !> The eigenvalues are not input to this routine, but are read directly - !> from the diagonal of T. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an - !> input matrix. If Q is the unitary factor that reduces a matrix A to - !> Schur form T, then Q*X and Q*Y are the matrices of right and left - !> eigenvectors of A. + !! ZTREVC computes some or all of the right and/or left eigenvectors of + !! a complex upper triangular matrix T. + !! Matrices of this type are produced by the Schur factorization of + !! a complex general matrix: A = Q*T*Q**H, as computed by ZHSEQR. + !! The right eigenvector x and the left eigenvector y of T corresponding + !! to an eigenvalue w are defined by: + !! T*x = w*x, (y**H)*T = w*(y**H) + !! where y**H denotes the conjugate transpose of the vector y. + !! The eigenvalues are not input to this routine, but are read directly + !! from the diagonal of T. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an + !! input matrix. If Q is the unitary factor that reduces a matrix A to + !! Schur form T, then Q*X and Q*Y are the matrices of right and left + !! eigenvectors of A. work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27899,22 +27895,22 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztrevc3( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & - !> ZTREVC3 computes some or all of the right and/or left eigenvectors of - !> a complex upper triangular matrix T. - !> Matrices of this type are produced by the Schur factorization of - !> a complex general matrix: A = Q*T*Q**H, as computed by ZHSEQR. - !> The right eigenvector x and the left eigenvector y of T corresponding - !> to an eigenvalue w are defined by: - !> T*x = w*x, (y**H)*T = w*(y**H) - !> where y**H denotes the conjugate transpose of the vector y. - !> The eigenvalues are not input to this routine, but are read directly - !> from the diagonal of T. - !> This routine returns the matrices X and/or Y of right and left - !> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an - !> input matrix. If Q is the unitary factor that reduces a matrix A to - !> Schur form T, then Q*X and Q*Y are the matrices of right and left - !> eigenvectors of A. - !> This uses a Level 3 BLAS version of the back transformation. + !! ZTREVC3 computes some or all of the right and/or left eigenvectors of + !! a complex upper triangular matrix T. + !! Matrices of this type are produced by the Schur factorization of + !! a complex general matrix: A = Q*T*Q**H, as computed by ZHSEQR. + !! The right eigenvector x and the left eigenvector y of T corresponding + !! to an eigenvalue w are defined by: + !! T*x = w*x, (y**H)*T = w*(y**H) + !! where y**H denotes the conjugate transpose of the vector y. + !! The eigenvalues are not input to this routine, but are read directly + !! from the diagonal of T. + !! This routine returns the matrices X and/or Y of right and left + !! eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an + !! input matrix. If Q is the unitary factor that reduces a matrix A to + !! Schur form T, then Q*X and Q*Y are the matrices of right and left + !! eigenvectors of A. + !! This uses a Level 3 BLAS version of the back transformation. work, lwork, rwork, lrwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28196,12 +28192,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztrexc( compq, n, t, ldt, q, ldq, ifst, ilst, info ) - !> ZTREXC reorders the Schur factorization of a complex matrix - !> A = Q*T*Q**H, so that the diagonal element of T with row index IFST - !> is moved to row ILST. - !> The Schur form T is reordered by a unitary similarity transformation - !> Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by - !> postmultplying it with Z. + !! ZTREXC reorders the Schur factorization of a complex matrix + !! A = Q*T*Q**H, so that the diagonal element of T with row index IFST + !! is moved to row ILST. + !! The Schur form T is reordered by a unitary similarity transformation + !! Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by + !! postmultplying it with Z. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28275,12 +28271,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztrrfs( uplo, trans, diag, n, nrhs, a, lda, b, ldb, x,ldx, ferr, berr,& - !> ZTRRFS provides error bounds and backward error estimates for the - !> solution to a system of linear equations with a triangular - !> coefficient matrix. - !> The solution matrix X must be computed by ZTRTRS or some other - !> means before entering this routine. ZTRRFS does not do iterative - !> refinement because doing so cannot improve the backward error. + !! ZTRRFS provides error bounds and backward error estimates for the + !! solution to a system of linear equations with a triangular + !! coefficient matrix. + !! The solution matrix X must be computed by ZTRTRS or some other + !! means before entering this routine. ZTRRFS does not do iterative + !! refinement because doing so cannot improve the backward error. work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28516,9 +28512,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztrsna( job, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, s, sep, mm,& - !> ZTRSNA estimates reciprocal condition numbers for specified - !> eigenvalues and/or right eigenvectors of a complex upper triangular - !> matrix T (or of any matrix Q*T*Q**H with Q unitary). + !! ZTRSNA estimates reciprocal condition numbers for specified + !! eigenvalues and/or right eigenvectors of a complex upper triangular + !! matrix T (or of any matrix Q*T*Q**H with Q unitary). m, work, ldwork, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28665,9 +28661,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztrti2( uplo, diag, n, a, lda, info ) - !> ZTRTI2 computes the inverse of a complex upper or lower triangular - !> matrix. - !> This is the Level 2 BLAS version of the algorithm. + !! ZTRTI2 computes the inverse of a complex upper or lower triangular + !! matrix. + !! This is the Level 2 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28739,9 +28735,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztrtri( uplo, diag, n, a, lda, info ) - !> ZTRTRI computes the inverse of a complex upper or lower triangular - !> matrix A. - !> This is the Level 3 BLAS version of the algorithm. + !! ZTRTRI computes the inverse of a complex upper or lower triangular + !! matrix A. + !! This is the Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28826,10 +28822,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztrtrs( uplo, trans, diag, n, nrhs, a, lda, b, ldb,info ) - !> ZTRTRS solves a triangular system of the form - !> A * X = B, A**T * X = B, or A**H * X = B, - !> where A is a triangular matrix of order N, and B is an N-by-NRHS - !> matrix. A check is made to verify that A is nonsingular. + !! ZTRTRS solves a triangular system of the form + !! A * X = B, A**T * X = B, or A**H * X = B, + !! where A is a triangular matrix of order N, and B is an N-by-NRHS + !! matrix. A check is made to verify that A is nonsingular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -28886,8 +28882,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztrttf( transr, uplo, n, a, lda, arf, info ) - !> ZTRTTF copies a triangular matrix A from standard full format (TR) - !> to rectangular full packed format (TF) . + !! ZTRTTF copies a triangular matrix A from standard full format (TR) + !! to rectangular full packed format (TF) . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29135,8 +29131,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztrttp( uplo, n, a, lda, ap, info ) - !> ZTRTTP copies a triangular matrix A from full format (TR) to standard - !> packed format (TP). + !! ZTRTTP copies a triangular matrix A from full format (TR) to standard + !! packed format (TP). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29189,12 +29185,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztzrzf( m, n, a, lda, tau, work, lwork, info ) - !> ZTZRZF reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A - !> to upper triangular form by means of unitary transformations. - !> The upper trapezoidal matrix A is factored as - !> A = ( R 0 ) * Z, - !> where Z is an N-by-N unitary matrix and R is an M-by-M upper - !> triangular matrix. + !! ZTZRZF reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A + !! to upper triangular form by means of unitary transformations. + !! The upper trapezoidal matrix A is factored as + !! A = ( R 0 ) * Z, + !! where Z is an N-by-N unitary matrix and R is an M-by-M upper + !! triangular matrix. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29305,22 +29301,22 @@ module stdlib_linalg_lapack_z subroutine stdlib_zunbdb( trans, signs, m, p, q, x11, ldx11, x12, ldx12,x21, ldx21, x22, & - !> ZUNBDB simultaneously bidiagonalizes the blocks of an M-by-M - !> partitioned unitary matrix X: - !> [ B11 | B12 0 0 ] - !> [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**H - !> X = [-----------] = [---------] [----------------] [---------] . - !> [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] - !> [ 0 | 0 0 I ] - !> X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is - !> not the case, then X must be transposed and/or permuted. This can be - !> done in constant time using the TRANS and SIGNS options. See ZUNCSD - !> for details.) - !> The unitary matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- - !> (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are - !> represented implicitly by Householder vectors. - !> B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! ZUNBDB simultaneously bidiagonalizes the blocks of an M-by-M + !! partitioned unitary matrix X: + !! [ B11 | B12 0 0 ] + !! [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**H + !! X = [-----------] = [---------] [----------------] [---------] . + !! [ X21 | X22 ] [ | P2 ] [ B21 | B22 0 0 ] [ | Q2 ] + !! [ 0 | 0 0 I ] + !! X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is + !! not the case, then X must be transposed and/or permuted. This can be + !! done in constant time using the TRANS and SIGNS options. See ZUNCSD + !! for details.) + !! The unitary matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- + !! (M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. They are + !! represented implicitly by Householder vectors. + !! B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented + !! implicitly by angles THETA, PHI. ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29628,15 +29624,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & - !> ZUNBDB6 orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then the zero vector is returned. + !! ZUNBDB6 orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then the zero vector is returned. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29756,11 +29752,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zung2l( m, n, k, a, lda, tau, work, info ) - !> ZUNG2L generates an m by n complex matrix Q with orthonormal columns, - !> which is defined as the last n columns of a product of k elementary - !> reflectors of order m - !> Q = H(k) . . . H(2) H(1) - !> as returned by ZGEQLF. + !! ZUNG2L generates an m by n complex matrix Q with orthonormal columns, + !! which is defined as the last n columns of a product of k elementary + !! reflectors of order m + !! Q = H(k) . . . H(2) H(1) + !! as returned by ZGEQLF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29820,11 +29816,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zung2r( m, n, k, a, lda, tau, work, info ) - !> ZUNG2R generates an m by n complex matrix Q with orthonormal columns, - !> which is defined as the first n columns of a product of k elementary - !> reflectors of order m - !> Q = H(1) H(2) . . . H(k) - !> as returned by ZGEQRF. + !! ZUNG2R generates an m by n complex matrix Q with orthonormal columns, + !! which is defined as the first n columns of a product of k elementary + !! reflectors of order m + !! Q = H(1) H(2) . . . H(k) + !! as returned by ZGEQRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29885,11 +29881,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zungl2( m, n, k, a, lda, tau, work, info ) - !> ZUNGL2 generates an m-by-n complex matrix Q with orthonormal rows, - !> which is defined as the first m rows of a product of k elementary - !> reflectors of order n - !> Q = H(k)**H . . . H(2)**H H(1)**H - !> as returned by ZGELQF. + !! ZUNGL2 generates an m-by-n complex matrix Q with orthonormal rows, + !! which is defined as the first m rows of a product of k elementary + !! reflectors of order n + !! Q = H(k)**H . . . H(2)**H H(1)**H + !! as returned by ZGELQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -29956,11 +29952,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunglq( m, n, k, a, lda, tau, work, lwork, info ) - !> ZUNGLQ generates an M-by-N complex matrix Q with orthonormal rows, - !> which is defined as the first M rows of a product of K elementary - !> reflectors of order N - !> Q = H(k)**H . . . H(2)**H H(1)**H - !> as returned by ZGELQF. + !! ZUNGLQ generates an M-by-N complex matrix Q with orthonormal rows, + !! which is defined as the first M rows of a product of K elementary + !! reflectors of order N + !! Q = H(k)**H . . . H(2)**H H(1)**H + !! as returned by ZGELQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30072,11 +30068,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zungql( m, n, k, a, lda, tau, work, lwork, info ) - !> ZUNGQL generates an M-by-N complex matrix Q with orthonormal columns, - !> which is defined as the last N columns of a product of K elementary - !> reflectors of order M - !> Q = H(k) . . . H(2) H(1) - !> as returned by ZGEQLF. + !! ZUNGQL generates an M-by-N complex matrix Q with orthonormal columns, + !! which is defined as the last N columns of a product of K elementary + !! reflectors of order M + !! Q = H(k) . . . H(2) H(1) + !! as returned by ZGEQLF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30193,11 +30189,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zungqr( m, n, k, a, lda, tau, work, lwork, info ) - !> ZUNGQR generates an M-by-N complex matrix Q with orthonormal columns, - !> which is defined as the first N columns of a product of K elementary - !> reflectors of order M - !> Q = H(1) H(2) . . . H(k) - !> as returned by ZGEQRF. + !! ZUNGQR generates an M-by-N complex matrix Q with orthonormal columns, + !! which is defined as the first N columns of a product of K elementary + !! reflectors of order M + !! Q = H(1) H(2) . . . H(k) + !! as returned by ZGEQRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30309,11 +30305,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zungr2( m, n, k, a, lda, tau, work, info ) - !> ZUNGR2 generates an m by n complex matrix Q with orthonormal rows, - !> which is defined as the last m rows of a product of k elementary - !> reflectors of order n - !> Q = H(1)**H H(2)**H . . . H(k)**H - !> as returned by ZGERQF. + !! ZUNGR2 generates an m by n complex matrix Q with orthonormal rows, + !! which is defined as the last m rows of a product of k elementary + !! reflectors of order n + !! Q = H(1)**H H(2)**H . . . H(k)**H + !! as returned by ZGERQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30377,11 +30373,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zungrq( m, n, k, a, lda, tau, work, lwork, info ) - !> ZUNGRQ generates an M-by-N complex matrix Q with orthonormal rows, - !> which is defined as the last M rows of a product of K elementary - !> reflectors of order N - !> Q = H(1)**H H(2)**H . . . H(k)**H - !> as returned by ZGERQF. + !! ZUNGRQ generates an M-by-N complex matrix Q with orthonormal rows, + !! which is defined as the last M rows of a product of K elementary + !! reflectors of order N + !! Q = H(1)**H H(2)**H . . . H(k)**H + !! as returned by ZGERQF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30499,21 +30495,21 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zungtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) - !> ZUNGTSQR_ROW generates an M-by-N complex matrix Q_out with - !> orthonormal columns from the output of ZLATSQR. These N orthonormal - !> columns are the first N columns of a product of complex unitary - !> matrices Q(k)_in of order M, which are returned by ZLATSQR in - !> a special format. - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> The input matrices Q(k)_in are stored in row and column blocks in A. - !> See the documentation of ZLATSQR for more details on the format of - !> Q(k)_in, where each Q(k)_in is represented by block Householder - !> transformations. This routine calls an auxiliary routine ZLARFB_GETT, - !> where the computation is performed on each individual block. The - !> algorithm first sweeps NB-sized column blocks from the right to left - !> starting in the bottom row block and continues to the top row block - !> (hence _ROW in the routine name). This sweep is in reverse order of - !> the order in which ZLATSQR generates the output blocks. + !! ZUNGTSQR_ROW generates an M-by-N complex matrix Q_out with + !! orthonormal columns from the output of ZLATSQR. These N orthonormal + !! columns are the first N columns of a product of complex unitary + !! matrices Q(k)_in of order M, which are returned by ZLATSQR in + !! a special format. + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! The input matrices Q(k)_in are stored in row and column blocks in A. + !! See the documentation of ZLATSQR for more details on the format of + !! Q(k)_in, where each Q(k)_in is represented by block Householder + !! transformations. This routine calls an auxiliary routine ZLARFB_GETT, + !! where the computation is performed on each individual block. The + !! algorithm first sweeps NB-sized column blocks from the right to left + !! starting in the bottom row block and continues to the top row block + !! (hence _ROW in the routine name). This sweep is in reverse order of + !! the order in which ZLATSQR generates the output blocks. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30824,16 +30820,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> ZUNM2L overwrites the general complex m-by-n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(k) . . . H(2) H(1) - !> as returned by ZGEQLF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! ZUNM2L overwrites the general complex m-by-n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(k) . . . H(2) H(1) + !! as returned by ZGEQLF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -30923,16 +30919,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> ZUNM2R overwrites the general complex m-by-n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by ZGEQRF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! ZUNM2R overwrites the general complex m-by-n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by ZGEQRF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31026,16 +31022,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunml2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> ZUNML2 overwrites the general complex m-by-n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(k)**H . . . H(2)**H H(1)**H - !> as returned by ZGELQF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! ZUNML2 overwrites the general complex m-by-n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(k)**H . . . H(2)**H H(1)**H + !! as returned by ZGELQF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31132,15 +31128,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunmlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> ZUNMLQ 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(k)**H . . . H(2)**H H(1)**H - !> as returned by ZGELQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! ZUNMLQ 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(k)**H . . . H(2)**H H(1)**H + !! as returned by ZGELQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31275,15 +31271,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunmql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> ZUNMQL 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(k) . . . H(2) H(1) - !> as returned by ZGEQLF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! ZUNMQL 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(k) . . . H(2) H(1) + !! as returned by ZGEQLF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31412,15 +31408,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunmqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> ZUNMQR 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) - !> as returned by ZGEQRF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! ZUNMQR 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) + !! as returned by ZGEQRF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31549,16 +31545,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunmr2( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) - !> ZUNMR2 overwrites the general complex m-by-n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(1)**H H(2)**H . . . H(k)**H - !> as returned by ZGERQF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! ZUNMR2 overwrites the general complex m-by-n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(1)**H H(2)**H . . . H(k)**H + !! as returned by ZGERQF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -31650,16 +31646,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunmr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, info ) - !> ZUNMR3 overwrites the general complex m by n matrix C with - !> Q * C if SIDE = 'L' and TRANS = 'N', or - !> Q**H* C if SIDE = 'L' and TRANS = 'C', or - !> C * Q if SIDE = 'R' and TRANS = 'N', or - !> C * Q**H if SIDE = 'R' and TRANS = 'C', - !> where Q is a complex unitary matrix defined as the product of k - !> elementary reflectors - !> Q = H(1) H(2) . . . H(k) - !> as returned by ZTZRZF. Q is of order m if SIDE = 'L' and of order n - !> if SIDE = 'R'. + !! ZUNMR3 overwrites the general complex m by n matrix C with + !! Q * C if SIDE = 'L' and TRANS = 'N', or + !! Q**H* C if SIDE = 'L' and TRANS = 'C', or + !! C * Q if SIDE = 'R' and TRANS = 'N', or + !! C * Q**H if SIDE = 'R' and TRANS = 'C', + !! where Q is a complex unitary matrix defined as the product of k + !! elementary reflectors + !! Q = H(1) H(2) . . . H(k) + !! as returned by ZTZRZF. Q is of order m if SIDE = 'L' and of order n + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31755,15 +31751,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunmrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, info ) - !> ZUNMRQ 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 H(2)**H . . . H(k)**H - !> as returned by ZGERQF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! ZUNMRQ 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 H(2)**H . . . H(k)**H + !! as returned by ZGERQF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31898,15 +31894,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunmrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & - !> ZUNMRZ 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) - !> as returned by ZTZRZF. Q is of order M if SIDE = 'L' and of order N - !> if SIDE = 'R'. + !! ZUNMRZ 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) + !! as returned by ZTZRZF. Q is of order M if SIDE = 'L' and of order N + !! if SIDE = 'R'. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32053,27 +32049,27 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zbbcsd( jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q,theta, phi, u1, & - !> ZBBCSD 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 ZUNCSD 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. + !! ZBBCSD 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 ZUNCSD 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. ldu1, u2, ldu2, v1t, ldv1t,v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e,b22d, b22e, rwork, & lrwork, info ) ! -- lapack computational routine -- @@ -32666,30 +32662,30 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, rwork,& - !> ZBDSQR 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 ZGEBRD, 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. + !! ZBDSQR 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 ZGEBRD, 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33129,12 +33125,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgbcon( norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond,work, rwork, & - !> ZGBCON 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 ZGBTRF. - !> 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)) ). + !! ZGBCON 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 ZGBTRF. + !! 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)) ). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33263,9 +33259,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgbtrf( m, n, kl, ku, ab, ldab, ipiv, info ) - !> ZGBTRF 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. + !! ZGBTRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33513,10 +33509,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgbtrs( trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb,info ) - !> ZGBTRS 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 ZGBTRF. + !! ZGBTRS 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 ZGBTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33626,9 +33622,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgebd2( m, n, a, lda, d, e, tauq, taup, work, info ) - !> ZGEBD2 reduces a complex general m by n matrix A to upper or lower - !> real 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. + !! ZGEBD2 reduces a complex general m by n matrix A to upper or lower + !! real 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33724,12 +33720,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgecon( norm, n, a, lda, anorm, rcond, work, rwork,info ) - !> ZGECON 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 ZGETRF. - !> 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)) ). + !! ZGECON 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 ZGETRF. + !! 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)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33830,8 +33826,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgehd2( n, ilo, ihi, a, lda, tau, work, info ) - !> ZGEHD2 reduces a complex general matrix A to upper Hessenberg form H - !> by a unitary similarity transformation: Q**H * A * Q = H . + !! ZGEHD2 reduces a complex general matrix A to upper Hessenberg form H + !! by a unitary similarity transformation: Q**H * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33882,12 +33878,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgelq2( m, n, a, lda, tau, work, info ) - !> ZGELQ2 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. + !! ZGELQ2 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -33938,12 +33934,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgelqf( m, n, a, lda, tau, work, lwork, info ) - !> ZGELQF 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. + !! ZGELQF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34035,10 +34031,10 @@ module stdlib_linalg_lapack_z pure recursive subroutine stdlib_zgelqt3( m, n, a, lda, t, ldt, info ) - !> ZGELQT3 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. + !! ZGELQT3 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34125,15 +34121,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgemlqt( side, trans, m, n, k, mb, v, ldv, t, ldt,c, ldc, work, info ) - !> ZGEMLQT 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 ZGELQT. - !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. + !! ZGEMLQT 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 ZGELQT. + !! Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34223,15 +34219,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgemqrt( side, trans, m, n, k, nb, v, ldv, t, ldt,c, ldc, work, info ) - !> ZGEMQRT 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 ZGEQRT. - !> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. + !! ZGEMQRT 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 ZGEQRT. + !! Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34321,8 +34317,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgeql2( m, n, a, lda, tau, work, info ) - !> ZGEQL2 computes a QL factorization of a complex m by n matrix A: - !> A = Q * L. + !! ZGEQL2 computes a QL factorization of a complex m by n matrix A: + !! A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34370,8 +34366,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgeqlf( m, n, a, lda, tau, work, lwork, info ) - !> ZGEQLF computes a QL factorization of a complex M-by-N matrix A: - !> A = Q * L. + !! ZGEQLF computes a QL factorization of a complex M-by-N matrix A: + !! A = Q * L. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34476,13 +34472,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgeqr2( m, n, a, lda, tau, work, info ) - !> ZGEQR2 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. + !! ZGEQR2 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34531,14 +34527,14 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgeqr2p( m, n, a, lda, tau, work, info ) - !> ZGEQR2P 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. + !! ZGEQR2P 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34587,13 +34583,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgeqrf( m, n, a, lda, tau, work, lwork, info ) - !> ZGEQRF 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. + !! ZGEQRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34689,14 +34685,14 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgeqrfp( m, n, a, lda, tau, work, lwork, info ) - !> ZGEQR2P 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. + !! ZGEQR2P 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34788,8 +34784,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgeqrt2( m, n, a, lda, t, ldt, info ) - !> ZGEQRT2 computes a QR factorization of a complex M-by-N matrix A, - !> using the compact WY representation of Q. + !! ZGEQRT2 computes a QR factorization of a complex M-by-N matrix A, + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34856,10 +34852,10 @@ module stdlib_linalg_lapack_z pure recursive subroutine stdlib_zgeqrt3( m, n, a, lda, t, ldt, info ) - !> ZGEQRT3 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. + !! ZGEQRT3 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34944,8 +34940,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgerq2( m, n, a, lda, tau, work, info ) - !> ZGERQ2 computes an RQ factorization of a complex m by n matrix A: - !> A = R * Q. + !! ZGERQ2 computes an RQ factorization of a complex m by n matrix A: + !! A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -34995,8 +34991,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgerqf( m, n, a, lda, tau, work, lwork, info ) - !> ZGERQF computes an RQ factorization of a complex M-by-N matrix A: - !> A = R * Q. + !! ZGERQF computes an RQ factorization of a complex M-by-N matrix A: + !! A = R * Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35101,10 +35097,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgesc2( n, a, lda, rhs, ipiv, jpiv, scale ) - !> ZGESC2 solves a system of linear equations - !> A * X = scale* RHS - !> with a general N-by-N matrix A using the LU factorization with - !> complete pivoting computed by ZGETC2. + !! ZGESC2 solves a system of linear equations + !! A * X = scale* RHS + !! with a general N-by-N matrix A using the LU factorization with + !! complete pivoting computed by ZGETC2. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35160,25 +35156,25 @@ module stdlib_linalg_lapack_z pure recursive subroutine stdlib_zgetrf2( m, n, a, lda, ipiv, info ) - !> ZGETRF2 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. + !! ZGETRF2 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35276,10 +35272,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgetri( n, a, lda, ipiv, work, lwork, info ) - !> ZGETRI computes the inverse of a matrix using the LU factorization - !> computed by ZGETRF. - !> This method inverts U and then computes inv(A) by solving the system - !> inv(A)*L = inv(U) for inv(A). + !! ZGETRI computes the inverse of a matrix using the LU factorization + !! computed by ZGETRF. + !! This method inverts U and then computes inv(A) by solving the system + !! inv(A)*L = inv(U) for inv(A). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35378,10 +35374,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgetrs( trans, n, nrhs, a, lda, ipiv, b, ldb, info ) - !> ZGETRS 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 ZGETRF. + !! ZGETRS 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 ZGETRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35447,29 +35443,29 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & - !> ZGGHRD 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 ZGGHRD reduces the original - !> problem to generalized Hessenberg form. + !! ZGGHRD 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 ZGGHRD reduces the original + !! problem to generalized Hessenberg form. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35579,24 +35575,24 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) - !> ZGGQRF 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**H denotes the - !> conjugate transpose of matrix Z. + !! ZGGQRF 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**H denotes the + !! conjugate transpose of matrix Z. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35657,24 +35653,24 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zggrqf( m, p, n, a, lda, taua, b, ldb, taub, work,lwork, info ) - !> ZGGRQF 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. + !! ZGGRQF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35735,10 +35731,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgttrs( trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb,info ) - !> ZGTTRS 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 ZGTTRF. + !! ZGTTRS 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 ZGTTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -35801,8 +35797,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhb2st_kernels( uplo, wantz, ttype,st, ed, sweep, n, nb, ib,a, lda, & - !> ZHB2ST_KERNELS is an internal routine used by the ZHETRD_HB2ST - !> subroutine. + !! ZHB2ST_KERNELS is an internal routine used by the ZHETRD_HB2ST + !! subroutine. v, tau, ldvt, work) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35946,13 +35942,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zheequb( uplo, n, a, lda, s, scond, amax, work, info ) - !> ZHEEQUB 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. + !! ZHEEQUB 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36128,13 +36124,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhegs2( itype, uplo, n, a, lda, b, ldb, info ) - !> ZHEGS2 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 ZPOTRF. + !! ZHEGS2 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 ZPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36261,13 +36257,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhegst( itype, uplo, n, a, lda, b, ldb, info ) - !> ZHEGST 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 ZPOTRF. + !! ZHEGST 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 ZPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36400,9 +36396,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetd2( uplo, n, a, lda, d, e, tau, info ) - !> ZHETD2 reduces a complex Hermitian matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. + !! ZHETD2 reduces a complex Hermitian matrix A to real symmetric + !! tridiagonal form T by a unitary similarity transformation: + !! Q**H * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36504,9 +36500,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetrd( uplo, n, a, lda, d, e, tau, work, lwork, info ) - !> ZHETRD reduces a complex Hermitian matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. + !! ZHETRD reduces a complex Hermitian matrix A to real symmetric + !! tridiagonal form T by a unitary similarity transformation: + !! Q**H * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -36632,9 +36628,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetrd_hb2st( stage1, vect, uplo, n, kd, ab, ldab,d, e, hous, lhous, & - !> ZHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. + !! ZHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric + !! tridiagonal form T by a unitary similarity transformation: + !! Q**H * A * Q = T. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36905,9 +36901,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetrd_he2hb( uplo, n, kd, a, lda, ab, ldab, tau,work, lwork, info ) - !> ZHETRD_HE2HB reduces a complex Hermitian matrix A to complex Hermitian - !> band-diagonal form AB by a unitary similarity transformation: - !> Q**H * A * Q = AB. + !! ZHETRD_HE2HB reduces a complex Hermitian matrix A to complex Hermitian + !! band-diagonal form AB by a unitary similarity transformation: + !! Q**H * A * Q = AB. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -37081,14 +37077,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetrf( uplo, n, a, lda, ipiv, work, lwork, info ) - !> ZHETRF 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. + !! ZHETRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37207,15 +37203,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) - !> ZHETRF_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. + !! ZHETRF_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37373,14 +37369,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) - !> ZHETRF_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. + !! ZHETRF_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37501,9 +37497,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetrs( uplo, n, nrhs, a, lda, ipiv, b, ldb, info ) - !> ZHETRS 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 ZHETRF. + !! ZHETRS 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 ZHETRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37732,9 +37728,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetrs2( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, info ) - !> ZHETRS2 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 ZHETRF and converted by ZSYCONV. + !! ZHETRS2 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 ZHETRF and converted by ZSYCONV. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -37913,9 +37909,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetrs_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb,work, lwork, info ) - !> ZHETRS_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 ZHETRF_AA. + !! ZHETRS_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 ZHETRF_AA. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38034,9 +38030,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetrs_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb,info ) - !> ZHETRS_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 ZHETRF_ROOK. + !! ZHETRS_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 ZHETRF_ROOK. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38273,9 +38269,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhptrd( uplo, n, ap, d, e, tau, info ) - !> ZHPTRD 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. + !! ZHPTRD 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38377,9 +38373,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhptrs( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> ZHPTRS 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 ZHPTRF. + !! ZHPTRS 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 ZHPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -38618,8 +38614,8 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zla_gbrcond_c( trans, n, kl, ku, ab,ldab, afb, ldafb, ipiv,c, & - !> ZLA_GBRCOND_C Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. + !! ZLA_GBRCOND_C Computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. capply, info, work,rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38766,8 +38762,8 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zla_gercond_c( trans, n, a, lda, af,ldaf, ipiv, c, capply,info, & - !> ZLA_GERCOND_C computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. + !! ZLA_GERCOND_C computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. work, rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38907,8 +38903,8 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zla_hercond_c( uplo, n, a, lda, af,ldaf, ipiv, c, capply,info, work,& - !> ZLA_HERCOND_C computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. + !! ZLA_HERCOND_C computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39057,12 +39053,12 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zla_herpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39246,8 +39242,8 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zla_porcond_c( uplo, n, a, lda, af,ldaf, c, capply, info,work, & - !> ZLA_PORCOND_C Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector + !! ZLA_PORCOND_C Computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39396,8 +39392,8 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zla_syrcond_c( uplo, n, a, lda, af,ldaf, ipiv, c, capply,info, work,& - !> ZLA_SYRCOND_C Computes the infinity norm condition number of - !> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. + !! ZLA_SYRCOND_C Computes the infinity norm condition number of + !! op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector. rwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39547,12 +39543,12 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zla_syrpvgrw( uplo, n, info, a, lda, af,ldaf, ipiv, work ) - !> ZLA_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. + !! ZLA_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39736,13 +39732,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlabrd( m, n, nb, a, lda, d, e, tauq, taup, x, ldx, y,ldy ) - !> ZLABRD 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 ZGEBRD + !! ZLABRD 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 ZGEBRD ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -39886,30 +39882,30 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaed7( n, cutpnt, qsiz, tlvls, curlvl, curpbm, d, q,ldq, rho, indxq, & - !> ZLAED7 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 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 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. + !! ZLAED7 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 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 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. qstore, qptr, prmptr, perm,givptr, givcol, givnum, work, rwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40013,9 +40009,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaein( rightv, noinit, n, h, ldh, w, v, b, ldb, rwork,eps3, smlnum, & - !> ZLAEIN uses inverse iteration to find a right or left eigenvector - !> corresponding to the eigenvalue W of a complex upper Hessenberg - !> matrix H. + !! ZLAEIN uses inverse iteration to find a right or left eigenvector + !! corresponding to the eigenvalue W of a complex upper Hessenberg + !! matrix H. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40157,30 +40153,30 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlags2( upper, a1, a2, a3, b1, b2, b3, csu, snu, csv,snv, csq, snq ) - !> ZLAGS2 computes 2-by-2 unitary matrices U, V and Q, such - !> that if ( UPPER ) then - !> U**H *A*Q = U**H *( A1 A2 )*Q = ( x 0 ) - !> ( 0 A3 ) ( x x ) - !> and - !> V**H*B*Q = V**H *( B1 B2 )*Q = ( x 0 ) - !> ( 0 B3 ) ( x x ) - !> or if ( .NOT.UPPER ) then - !> U**H *A*Q = U**H *( A1 0 )*Q = ( x x ) - !> ( A2 A3 ) ( 0 x ) - !> and - !> V**H *B*Q = V**H *( B1 0 )*Q = ( x x ) - !> ( B2 B3 ) ( 0 x ) - !> where - !> U = ( CSU SNU ), V = ( CSV SNV ), - !> ( -SNU**H CSU ) ( -SNV**H CSV ) - !> Q = ( CSQ SNQ ) - !> ( -SNQ**H CSQ ) - !> The rows of the transformed A and B are parallel. Moreover, if the - !> input 2-by-2 matrix A is not zero, then the transformed (1,1) entry - !> of A is not zero. If the input matrices A and B are both not zero, - !> then the transformed (2,2) element of B is not zero, except when the - !> first rows of input A and B are parallel and the second rows are - !> zero. + !! ZLAGS2 computes 2-by-2 unitary matrices U, V and Q, such + !! that if ( UPPER ) then + !! U**H *A*Q = U**H *( A1 A2 )*Q = ( x 0 ) + !! ( 0 A3 ) ( x x ) + !! and + !! V**H*B*Q = V**H *( B1 B2 )*Q = ( x 0 ) + !! ( 0 B3 ) ( x x ) + !! or if ( .NOT.UPPER ) then + !! U**H *A*Q = U**H *( A1 0 )*Q = ( x x ) + !! ( A2 A3 ) ( 0 x ) + !! and + !! V**H *B*Q = V**H *( B1 0 )*Q = ( x x ) + !! ( B2 B3 ) ( 0 x ) + !! where + !! U = ( CSU SNU ), V = ( CSV SNV ), + !! ( -SNU**H CSU ) ( -SNV**H CSV ) + !! Q = ( CSQ SNQ ) + !! ( -SNQ**H CSQ ) + !! The rows of the transformed A and B are parallel. Moreover, if the + !! input 2-by-2 matrix A is not zero, then the transformed (1,1) entry + !! of A is not zero. If the input matrices A and B are both not zero, + !! then the transformed (2,2) element of B is not zero, except when the + !! first rows of input A and B are parallel and the second rows are + !! zero. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40344,10 +40340,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, info & - !> ZLAHQR 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. + !! ZLAHQR 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. ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40630,12 +40626,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlahr2( n, k, nb, a, lda, tau, t, ldt, y, ldy ) - !> ZLAHR2 reduces the first NB columns of A complex general n-BY-(n-k+1) - !> matrix A so that elements below the k-th subdiagonal are zero. The - !> reduction is performed by an unitary similarity transformation - !> Q**H * A * Q. The routine returns the matrices V and T which determine - !> Q as a block reflector I - V*T*V**H, and also the matrix Y = A * V * T. - !> This is an auxiliary routine called by ZGEHRD. + !! ZLAHR2 reduces the first NB columns of A complex general n-BY-(n-k+1) + !! matrix A so that elements below the k-th subdiagonal are zero. The + !! reduction is performed by an unitary similarity transformation + !! Q**H * A * Q. The routine returns the matrices V and T which determine + !! Q as a block reflector I - V*T*V**H, and also the matrix Y = A * V * T. + !! This is an auxiliary routine called by ZGEHRD. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -40720,26 +40716,26 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlals0( icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx,perm, givptr, & - !> ZLALS0 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). + !! ZLALS0 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). givcol, ldgcol, givnum, ldgnum,poles, difl, difr, z, k, c, s, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40965,15 +40961,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlalsa( icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u,ldu, vt, k, difl,& - !> ZLALSA 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, ZLALSA applies the inverse of the left singular vector - !> matrix of an upper bidiagonal matrix to the right hand side; and if - !> ICOMPQ = 1, ZLALSA applies the right singular vector matrix to the - !> right hand side. The singular vector matrices were generated in - !> compact form by ZLALSA. + !! ZLALSA 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, ZLALSA applies the inverse of the left singular vector + !! matrix of an upper bidiagonal matrix to the right hand side; and if + !! ICOMPQ = 1, ZLALSA applies the right singular vector matrix to the + !! right hand side. The singular vector matrices were generated in + !! compact form by ZLALSA. difr, z, poles, givptr,givcol, ldgcol, perm, givnum, c, s, rwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41268,20 +41264,20 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlalsd( uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond,rank, work, rwork, & - !> ZLALSD 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. + !! ZLALSD 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. iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41679,9 +41675,9 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zlangb( norm, n, kl, ku, ab, ldab,work ) - !> ZLANGB 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. + !! ZLANGB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41754,9 +41750,9 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zlange( norm, m, n, a, lda, work ) - !> ZLANGE 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. + !! ZLANGE 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41826,9 +41822,9 @@ module stdlib_linalg_lapack_z pure real(dp) function stdlib_zlangt( norm, n, dl, d, du ) - !> ZLANGT 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. + !! ZLANGT 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -41902,9 +41898,9 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zlanhb( norm, uplo, n, k, ab, ldab,work ) - !> ZLANHB 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. + !! ZLANHB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42021,9 +42017,9 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zlanhe( norm, uplo, n, a, lda, work ) - !> ZLANHE 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. + !! ZLANHE 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -42131,9 +42127,9 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zlanhf( norm, transr, uplo, n, a, work ) - !> ZLANHF 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. + !! ZLANHF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43351,9 +43347,9 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zlanhp( norm, uplo, n, ap, work ) - !> ZLANHP 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. + !! ZLANHP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43479,9 +43475,9 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zlanhs( norm, n, a, lda, work ) - !> ZLANHS 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. + !! ZLANHS 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43551,9 +43547,9 @@ module stdlib_linalg_lapack_z pure real(dp) function stdlib_zlanht( norm, n, d, e ) - !> ZLANHT 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. + !! ZLANHT 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43614,9 +43610,9 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zlansb( norm, uplo, n, k, ab, ldab,work ) - !> ZLANSB 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. + !! ZLANSB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43719,9 +43715,9 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zlansp( norm, uplo, n, ap, work ) - !> ZLANSP 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. + !! ZLANSP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43852,9 +43848,9 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zlansy( norm, uplo, n, a, lda, work ) - !> ZLANSY 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. + !! ZLANSY 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -43948,9 +43944,9 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zlantb( norm, uplo, diag, n, k, ab,ldab, work ) - !> ZLANTB 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. + !! ZLANTB 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44141,9 +44137,9 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zlantp( norm, uplo, diag, n, ap, work ) - !> ZLANTP 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. + !! ZLANTP 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44347,9 +44343,9 @@ module stdlib_linalg_lapack_z real(dp) function stdlib_zlantr( norm, uplo, diag, m, n, a, lda,work ) - !> ZLANTR 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. + !! ZLANTR 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44533,12 +44529,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlapll( n, x, incx, y, incy, ssmin ) - !> 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. + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44577,9 +44573,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqp2( m, n, offset, a, lda, jpvt, tau, vn1, vn2,work ) - !> ZLAQP2 computes a QR factorization with column pivoting of - !> the block A(OFFSET+1:M,1:N). - !> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. + !! ZLAQP2 computes a QR factorization with column pivoting of + !! the block A(OFFSET+1:M,1:N). + !! The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -44657,14 +44653,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & - !> ZLAQPS 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. + !! ZLAQPS 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. ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -44800,8 +44796,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqr5( wantt, wantz, kacc22, n, ktop, kbot, nshfts, s,h, ldh, iloz, & - !> ZLAQR5 , called by ZLAQR0, performs a - !> single small-bulge multi-shift QR sweep. + !! ZLAQR5 , called by ZLAQR0, performs a + !! single small-bulge multi-shift QR sweep. ihiz, z, ldz, v, ldv, u, ldu, nv,wv, ldwv, nh, wh, ldwh ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45198,7 +45194,7 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqz1( ilq, ilz, k, istartm, istopm, ihi, a, lda, b,ldb, nq, qstart, & - !> ZLAQZ1 chases a 1x1 shift bulge in a matrix pencil down a single position + !! ZLAQZ1 chases a 1x1 shift bulge in a matrix pencil down a single position q, ldq, nz, zstart, z, ldz ) ! arguments logical(lk), intent( in ) :: ilq, ilz @@ -45252,7 +45248,7 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqz3( ilschur, ilq, ilz, n, ilo, ihi, nshifts,nblock_desired, alpha,& - !> ZLAQZ3 Executes a single multishift QZ sweep + !! ZLAQZ3 Executes a single multishift QZ sweep beta, a, lda, b, ldb,q, ldq, z, ldz, qc, ldqc, zc, ldzc, work,lwork, info ) ! function arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -45492,16 +45488,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlargv( n, x, incx, y, incy, c, incc ) - !> ZLARGV 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 ZLARTG, - !> but differ from the BLAS1 routine ZROTG): - !> 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. + !! ZLARGV 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 ZLARTG, + !! but differ from the BLAS1 routine ZROTG): + !! 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -45646,9 +45642,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlarrv( n, vl, vu, d, l, pivmin,isplit, m, dol, dou, minrgp,rtol1, & - !> ZLARRV 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 DLARRE. + !! ZLARRV 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 DLARRE. rtol2, w, werr, wgap,iblock, indexw, gers, z, ldz, isuppz,work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46296,14 +46292,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) - !> ZLATDF 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 ZGETC2. On entry RHS = f holds the - !> contribution from earlier solved sub-systems, and on return RHS = x. - !> The factorization of Z returned by ZGETC2 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. + !! ZLATDF 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 ZGETC2. On entry RHS = f holds the + !! contribution from earlier solved sub-systems, and on return RHS = x. + !! The factorization of Z returned by ZGETC2 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46410,39 +46406,39 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaunhr_col_getrfnp( m, n, a, lda, d, info ) - !> ZLAUNHR_COL_GETRFNP computes the modified LU factorization without - !> pivoting of a complex 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 ZUNHR_COL. In ZUNHR_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 ZLAUNHR_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. + !! ZLAUNHR_COL_GETRFNP computes the modified LU factorization without + !! pivoting of a complex 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 ZUNHR_COL. In ZUNHR_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 ZLAUNHR_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46504,10 +46500,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b,ldb, x, ldx, ferr, & - !> ZPBRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite - !> and banded, and provides error bounds and backward error estimates - !> for the solution. + !! ZPBRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite + !! and banded, and provides error bounds and backward error estimates + !! for the solution. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46702,12 +46698,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpbtrf( uplo, n, kd, ab, ldab, info ) - !> ZPBTRF computes the Cholesky factorization of a complex Hermitian - !> positive definite band matrix A. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. + !! ZPBTRF computes the Cholesky factorization of a complex Hermitian + !! positive definite band matrix A. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46902,9 +46898,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpftrs( transr, uplo, n, nrhs, a, b, ldb, info ) - !> ZPFTRS solves a system of linear equations A*X = B with a Hermitian - !> positive definite matrix A using the Cholesky factorization - !> A = U**H*U or A = L*L**H computed by ZPFTRF. + !! ZPFTRS solves a system of linear equations A*X = B with a Hermitian + !! positive definite matrix A using the Cholesky factorization + !! A = U**H*U or A = L*L**H computed by ZPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -46956,10 +46952,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zporfs( uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x,ldx, ferr, berr, & - !> ZPORFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite, - !> and provides error bounds and backward error estimates for the - !> solution. + !! ZPORFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite, + !! and provides error bounds and backward error estimates for the + !! solution. work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47149,13 +47145,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpotrf( uplo, n, a, lda, info ) - !> ZPOTRF computes the Cholesky factorization of a complex Hermitian - !> positive definite matrix A. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the block version of the algorithm, calling Level 3 BLAS. + !! ZPOTRF computes the Cholesky factorization of a complex Hermitian + !! positive definite matrix A. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the block version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47244,9 +47240,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpotri( uplo, n, a, lda, info ) - !> ZPOTRI computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by ZPOTRF. + !! ZPOTRI computes the inverse of a complex Hermitian positive definite + !! matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !! computed by ZPOTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47285,10 +47281,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr,berr, work, & - !> ZPPRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite - !> and packed, and provides error bounds and backward error estimates - !> for the solution. + !! ZPPRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite + !! and packed, and provides error bounds and backward error estimates + !! for the solution. rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47481,16 +47477,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zppsv( uplo, n, nrhs, ap, b, ldb, info ) - !> ZPPSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix stored in - !> packed format and X and B are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is a lower triangular - !> matrix. The factored form of A is then used to solve the system of - !> equations A * X = B. + !! ZPPSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix stored in + !! packed format and X and B are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is a lower triangular + !! matrix. The factored form of A is then used to solve the system of + !! equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47530,13 +47526,13 @@ module stdlib_linalg_lapack_z subroutine stdlib_zppsvx( fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb,x, ldx, rcond, ferr,& - !> ZPPSVX uses the Cholesky factorization A = U**H * U or A = L * L**H to - !> compute the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix stored in - !> packed format and X and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZPPSVX uses the Cholesky factorization A = U**H * U or A = L * L**H to + !! compute the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix stored in + !! packed format and X and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47670,9 +47666,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpptri( uplo, n, ap, info ) - !> ZPPTRI computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by ZPPTRF. + !! ZPPTRI computes the inverse of a complex Hermitian positive definite + !! matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !! computed by ZPPTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47734,21 +47730,21 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpteqr( compz, n, d, e, z, ldz, work, info ) - !> ZPTEQR computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric positive definite tridiagonal matrix by first factoring the - !> matrix using DPTTRF and then calling ZBDSQR to compute the singular - !> values of the bidiagonal factor. - !> This routine computes the eigenvalues of the positive definite - !> tridiagonal matrix to high relative accuracy. This means that if the - !> eigenvalues range over many orders of magnitude in size, then the - !> small eigenvalues and corresponding eigenvectors will be computed - !> more accurately than, for example, with the standard QR method. - !> The eigenvectors of a full or band positive definite Hermitian matrix - !> can also be found if ZHETRD, ZHPTRD, or ZHBTRD has been used to - !> reduce this matrix to tridiagonal form. (The reduction to - !> tridiagonal form, however, may preclude the possibility of obtaining - !> high relative accuracy in the small eigenvalues of the original - !> matrix, if these eigenvalues range over many orders of magnitude.) + !! ZPTEQR computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric positive definite tridiagonal matrix by first factoring the + !! matrix using DPTTRF and then calling ZBDSQR to compute the singular + !! values of the bidiagonal factor. + !! This routine computes the eigenvalues of the positive definite + !! tridiagonal matrix to high relative accuracy. This means that if the + !! eigenvalues range over many orders of magnitude in size, then the + !! small eigenvalues and corresponding eigenvectors will be computed + !! more accurately than, for example, with the standard QR method. + !! The eigenvectors of a full or band positive definite Hermitian matrix + !! can also be found if ZHETRD, ZHPTRD, or ZHBTRD has been used to + !! reduce this matrix to tridiagonal form. (The reduction to + !! tridiagonal form, however, may preclude the possibility of obtaining + !! high relative accuracy in the small eigenvalues of the original + !! matrix, if these eigenvalues range over many orders of magnitude.) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47829,12 +47825,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpttrs( uplo, n, nrhs, d, e, b, ldb, info ) - !> ZPTTRS solves a tridiagonal system of the form - !> A * X = B - !> using the factorization A = U**H *D* U or A = L*D*L**H computed by ZPTTRF. - !> D is a diagonal matrix specified in the vector D, U (or L) is a unit - !> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in - !> the vector E, and X and B are N by NRHS matrices. + !! ZPTTRS solves a tridiagonal system of the form + !! A * X = B + !! using the factorization A = U**H *D* U or A = L*D*L**H computed by ZPTTRF. + !! D is a diagonal matrix specified in the vector D, U (or L) is a unit + !! bidiagonal matrix whose superdiagonal (subdiagonal) is specified in + !! the vector E, and X and B are N by NRHS matrices. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47896,11 +47892,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zspcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) - !> ZSPCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex symmetric packed matrix A using the - !> factorization A = U*D*U**T or A = L*D*L**T computed by ZSPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZSPCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex symmetric packed matrix A using the + !! factorization A = U*D*U**T or A = L*D*L**T computed by ZSPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -47977,10 +47973,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& - !> ZSPRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite - !> and packed, and provides error bounds and backward error estimates - !> for the solution. + !! ZSPRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric indefinite + !! and packed, and provides error bounds and backward error estimates + !! for the solution. rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48174,17 +48170,17 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> ZSPSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric 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**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, D is symmetric 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. + !! ZSPSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric 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**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, D is symmetric 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48225,12 +48221,12 @@ module stdlib_linalg_lapack_z subroutine stdlib_zspsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & - !> ZSPSVX uses the diagonal pivoting factorization A = U*D*U**T or - !> A = L*D*L**T to compute the solution to a complex system of linear - !> equations A * X = B, where A is an N-by-N symmetric matrix stored - !> in packed format and X and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZSPSVX uses the diagonal pivoting factorization A = U*D*U**T or + !! A = L*D*L**T to compute the solution to a complex system of linear + !! equations A * X = B, where A is an N-by-N symmetric matrix stored + !! in packed format and X and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48303,65 +48299,65 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zstemr( jobz, range, n, d, e, vl, vu, il, iu,m, w, z, ldz, nzc, & - !> ZSTEMR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has - !> a well defined set of pairwise different real eigenvalues, the corresponding - !> real eigenvectors are pairwise orthogonal. - !> The spectrum may be computed either completely or partially by specifying - !> either an interval (VL,VU] or a range of indices IL:IU for the desired - !> eigenvalues. - !> Depending on the number of desired eigenvalues, these are computed either - !> by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are - !> computed by the use of various suitable L D L^T factorizations near clusters - !> of close eigenvalues (referred to as RRRs, Relatively Robust - !> Representations). An informal sketch of the algorithm 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. - !> For more details, see: - !> - 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. - !> Further Details - !> 1.ZSTEMR works only on machines which follow IEEE-754 - !> floating-point standard in their handling of infinities and NaNs. - !> This permits the use of efficient inner loops avoiding a check for - !> zero divisors. - !> 2. LAPACK routines can be used to reduce a complex Hermitean matrix to - !> real symmetric tridiagonal form. - !> (Any complex Hermitean tridiagonal matrix has real values on its diagonal - !> and potentially complex numbers on its off-diagonals. By applying a - !> similarity transform with an appropriate diagonal matrix - !> diag(1,e^{i \phy_1}, ... , e^{i \phy_{n-1}}), the complex Hermitean - !> matrix can be transformed into a real symmetric matrix and complex - !> arithmetic can be entirely avoided.) - !> While the eigenvectors of the real symmetric tridiagonal matrix are real, - !> the eigenvectors of original complex Hermitean matrix have complex entries - !> in general. - !> Since LAPACK drivers overwrite the matrix data with the eigenvectors, - !> ZSTEMR accepts complex workspace to facilitate interoperability - !> with ZUNMTR or ZUPMTR. + !! ZSTEMR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Any such unreduced matrix has + !! a well defined set of pairwise different real eigenvalues, the corresponding + !! real eigenvectors are pairwise orthogonal. + !! The spectrum may be computed either completely or partially by specifying + !! either an interval (VL,VU] or a range of indices IL:IU for the desired + !! eigenvalues. + !! Depending on the number of desired eigenvalues, these are computed either + !! by bisection or the dqds algorithm. Numerically orthogonal eigenvectors are + !! computed by the use of various suitable L D L^T factorizations near clusters + !! of close eigenvalues (referred to as RRRs, Relatively Robust + !! Representations). An informal sketch of the algorithm 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. + !! For more details, see: + !! - 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. + !! Further Details + !! 1.ZSTEMR works only on machines which follow IEEE-754 + !! floating-point standard in their handling of infinities and NaNs. + !! This permits the use of efficient inner loops avoiding a check for + !! zero divisors. + !! 2. LAPACK routines can be used to reduce a complex Hermitean matrix to + !! real symmetric tridiagonal form. + !! (Any complex Hermitean tridiagonal matrix has real values on its diagonal + !! and potentially complex numbers on its off-diagonals. By applying a + !! similarity transform with an appropriate diagonal matrix + !! diag(1,e^{i \phy_1}, ... , e^{i \phy_{n-1}}), the complex Hermitean + !! matrix can be transformed into a real symmetric matrix and complex + !! arithmetic can be entirely avoided.) + !! While the eigenvectors of the real symmetric tridiagonal matrix are real, + !! the eigenvectors of original complex Hermitean matrix have complex entries + !! in general. + !! Since LAPACK drivers overwrite the matrix data with the eigenvectors, + !! ZSTEMR accepts complex workspace to facilitate interoperability + !! with ZUNMTR or ZUPMTR. isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48737,11 +48733,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsycon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) - !> ZSYCON estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex symmetric matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by ZSYTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZSYCON estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex symmetric matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by ZSYTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48818,11 +48814,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsycon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) - !> ZSYCON_ROOK estimates the reciprocal of the condition number (in the - !> 1-norm) of a complex symmetric matrix A using the factorization - !> A = U*D*U**T or A = L*D*L**T computed by ZSYTRF_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))). + !! ZSYCON_ROOK estimates the reciprocal of the condition number (in the + !! 1-norm) of a complex symmetric matrix A using the factorization + !! A = U*D*U**T or A = L*D*L**T computed by ZSYTRF_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))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -48900,9 +48896,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsyrfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & - !> ZSYRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is symmetric indefinite, and - !> provides error bounds and backward error estimates for the solution. + !! ZSYRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is symmetric indefinite, and + !! provides error bounds and backward error estimates for the solution. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49093,17 +49089,17 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> ZSYSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> The 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 symmetric 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. + !! ZSYSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! The 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 symmetric 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49171,20 +49167,20 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) - !> ZSYSV_RK computes the solution to a complex system of linear - !> equations A * X = B, where A is an N-by-N symmetric 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**T)*(P**T), if UPLO = 'U', or - !> A = P*L*D*(L**T)*(P**T), if UPLO = 'L', - !> where U (or L) is unit upper (or lower) triangular matrix, - !> U**T (or L**T) is the transpose of U (or L), P is a permutation - !> matrix, P**T is the transpose of P, and D is symmetric and block - !> diagonal with 1-by-1 and 2-by-2 diagonal blocks. - !> ZSYTRF_RK is called to compute the factorization of a complex - !> symmetric matrix. The factored form of A is then used to solve - !> the system of equations A * X = B by calling BLAS3 routine ZSYTRS_3. + !! ZSYSV_RK computes the solution to a complex system of linear + !! equations A * X = B, where A is an N-by-N symmetric 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**T)*(P**T), if UPLO = 'U', or + !! A = P*L*D*(L**T)*(P**T), if UPLO = 'L', + !! where U (or L) is unit upper (or lower) triangular matrix, + !! U**T (or L**T) is the transpose of U (or L), P is a permutation + !! matrix, P**T is the transpose of P, and D is symmetric and block + !! diagonal with 1-by-1 and 2-by-2 diagonal blocks. + !! ZSYTRF_RK is called to compute the factorization of a complex + !! symmetric matrix. The factored form of A is then used to solve + !! the system of equations A * X = B by calling BLAS3 routine ZSYTRS_3. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49248,22 +49244,22 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> ZSYSV_ROOK computes the solution to a complex system of linear - !> equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> The 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 symmetric and block diagonal with - !> 1-by-1 and 2-by-2 diagonal blocks. - !> ZSYTRF_ROOK is called to compute the factorization of a complex - !> symmetric 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 ZSYTRS_ROOK. + !! ZSYSV_ROOK computes the solution to a complex system of linear + !! equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! The 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 symmetric and block diagonal with + !! 1-by-1 and 2-by-2 diagonal blocks. + !! ZSYTRF_ROOK is called to compute the factorization of a complex + !! symmetric 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 ZSYTRS_ROOK. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49327,12 +49323,12 @@ module stdlib_linalg_lapack_z subroutine stdlib_zsysvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & - !> ZSYSVX uses the diagonal pivoting factorization to compute the - !> solution to a complex system of linear equations A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZSYSVX uses the diagonal pivoting factorization to compute the + !! solution to a complex system of linear equations A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ferr, berr, work, lwork,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49424,12 +49420,12 @@ module stdlib_linalg_lapack_z subroutine stdlib_ztbcon( norm, uplo, diag, n, kd, ab, ldab, rcond, work,rwork, info ) - !> ZTBCON estimates the reciprocal of the condition number of a - !> triangular band matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! ZTBCON estimates the reciprocal of the condition number of a + !! triangular band matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49533,9 +49529,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztftri( transr, uplo, diag, n, a, info ) - !> ZTFTRI computes the inverse of a triangular matrix A stored in RFP - !> format. - !> This is a Level 3 BLAS version of the algorithm. + !! ZTFTRI computes the inverse of a triangular matrix A stored in RFP + !! format. + !! This is a Level 3 BLAS version of the algorithm. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -49716,68 +49712,68 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b,ldb, tola, tolb, & - !> ZTGSJA computes the generalized singular value decomposition (GSVD) - !> of two complex upper triangular (or trapezoidal) matrices A and B. - !> On entry, it is assumed that matrices A and B have the following - !> forms, which may be obtained by the preprocessing subroutine ZGGSVP - !> from a general M-by-N matrix A and P-by-N matrix B: - !> N-K-L K L - !> A = K ( 0 A12 A13 ) if M-K-L >= 0; - !> L ( 0 0 A23 ) - !> M-K-L ( 0 0 0 ) - !> N-K-L K L - !> A = K ( 0 A12 A13 ) if M-K-L < 0; - !> M-K ( 0 0 A23 ) - !> N-K-L K L - !> B = L ( 0 0 B13 ) - !> P-L ( 0 0 0 ) - !> where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular - !> upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, - !> otherwise A23 is (M-K)-by-L upper trapezoidal. - !> On exit, - !> U**H *A*Q = D1*( 0 R ), V**H *B*Q = D2*( 0 R ), - !> where U, V and Q are unitary matrices. - !> R is a nonsingular upper triangular matrix, and D1 - !> and D2 are ``diagonal'' matrices, which are of the following - !> structures: - !> If M-K-L >= 0, - !> K L - !> D1 = K ( I 0 ) - !> L ( 0 C ) - !> M-K-L ( 0 0 ) - !> K L - !> D2 = L ( 0 S ) - !> P-L ( 0 0 ) - !> N-K-L K L - !> ( 0 R ) = K ( 0 R11 R12 ) K - !> L ( 0 0 R22 ) L - !> where - !> C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), - !> S = diag( BETA(K+1), ... , BETA(K+L) ), - !> C**2 + S**2 = I. - !> R is stored in A(1:K+L,N-K-L+1:N) on exit. - !> If M-K-L < 0, - !> K M-K K+L-M - !> D1 = K ( I 0 0 ) - !> M-K ( 0 C 0 ) - !> K M-K K+L-M - !> D2 = M-K ( 0 S 0 ) - !> K+L-M ( 0 0 I ) - !> P-L ( 0 0 0 ) - !> N-K-L K M-K K+L-M - !> ( 0 R ) = K ( 0 R11 R12 R13 ) - !> M-K ( 0 0 R22 R23 ) - !> K+L-M ( 0 0 0 R33 ) - !> where - !> C = diag( ALPHA(K+1), ... , ALPHA(M) ), - !> S = diag( BETA(K+1), ... , BETA(M) ), - !> C**2 + S**2 = I. - !> R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored - !> ( 0 R22 R23 ) - !> in B(M-K+1:L,N+M-K-L+1:N) on exit. - !> The computation of the unitary transformation matrices U, V or Q - !> is optional. These matrices may either be formed explicitly, or they - !> may be postmultiplied into input matrices U1, V1, or Q1. + !! ZTGSJA computes the generalized singular value decomposition (GSVD) + !! of two complex upper triangular (or trapezoidal) matrices A and B. + !! On entry, it is assumed that matrices A and B have the following + !! forms, which may be obtained by the preprocessing subroutine ZGGSVP + !! from a general M-by-N matrix A and P-by-N matrix B: + !! N-K-L K L + !! A = K ( 0 A12 A13 ) if M-K-L >= 0; + !! L ( 0 0 A23 ) + !! M-K-L ( 0 0 0 ) + !! N-K-L K L + !! A = K ( 0 A12 A13 ) if M-K-L < 0; + !! M-K ( 0 0 A23 ) + !! N-K-L K L + !! B = L ( 0 0 B13 ) + !! P-L ( 0 0 0 ) + !! where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular + !! upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, + !! otherwise A23 is (M-K)-by-L upper trapezoidal. + !! On exit, + !! U**H *A*Q = D1*( 0 R ), V**H *B*Q = D2*( 0 R ), + !! where U, V and Q are unitary matrices. + !! R is a nonsingular upper triangular matrix, and D1 + !! and D2 are ``diagonal'' matrices, which are of the following + !! structures: + !! If M-K-L >= 0, + !! K L + !! D1 = K ( I 0 ) + !! L ( 0 C ) + !! M-K-L ( 0 0 ) + !! K L + !! D2 = L ( 0 S ) + !! P-L ( 0 0 ) + !! N-K-L K L + !! ( 0 R ) = K ( 0 R11 R12 ) K + !! L ( 0 0 R22 ) L + !! where + !! C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), + !! S = diag( BETA(K+1), ... , BETA(K+L) ), + !! C**2 + S**2 = I. + !! R is stored in A(1:K+L,N-K-L+1:N) on exit. + !! If M-K-L < 0, + !! K M-K K+L-M + !! D1 = K ( I 0 0 ) + !! M-K ( 0 C 0 ) + !! K M-K K+L-M + !! D2 = M-K ( 0 S 0 ) + !! K+L-M ( 0 0 I ) + !! P-L ( 0 0 0 ) + !! N-K-L K M-K K+L-M + !! ( 0 R ) = K ( 0 R11 R12 R13 ) + !! M-K ( 0 0 R22 R23 ) + !! K+L-M ( 0 0 0 R33 ) + !! where + !! C = diag( ALPHA(K+1), ... , ALPHA(M) ), + !! S = diag( BETA(K+1), ... , BETA(M) ), + !! C**2 + S**2 = I. + !! R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored + !! ( 0 R22 R23 ) + !! in B(M-K+1:L,N+M-K-L+1:N) on exit. + !! The computation of the unitary transformation matrices U, V or Q + !! is optional. These matrices may either be formed explicitly, or they + !! may be postmultiplied into input matrices U1, V1, or Q1. alpha, beta, u, ldu, v, ldv,q, ldq, work, ncycle, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49965,31 +49961,31 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztgsy2( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & - !> ZTGSY2 solves the generalized Sylvester equation - !> A * R - L * B = scale * C (1) - !> D * R - L * E = scale * F - !> using Level 1 and 2 BLAS, where R and L are unknown M-by-N matrices, - !> (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M, - !> N-by-N and M-by-N, respectively. A, B, D and E are upper triangular - !> (i.e., (A,D) and (B,E) in generalized Schur form). - !> The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output - !> scaling factor chosen to avoid overflow. - !> In matrix notation solving equation (1) corresponds to solve - !> Zx = scale * b, where Z is defined as - !> Z = [ kron(In, A) -kron(B**H, Im) ] (2) - !> [ kron(In, D) -kron(E**H, Im) ], - !> Ik is the identity matrix of size k and X**H is the conjuguate transpose of X. - !> kron(X, Y) is the Kronecker product between the matrices X and Y. - !> If TRANS = 'C', y in the conjugate transposed system Z**H*y = scale*b - !> is solved for, which is equivalent to solve for R and L in - !> A**H * R + D**H * L = scale * C (3) - !> R * B**H + L * E**H = scale * -F - !> This case is used to compute an estimate of Dif[(A, D), (B, E)] = - !> = sigma_min(Z) using reverse communication with ZLACON. - !> ZTGSY2 also (IJOB >= 1) contributes to the computation in ZTGSYL - !> of an upper bound on the separation between to matrix pairs. Then - !> the input (A, D), (B, E) are sub-pencils of two matrix pairs in - !> ZTGSYL. + !! ZTGSY2 solves the generalized Sylvester equation + !! A * R - L * B = scale * C (1) + !! D * R - L * E = scale * F + !! using Level 1 and 2 BLAS, where R and L are unknown M-by-N matrices, + !! (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M, + !! N-by-N and M-by-N, respectively. A, B, D and E are upper triangular + !! (i.e., (A,D) and (B,E) in generalized Schur form). + !! The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output + !! scaling factor chosen to avoid overflow. + !! In matrix notation solving equation (1) corresponds to solve + !! Zx = scale * b, where Z is defined as + !! Z = [ kron(In, A) -kron(B**H, Im) ] (2) + !! [ kron(In, D) -kron(E**H, Im) ], + !! Ik is the identity matrix of size k and X**H is the conjuguate transpose of X. + !! kron(X, Y) is the Kronecker product between the matrices X and Y. + !! If TRANS = 'C', y in the conjugate transposed system Z**H*y = scale*b + !! is solved for, which is equivalent to solve for R and L in + !! A**H * R + D**H * L = scale * C (3) + !! R * B**H + L * E**H = scale * -F + !! This case is used to compute an estimate of Dif[(A, D), (B, E)] = + !! = sigma_min(Z) using reverse communication with ZLACON. + !! ZTGSY2 also (IJOB >= 1) contributes to the computation in ZTGSYL + !! of an upper bound on the separation between to matrix pairs. Then + !! the input (A, D), (B, E) are sub-pencils of two matrix pairs in + !! ZTGSYL. ldf, scale, rdsum, rdscal,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50155,33 +50151,33 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztgsyl( trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,ldd, e, lde, f, & - !> ZTGSYL solves the generalized Sylvester equation: - !> A * R - L * B = scale * C (1) - !> D * R - L * E = scale * F - !> where R and L are unknown m-by-n matrices, (A, D), (B, E) and - !> (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n, - !> respectively, with complex entries. A, B, D and E are upper - !> triangular (i.e., (A,D) and (B,E) in generalized Schur form). - !> The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 - !> is an output scaling factor chosen to avoid overflow. - !> In matrix notation (1) is equivalent to solve Zx = scale*b, where Z - !> is defined as - !> Z = [ kron(In, A) -kron(B**H, Im) ] (2) - !> [ kron(In, D) -kron(E**H, Im) ], - !> Here Ix is the identity matrix of size x and X**H is the conjugate - !> transpose of X. Kron(X, Y) is the Kronecker product between the - !> matrices X and Y. - !> If TRANS = 'C', y in the conjugate transposed system Z**H *y = scale*b - !> is solved for, which is equivalent to solve for R and L in - !> A**H * R + D**H * L = scale * C (3) - !> R * B**H + L * E**H = scale * -F - !> This case (TRANS = 'C') is used to compute an one-norm-based estimate - !> of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D) - !> and (B,E), using ZLACON. - !> If IJOB >= 1, ZTGSYL computes a Frobenius norm-based estimate of - !> Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the - !> reciprocal of the smallest singular value of Z. - !> This is a level-3 BLAS algorithm. + !! ZTGSYL solves the generalized Sylvester equation: + !! A * R - L * B = scale * C (1) + !! D * R - L * E = scale * F + !! where R and L are unknown m-by-n matrices, (A, D), (B, E) and + !! (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n, + !! respectively, with complex entries. A, B, D and E are upper + !! triangular (i.e., (A,D) and (B,E) in generalized Schur form). + !! The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 + !! is an output scaling factor chosen to avoid overflow. + !! In matrix notation (1) is equivalent to solve Zx = scale*b, where Z + !! is defined as + !! Z = [ kron(In, A) -kron(B**H, Im) ] (2) + !! [ kron(In, D) -kron(E**H, Im) ], + !! Here Ix is the identity matrix of size x and X**H is the conjugate + !! transpose of X. Kron(X, Y) is the Kronecker product between the + !! matrices X and Y. + !! If TRANS = 'C', y in the conjugate transposed system Z**H *y = scale*b + !! is solved for, which is equivalent to solve for R and L in + !! A**H * R + D**H * L = scale * C (3) + !! R * B**H + L * E**H = scale * -F + !! This case (TRANS = 'C') is used to compute an one-norm-based estimate + !! of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D) + !! and (B,E), using ZLACON. + !! If IJOB >= 1, ZTGSYL computes a Frobenius norm-based estimate of + !! Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the + !! reciprocal of the smallest singular value of Z. + !! This is a level-3 BLAS algorithm. ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50505,12 +50501,12 @@ module stdlib_linalg_lapack_z subroutine stdlib_ztpcon( norm, uplo, diag, n, ap, rcond, work, rwork,info ) - !> ZTPCON estimates the reciprocal of the condition number of a packed - !> triangular matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! ZTPCON estimates the reciprocal of the condition number of a packed + !! triangular matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50609,10 +50605,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztplqt( m, n, l, mb, a, lda, b, ldb, t, ldt, work,info ) - !> ZTPLQT computes a blocked LQ factorization of a complex - !> "triangular-pentagonal" matrix C, which is composed of a - !> triangular block A and pentagonal block B, using the compact - !> WY representation for Q. + !! ZTPLQT computes a blocked LQ factorization of a complex + !! "triangular-pentagonal" matrix C, which is composed of a + !! triangular block A and pentagonal block B, using the compact + !! WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50671,9 +50667,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztpmlqt( side, trans, m, n, k, l, mb, v, ldv, t, ldt,a, lda, b, ldb, & - !> ZTPMLQT applies a complex unitary matrix Q obtained from a - !> "triangular-pentagonal" complex block reflector H to a general - !> complex matrix C, which consists of two blocks A and B. + !! ZTPMLQT applies a complex unitary matrix Q obtained from a + !! "triangular-pentagonal" complex block reflector H to a general + !! complex matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50789,9 +50785,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztpmqrt( side, trans, m, n, k, l, nb, v, ldv, t, ldt,a, lda, b, ldb, & - !> ZTPMQRT applies a complex orthogonal matrix Q obtained from a - !> "triangular-pentagonal" complex block reflector H to a general - !> complex matrix C, which consists of two blocks A and B. + !! ZTPMQRT applies a complex orthogonal matrix Q obtained from a + !! "triangular-pentagonal" complex block reflector H to a general + !! complex matrix C, which consists of two blocks A and B. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50909,10 +50905,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztpqrt( m, n, l, nb, a, lda, b, ldb, t, ldt, work,info ) - !> ZTPQRT computes a blocked QR factorization of a complex - !> "triangular-pentagonal" matrix C, which is composed of a - !> triangular block A and pentagonal block B, using the compact - !> WY representation for Q. + !! ZTPQRT computes a blocked QR factorization of a complex + !! "triangular-pentagonal" matrix C, which is composed of a + !! triangular block A and pentagonal block B, using the compact + !! WY representation for Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -50971,12 +50967,12 @@ module stdlib_linalg_lapack_z subroutine stdlib_ztrcon( norm, uplo, diag, n, a, lda, rcond, work,rwork, info ) - !> ZTRCON estimates the reciprocal of the condition number of a - !> triangular matrix A, in either the 1-norm or the infinity-norm. - !> The norm of A is computed and an estimate is obtained for - !> norm(inv(A)), then the reciprocal of the condition number is - !> computed as - !> RCOND = 1 / ( norm(A) * norm(inv(A)) ). + !! ZTRCON estimates the reciprocal of the condition number of a + !! triangular matrix A, in either the 1-norm or the infinity-norm. + !! The norm of A is computed and an estimate is obtained for + !! norm(inv(A)), then the reciprocal of the condition number is + !! computed as + !! RCOND = 1 / ( norm(A) * norm(inv(A)) ). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51077,13 +51073,13 @@ module stdlib_linalg_lapack_z subroutine stdlib_ztrsyl( trana, tranb, isgn, m, n, a, lda, b, ldb, c,ldc, scale, info ) - !> ZTRSYL solves the complex Sylvester matrix equation: - !> op(A)*X + X*op(B) = scale*C or - !> op(A)*X - X*op(B) = scale*C, - !> where op(A) = A or A**H, and A and B are both upper triangular. A is - !> M-by-M and B is N-by-N; the right hand side C and the solution X are - !> M-by-N; and scale is an output scale factor, set <= 1 to avoid - !> overflow in X. + !! ZTRSYL solves the complex Sylvester matrix equation: + !! op(A)*X + X*op(B) = scale*C or + !! op(A)*X - X*op(B) = scale*C, + !! where op(A) = A or A**H, and A and B are both upper triangular. A is + !! M-by-M and B is N-by-N; the right hand side C and the solution X are + !! M-by-N; and scale is an output scale factor, set <= 1 to avoid + !! overflow in X. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51303,17 +51299,17 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & - !> ZUNBDB5 orthogonalizes the column vector - !> X = [ X1 ] - !> [ X2 ] - !> with respect to the columns of - !> Q = [ Q1 ] . - !> [ Q2 ] - !> The columns of Q must be orthonormal. - !> If the projection is zero according to Kahan's "twice is enough" - !> criterion, then some other vector from the orthogonal complement - !> is returned. This vector is chosen in an arbitrary but deterministic - !> way. + !! ZUNBDB5 orthogonalizes the column vector + !! X = [ X1 ] + !! [ X2 ] + !! with respect to the columns of + !! Q = [ Q1 ] . + !! [ Q2 ] + !! The columns of Q must be orthonormal. + !! If the projection is zero according to Kahan's "twice is enough" + !! criterion, then some other vector from the orthogonal complement + !! is returned. This vector is chosen in an arbitrary but deterministic + !! way. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51402,19 +51398,19 @@ module stdlib_linalg_lapack_z recursive subroutine stdlib_zuncsd( jobu1, jobu2, jobv1t, jobv2t, trans,signs, m, p, q, x11, & - !> ZUNCSD computes the CS decomposition of an M-by-M partitioned - !> unitary matrix X: - !> [ I 0 0 | 0 0 0 ] - !> [ 0 C 0 | 0 -S 0 ] - !> [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**H - !> X = [-----------] = [---------] [---------------------] [---------] . - !> [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] - !> [ 0 S 0 | 0 C 0 ] - !> [ 0 0 I | 0 0 0 ] - !> X11 is P-by-Q. The unitary matrices U1, U2, V1, and V2 are P-by-P, - !> (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are - !> R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in - !> which R = MIN(P,M-P,Q,M-Q). + !! ZUNCSD computes the CS decomposition of an M-by-M partitioned + !! unitary matrix X: + !! [ I 0 0 | 0 0 0 ] + !! [ 0 C 0 | 0 -S 0 ] + !! [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**H + !! X = [-----------] = [---------] [---------------------] [---------] . + !! [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] + !! [ 0 S 0 | 0 C 0 ] + !! [ 0 0 I | 0 0 0 ] + !! X11 is P-by-Q. The unitary matrices U1, U2, V1, and V2 are P-by-P, + !! (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-Q), respectively. C and S are + !! R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in + !! which R = MIN(P,M-P,Q,M-Q). ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, ldv1t, v2t,ldv2t, & work, lwork, rwork, lrwork,iwork, info ) ! -- lapack computational routine -- @@ -51692,10 +51688,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunghr( n, ilo, ihi, a, lda, tau, work, lwork, info ) - !> ZUNGHR generates a complex unitary matrix Q which is defined as the - !> product of IHI-ILO elementary reflectors of order N, as returned by - !> ZGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! ZUNGHR generates a complex unitary matrix Q which is defined as the + !! product of IHI-ILO elementary reflectors of order N, as returned by + !! ZGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51782,11 +51778,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zungtr( uplo, n, a, lda, tau, work, lwork, info ) - !> ZUNGTR generates a complex unitary matrix Q which is defined as the - !> product of n-1 elementary reflectors of order N, as returned by - !> ZHETRD: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! ZUNGTR generates a complex unitary matrix Q which is defined as the + !! product of n-1 elementary reflectors of order N, as returned by + !! ZHETRD: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -51883,15 +51879,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunhr_col( m, n, nb, a, lda, t, ldt, d, info ) - !> ZUNHR_COL takes an M-by-N complex matrix Q_in with orthonormal columns - !> as input, stored in A, and performs Householder Reconstruction (HR), - !> i.e. reconstructs Householder vectors V(i) implicitly representing - !> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, - !> where S is an N-by-N diagonal matrix with diagonal entries - !> equal to +1 or -1. The Householder vectors (columns V(i) of V) are - !> stored in A on output, and the diagonal entries of S are stored in D. - !> Block reflectors are also returned in T - !> (same output format as ZGEQRT). + !! ZUNHR_COL takes an M-by-N complex matrix Q_in with orthonormal columns + !! as input, stored in A, and performs Householder Reconstruction (HR), + !! i.e. reconstructs Householder vectors V(i) implicitly representing + !! another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, + !! where S is an N-by-N diagonal matrix with diagonal entries + !! equal to +1 or -1. The Householder vectors (columns V(i) of V) are + !! stored in A on output, and the diagonal entries of S are stored in D. + !! Block reflectors are also returned in T + !! (same output format as ZGEQRT). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52020,14 +52016,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunmhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, lwork, & - !> ZUNMHR 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 of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> IHI-ILO elementary reflectors, as returned by ZGEHRD: - !> Q = H(ilo) H(ilo+1) . . . H(ihi-1). + !! ZUNMHR 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 of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! IHI-ILO elementary reflectors, as returned by ZGEHRD: + !! Q = H(ilo) H(ilo+1) . . . H(ihi-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52119,15 +52115,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunmtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & - !> ZUNMTR 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 of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by ZHETRD: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! ZUNMTR 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 of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by ZHETRD: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52235,11 +52231,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zupgtr( uplo, n, ap, tau, q, ldq, work, info ) - !> ZUPGTR generates a complex unitary matrix Q which is defined as the - !> product of n-1 elementary reflectors H(i) of order n, as returned by - !> ZHPTRD using packed storage: - !> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), - !> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). + !! ZUPGTR generates a complex unitary matrix Q which is defined as the + !! product of n-1 elementary reflectors H(i) of order n, as returned by + !! ZHPTRD using packed storage: + !! if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), + !! if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52322,16 +52318,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zupmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) - !> ZUPMTR 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 of order nq, with nq = m if - !> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of - !> nq-1 elementary reflectors, as returned by ZHPTRD using packed - !> storage: - !> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); - !> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). + !! ZUPMTR 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 of order nq, with nq = m if + !! SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of + !! nq-1 elementary reflectors, as returned by ZHPTRD using packed + !! storage: + !! if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); + !! if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -52479,34 +52475,34 @@ module stdlib_linalg_lapack_z subroutine stdlib_zcposv( uplo, n, nrhs, a, lda, b, ldb, x, ldx, work,swork, rwork, iter, & - !> ZCPOSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> ZCPOSV first attempts to factorize the matrix in COMPLEX and use this - !> factorization within an iterative refinement procedure to produce a - !> solution with COMPLEX*16 normwise backward error quality (see below). - !> If the approach fails the method switches to a COMPLEX*16 - !> factorization and solve. - !> The iterative refinement is not going to be a winning strategy if - !> the ratio COMPLEX performance over COMPLEX*16 performance is too - !> small. A reasonable strategy should take the number of right-hand - !> sides and the size of the matrix into account. This might be done - !> with a call to ILAENV in the future. Up to now, we always try - !> iterative refinement. - !> The iterative refinement process is stopped if - !> ITER > ITERMAX - !> or for all the RHS we have: - !> RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX - !> where - !> o ITER is the number of the current iteration in the iterative - !> refinement process - !> o RNRM is the infinity-norm of the residual - !> o XNRM is the infinity-norm of the solution - !> o ANRM is the infinity-operator-norm of the matrix A - !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') - !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 - !> respectively. + !! ZCPOSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! ZCPOSV first attempts to factorize the matrix in COMPLEX and use this + !! factorization within an iterative refinement procedure to produce a + !! solution with COMPLEX*16 normwise backward error quality (see below). + !! If the approach fails the method switches to a COMPLEX*16 + !! factorization and solve. + !! The iterative refinement is not going to be a winning strategy if + !! the ratio COMPLEX performance over COMPLEX*16 performance is too + !! small. A reasonable strategy should take the number of right-hand + !! sides and the size of the matrix into account. This might be done + !! with a call to ILAENV in the future. Up to now, we always try + !! iterative refinement. + !! The iterative refinement process is stopped if + !! ITER > ITERMAX + !! or for all the RHS we have: + !! RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX + !! where + !! o ITER is the number of the current iteration in the iterative + !! refinement process + !! o RNRM is the infinity-norm of the residual + !! o XNRM is the infinity-norm of the solution + !! o ANRM is the infinity-operator-norm of the matrix A + !! o EPS is the machine epsilon returned by DLAMCH('Epsilon') + !! The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 + !! respectively. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52666,10 +52662,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgbbrd( vect, m, n, ncc, kl, ku, ab, ldab, d, e, q,ldq, pt, ldpt, c, & - !> ZGBBRD 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. + !! ZGBBRD 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. ldc, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52943,9 +52939,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb,ipiv, b, ldb, x, & - !> ZGBRFS 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. + !! ZGBRFS 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. ldx, ferr, berr, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53149,14 +53145,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgbsv( n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info ) - !> ZGBSV 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. + !! ZGBSV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53201,12 +53197,12 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgbsvx( fact, trans, n, kl, ku, nrhs, ab, ldab, afb,ldafb, ipiv, equed, r, & - !> ZGBSVX uses the LU factorization to compute the solution to a complex - !> system of linear equations A * X = B, A**T * X = B, or A**H * 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. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZGBSVX uses the LU factorization to compute the solution to a complex + !! system of linear equations A * X = B, A**T * X = B, or A**H * 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. + !! Error bounds on the solution and a condition estimate are also + !! provided. c, b, ldb, x, ldx,rcond, ferr, berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53428,9 +53424,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgebrd( m, n, a, lda, d, e, tauq, taup, work, lwork,info ) - !> ZGEBRD 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. + !! ZGEBRD 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53535,8 +53531,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgehrd( n, ilo, ihi, a, lda, tau, work, lwork, info ) - !> ZGEHRD reduces a complex general matrix A to upper Hessenberg form H by - !> an unitary similarity transformation: Q**H * A * Q = H . + !! ZGEHRD reduces a complex general matrix A to upper Hessenberg form H by + !! an unitary similarity transformation: Q**H * A * Q = H . ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53665,8 +53661,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgelqt( m, n, mb, a, lda, t, ldt, work, info ) - !> ZGELQT computes a blocked LQ factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. + !! ZGELQT computes a blocked LQ factorization of a complex M-by-N matrix A + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53716,24 +53712,24 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) - !> ZGELS 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. + !! ZGELS 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -53934,8 +53930,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgeqp3( m, n, a, lda, jpvt, tau, work, lwork, rwork,info ) - !> ZGEQP3 computes a QR factorization with column pivoting of a - !> matrix A: A*P = Q*R using Level 3 BLAS. + !! ZGEQP3 computes a QR factorization with column pivoting of a + !! matrix A: A*P = Q*R using Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54086,8 +54082,8 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgeqrt( m, n, nb, a, lda, t, ldt, work, info ) - !> ZGEQRT computes a blocked QR factorization of a complex M-by-N matrix A - !> using the compact WY representation of Q. + !! ZGEQRT computes a blocked QR factorization of a complex M-by-N matrix A + !! using the compact WY representation of Q. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54143,9 +54139,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & - !> ZGERFS improves the computed solution to a system of linear - !> equations and provides error bounds and backward error estimates for - !> the solution. + !! ZGERFS improves the computed solution to a system of linear + !! equations and provides error bounds and backward error estimates for + !! the solution. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54340,14 +54336,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgetrf( m, n, a, lda, ipiv, info ) - !> ZGETRF 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. + !! ZGETRF 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54418,24 +54414,24 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) - !> ZGGGLM 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. + !! ZGGGLM 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -54554,31 +54550,31 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgghd3( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & - !> ZGGHD3 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 ZGGHD3 reduces the original - !> problem to generalized Hessenberg form. - !> This is a blocked variant of CGGHRD, using matrix-matrix - !> multiplications for parts of the computation to enhance performance. + !! ZGGHD3 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 ZGGHD3 reduces the original + !! problem to generalized Hessenberg form. + !! This is a blocked variant of CGGHRD, using matrix-matrix + !! multiplications for parts of the computation to enhance performance. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55084,18 +55080,18 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) - !> ZGGLSE 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. + !! ZGGLSE 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -55216,11 +55212,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgtcon( norm, n, dl, d, du, du2, ipiv, anorm, rcond,work, info ) - !> ZGTCON estimates the reciprocal of the condition number of a complex - !> tridiagonal matrix A using the LU factorization as computed by - !> ZGTTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZGTCON estimates the reciprocal of the condition number of a complex + !! tridiagonal matrix A using the LU factorization as computed by + !! ZGTTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55300,9 +55296,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,ipiv, b, ldb, x, & - !> ZGTRFS 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. + !! ZGTRFS 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. ldx, ferr, berr, work, rwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55507,12 +55503,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgtsvx( fact, trans, n, nrhs, dl, d, du, dlf, df, duf,du2, ipiv, b, & - !> ZGTSVX uses the LU factorization to compute the solution to a complex - !> system of linear equations A * X = B, A**T * X = B, or A**H * X = B, - !> where A is a tridiagonal matrix of order N and X and B are N-by-NRHS - !> matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZGTSVX uses the LU factorization to compute the solution to a complex + !! system of linear equations A * X = B, A**T * X = B, or A**H * X = B, + !! where A is a tridiagonal matrix of order N and X and B are N-by-NRHS + !! matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ldb, x, ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55595,13 +55591,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhbgst( vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x,ldx, work, rwork,& - !> ZHBGST 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 ZPBSTF, 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. + !! ZHBGST 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 ZPBSTF, 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56527,9 +56523,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhbtrd( vect, uplo, n, kd, ab, ldab, d, e, q, ldq,work, info ) - !> ZHBTRD reduces a complex Hermitian band matrix A to real symmetric - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. + !! ZHBTRD reduces a complex Hermitian band matrix A to real symmetric + !! tridiagonal form T by a unitary similarity transformation: + !! Q**H * A * Q = T. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56891,11 +56887,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhecon( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) - !> ZHECON 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 ZHETRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZHECON 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 ZHETRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -56972,11 +56968,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhecon_rook( uplo, n, a, lda, ipiv, anorm, rcond, work,info ) - !> ZHECON_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))). + !! ZHECON_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))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57053,8 +57049,8 @@ module stdlib_linalg_lapack_z subroutine stdlib_zheev( jobz, uplo, n, a, lda, w, work, lwork, rwork,info ) - !> ZHEEV computes all eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix A. + !! ZHEEV computes all eigenvalues and, optionally, eigenvectors of a + !! complex Hermitian matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -57164,56 +57160,56 @@ module stdlib_linalg_lapack_z subroutine stdlib_zheevr( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> ZHEEVR 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. - !> ZHEEVR first reduces the matrix A to tridiagonal form T with a call - !> to ZHETRD. Then, whenever possible, ZHEEVR calls ZSTEMR to compute - !> eigenspectrum using Relatively Robust Representations. ZSTEMR - !> 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 ZSTEMR'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 : ZHEEVR calls ZSTEMR when the full spectrum is requested - !> on machines which conform to the ieee-754 floating point standard. - !> ZHEEVR calls DSTEBZ and ZSTEIN on non-ieee machines and - !> when partial spectrum requests are made. - !> Normal execution of ZSTEMR 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. + !! ZHEEVR 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. + !! ZHEEVR first reduces the matrix A to tridiagonal form T with a call + !! to ZHETRD. Then, whenever possible, ZHEEVR calls ZSTEMR to compute + !! eigenspectrum using Relatively Robust Representations. ZSTEMR + !! 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 ZSTEMR'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 : ZHEEVR calls ZSTEMR when the full spectrum is requested + !! on machines which conform to the ieee-754 floating point standard. + !! ZHEEVR calls DSTEBZ and ZSTEIN on non-ieee machines and + !! when partial spectrum requests are made. + !! Normal execution of ZSTEMR 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. isuppz, work, lwork,rwork, lrwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57503,10 +57499,10 @@ module stdlib_linalg_lapack_z subroutine stdlib_zheevx( jobz, range, uplo, n, a, lda, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> ZHEEVX 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. + !! ZHEEVX 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. work, lwork, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57750,11 +57746,11 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhegv( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, info ) - !> ZHEGV 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. + !! ZHEGV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57851,12 +57847,12 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhegvx( itype, jobz, range, uplo, n, a, lda, b, ldb,vl, vu, il, iu, abstol,& - !> ZHEGVX computes selected eigenvalues, and optionally, 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. - !> Eigenvalues and eigenvectors can be selected by specifying either a - !> range of values or a range of indices for the desired eigenvalues. + !! ZHEGVX computes selected eigenvalues, and optionally, 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. + !! Eigenvalues and eigenvectors can be selected by specifying either a + !! range of values or a range of indices for the desired eigenvalues. m, w, z, ldz, work,lwork, rwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57979,9 +57975,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zherfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb,x, ldx, ferr, & - !> ZHERFS 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. + !! ZHERFS 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. berr, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58172,17 +58168,17 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhesv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> ZHESV 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. + !! ZHESV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -58250,20 +58246,20 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhesv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info ) - !> ZHESV_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. - !> ZHETRF_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 ZHETRS_3. + !! ZHESV_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. + !! ZHETRF_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 ZHETRS_3. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58327,22 +58323,22 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhesv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> ZHESV_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. - !> ZHETRF_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 ZHETRS_ROOK (uses BLAS 2). + !! ZHESV_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. + !! ZHETRF_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 ZHETRS_ROOK (uses BLAS 2). ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58406,12 +58402,12 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhesvx( fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b,ldb, x, ldx, rcond, & - !> ZHESVX uses the diagonal pivoting factorization to compute 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. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZHESVX uses the diagonal pivoting factorization to compute 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. + !! Error bounds on the solution and a condition estimate are also + !! provided. ferr, berr, work, lwork,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58503,39 +58499,39 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhgeqz( job, compq, compz, n, ilo, ihi, h, ldh, t, ldt,alpha, beta, q, ldq,& - !> ZHGEQZ 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 ZGGHRD. - !> 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 ZGGHRD 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. + !! ZHGEQZ 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 ZGGHRD. + !! 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 ZGGHRD 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. z, ldz, work, lwork,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59003,11 +58999,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhpcon( uplo, n, ap, ipiv, anorm, rcond, work, info ) - !> ZHPCON 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 ZHPTRF. - !> An estimate is obtained for norm(inv(A)), and the reciprocal of the - !> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). + !! ZHPCON 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 ZHPTRF. + !! An estimate is obtained for norm(inv(A)), and the reciprocal of the + !! condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59084,8 +59080,8 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhpev( jobz, uplo, n, ap, w, z, ldz, work, rwork,info ) - !> ZHPEV computes all the eigenvalues and, optionally, eigenvectors of a - !> complex Hermitian matrix in packed storage. + !! ZHPEV computes all the eigenvalues and, optionally, eigenvectors of a + !! complex Hermitian matrix in packed storage. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59181,10 +59177,10 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhpevx( jobz, range, uplo, n, ap, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> ZHPEVX computes selected eigenvalues and, optionally, eigenvectors - !> of a complex Hermitian matrix A in packed storage. - !> Eigenvalues/vectors can be selected by specifying either a range of - !> values or a range of indices for the desired eigenvalues. + !! ZHPEVX computes selected eigenvalues and, optionally, eigenvectors + !! of a complex Hermitian matrix A in packed storage. + !! Eigenvalues/vectors can be selected by specifying either a range of + !! values or a range of indices for the desired eigenvalues. work, rwork, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59398,11 +59394,11 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhpgv( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,rwork, info ) - !> ZHPGV 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. + !! ZHPGV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59483,13 +59479,13 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhpgvx( itype, jobz, range, uplo, n, ap, bp, vl, vu,il, iu, abstol, m, w, & - !> ZHPGVX computes selected eigenvalues and, optionally, 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. Eigenvalues and eigenvectors can be selected by - !> specifying either a range of values or a range of indices for the - !> desired eigenvalues. + !! ZHPGVX computes selected eigenvalues and, optionally, 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. Eigenvalues and eigenvectors can be selected by + !! specifying either a range of values or a range of indices for the + !! desired eigenvalues. z, ldz, work, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59595,10 +59591,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, work,& - !> ZHPRFS 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. + !! ZHPRFS 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. rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59792,17 +59788,17 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhpsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) - !> ZHPSV 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. + !! ZHPSV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -59843,12 +59839,12 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhpsvx( fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x,ldx, rcond, ferr, & - !> ZHPSVX uses the diagonal pivoting factorization A = U*D*U**H or - !> A = L*D*L**H to compute 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. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZHPSVX uses the diagonal pivoting factorization A = U*D*U**H or + !! A = L*D*L**H to compute 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. + !! Error bounds on the solution and a condition estimate are also + !! provided. berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59921,12 +59917,12 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhsein( side, eigsrc, initv, select, n, h, ldh, w, vl,ldvl, vr, ldvr, mm, & - !> ZHSEIN 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. + !! ZHSEIN 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. m, work, rwork, ifaill,ifailr, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60095,10 +60091,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaed0( qsiz, n, d, e, q, ldq, qstore, ldqs, rwork,iwork, info ) - !> Using the divide and conquer method, ZLAED0: 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. + !! Using the divide and conquer method, ZLAED0: 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60273,13 +60269,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlamswlq( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & - !> ZLAMSWLQ 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 short wide LQ - !> factorization (ZLASWLQ) + !! ZLAMSWLQ 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 short wide LQ + !! factorization (ZLASWLQ) lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60431,13 +60427,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlamtsqr( side, trans, m, n, k, mb, nb, a, lda, t,ldt, c, ldc, work, & - !> ZLAMTSQR 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 (ZLATSQR) + !! ZLAMTSQR 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 (ZLATSQR) lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60593,17 +60589,17 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqr2( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & - !> ZLAQR2 is identical to ZLAQR3 except that it avoids - !> recursion by calling ZLAHQR instead of ZLAQR4. - !> Aggressive early deflation: - !> ZLAQR2 accepts as input an upper Hessenberg matrix - !> H and performs an unitary similarity transformation - !> designed to detect and deflate fully converged eigenvalues from - !> a trailing principal submatrix. On output H has been over- - !> written by a new Hessenberg matrix that is a perturbation of - !> an unitary similarity transformation of H. It is to be - !> hoped that the final version of H has many zero subdiagonal - !> entries. + !! ZLAQR2 is identical to ZLAQR3 except that it avoids + !! recursion by calling ZLAHQR instead of ZLAQR4. + !! Aggressive early deflation: + !! ZLAQR2 accepts as input an upper Hessenberg matrix + !! H and performs an unitary similarity transformation + !! designed to detect and deflate fully converged eigenvalues from + !! a trailing principal submatrix. On output H has been over- + !! written by a new Hessenberg matrix that is a perturbation of + !! an unitary similarity transformation of H. It is to be + !! hoped that the final version of H has many zero subdiagonal + !! entries. ns, nd, sh, v, ldv, nh, t, ldt,nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60807,16 +60803,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaswlq( m, n, mb, nb, a, lda, t, ldt, work, lwork,info) - !> ZLASWLQ computes a blocked Tall-Skinny LQ factorization of - !> a complexx 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. + !! ZLASWLQ computes a blocked Tall-Skinny LQ factorization of + !! a complexx 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -60891,17 +60887,17 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlatsqr( m, n, mb, nb, a, lda, t, ldt, work,lwork, info) - !> ZLATSQR computes a blocked Tall-Skinny QR factorization of - !> a complex M-by-N matrix A for M >= N: - !> A = Q * ( R ), - !> ( 0 ) - !> where: - !> Q is a M-by-M orthogonal matrix, stored on exit in an implicit - !> form in the elements below the diagonal of the array A and in - !> the elements of the array T; - !> R is an upper-triangular N-by-N matrix, stored on exit in - !> the elements on and above the diagonal of the array A. - !> 0 is a (M-N)-by-N zero matrix, and is not stored. + !! ZLATSQR computes a blocked Tall-Skinny QR factorization of + !! a complex M-by-N matrix A for M >= N: + !! A = Q * ( R ), + !! ( 0 ) + !! where: + !! Q is a M-by-M orthogonal matrix, stored on exit in an implicit + !! form in the elements below the diagonal of the array A and in + !! the elements of the array T; + !! R is an upper-triangular N-by-N matrix, stored on exit in + !! the elements on and above the diagonal of the array A. + !! 0 is a (M-N)-by-N zero matrix, and is not stored. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -60976,17 +60972,17 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) - !> ZPBSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite band matrix and X - !> and B are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular band matrix, and L is a lower - !> triangular band matrix, with the same number of superdiagonals or - !> subdiagonals as A. The factored form of A is then used to solve the - !> system of equations A * X = B. + !! ZPBSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite band matrix and X + !! and B are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular band matrix, and L is a lower + !! triangular band matrix, with the same number of superdiagonals or + !! subdiagonals as A. The factored form of A is then used to solve the + !! system of equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61030,13 +61026,13 @@ module stdlib_linalg_lapack_z subroutine stdlib_zpbsvx( fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb,equed, s, b, ldb, x, & - !> ZPBSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to - !> compute the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite band matrix and X - !> and B are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZPBSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to + !! compute the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite band matrix and X + !! and B are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61187,13 +61183,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpftrf( transr, uplo, n, a, info ) - !> ZPFTRF computes the Cholesky factorization of a complex Hermitian - !> positive definite matrix A. - !> The factorization has the form - !> A = U**H * U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is lower triangular. - !> This is the block version of the algorithm, calling Level 3 BLAS. + !! ZPFTRF computes the Cholesky factorization of a complex Hermitian + !! positive definite matrix A. + !! The factorization has the form + !! A = U**H * U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is lower triangular. + !! This is the block version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61363,9 +61359,9 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zpftri( transr, uplo, n, a, info ) - !> ZPFTRI computes the inverse of a complex Hermitian positive definite - !> matrix A using the Cholesky factorization A = U**H*U or A = L*L**H - !> computed by ZPFTRF. + !! ZPFTRI computes the inverse of a complex Hermitian positive definite + !! matrix A using the Cholesky factorization A = U**H*U or A = L*L**H + !! computed by ZPFTRF. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61522,16 +61518,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zposv( uplo, n, nrhs, a, lda, b, ldb, info ) - !> ZPOSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> The Cholesky decomposition is used to factor A as - !> A = U**H* U, if UPLO = 'U', or - !> A = L * L**H, if UPLO = 'L', - !> where U is an upper triangular matrix and L is a lower triangular - !> matrix. The factored form of A is then used to solve the system of - !> equations A * X = B. + !! ZPOSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! The Cholesky decomposition is used to factor A as + !! A = U**H* U, if UPLO = 'U', or + !! A = L * L**H, if UPLO = 'L', + !! where U is an upper triangular matrix and L is a lower triangular + !! matrix. The factored form of A is then used to solve the system of + !! equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61573,13 +61569,13 @@ module stdlib_linalg_lapack_z subroutine stdlib_zposvx( fact, uplo, n, nrhs, a, lda, af, ldaf, equed,s, b, ldb, x, ldx, & - !> ZPOSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to - !> compute the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N Hermitian positive definite matrix and X and B - !> are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZPOSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to + !! compute the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N Hermitian positive definite matrix and X and B + !! are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. rcond, ferr, berr, work,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61717,10 +61713,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zptrfs( uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx,ferr, berr, work, & - !> ZPTRFS improves the computed solution to a system of linear - !> equations when the coefficient matrix is Hermitian positive definite - !> and tridiagonal, and provides error bounds and backward error - !> estimates for the solution. + !! ZPTRFS improves the computed solution to a system of linear + !! equations when the coefficient matrix is Hermitian positive definite + !! and tridiagonal, and provides error bounds and backward error + !! estimates for the solution. rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61935,11 +61931,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zptsv( n, nrhs, d, e, b, ldb, info ) - !> ZPTSV computes the solution to a complex system of linear equations - !> A*X = B, where A is an N-by-N Hermitian positive definite tridiagonal - !> matrix, and X and B are N-by-NRHS matrices. - !> A is factored as A = L*D*L**H, and the factored form of A is then - !> used to solve the system of equations. + !! ZPTSV computes the solution to a complex system of linear equations + !! A*X = B, where A is an N-by-N Hermitian positive definite tridiagonal + !! matrix, and X and B are N-by-NRHS matrices. + !! A is factored as A = L*D*L**H, and the factored form of A is then + !! used to solve the system of equations. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -61977,12 +61973,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zptsvx( fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx,rcond, ferr, berr,& - !> ZPTSVX uses the factorization A = L*D*L**H to compute the solution - !> to a complex system of linear equations A*X = B, where A is an - !> N-by-N Hermitian positive definite tridiagonal matrix and X and B - !> are N-by-NRHS matrices. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZPTSVX uses the factorization A = L*D*L**H to compute the solution + !! to a complex system of linear equations A*X = B, where A is an + !! N-by-N Hermitian positive definite tridiagonal matrix and X and B + !! are N-by-NRHS matrices. + !! Error bounds on the solution and a condition estimate are also + !! provided. work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62054,17 +62050,17 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zstedc( compz, n, d, e, z, ldz, work, lwork, rwork,lrwork, iwork, & - !> ZSTEDC computes all eigenvalues and, optionally, eigenvectors of a - !> symmetric tridiagonal matrix using the divide and conquer method. - !> The eigenvectors of a full or band complex Hermitian matrix can also - !> be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this - !> matrix to tridiagonal 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 DLAED3 for details. + !! ZSTEDC computes all eigenvalues and, optionally, eigenvectors of a + !! symmetric tridiagonal matrix using the divide and conquer method. + !! The eigenvectors of a full or band complex Hermitian matrix can also + !! be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this + !! matrix to tridiagonal 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 DLAED3 for details. liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62268,22 +62264,22 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zstegr( jobz, range, n, d, e, vl, vu, il, iu,abstol, m, w, z, ldz, & - !> ZSTEGR computes selected eigenvalues and, optionally, eigenvectors - !> of a real symmetric tridiagonal matrix T. Any such unreduced matrix has - !> a well defined set of pairwise different real eigenvalues, the corresponding - !> real eigenvectors are pairwise orthogonal. - !> The spectrum may be computed either completely or partially by specifying - !> either an interval (VL,VU] or a range of indices IL:IU for the desired - !> eigenvalues. - !> ZSTEGR is a compatibility wrapper around the improved ZSTEMR routine. - !> See ZSTEMR for further details. - !> One important change is that the ABSTOL parameter no longer provides any - !> benefit and hence is no longer used. - !> Note : ZSTEGR and ZSTEMR work only on machines which follow - !> IEEE-754 floating-point standard in their handling of infinities and - !> NaNs. Normal execution may create these exceptiona values and hence - !> may abort due to a floating point exception in environments which - !> do not conform to the IEEE-754 standard. + !! ZSTEGR computes selected eigenvalues and, optionally, eigenvectors + !! of a real symmetric tridiagonal matrix T. Any such unreduced matrix has + !! a well defined set of pairwise different real eigenvalues, the corresponding + !! real eigenvectors are pairwise orthogonal. + !! The spectrum may be computed either completely or partially by specifying + !! either an interval (VL,VU] or a range of indices IL:IU for the desired + !! eigenvalues. + !! ZSTEGR is a compatibility wrapper around the improved ZSTEMR routine. + !! See ZSTEMR for further details. + !! One important change is that the ABSTOL parameter no longer provides any + !! benefit and hence is no longer used. + !! Note : ZSTEGR and ZSTEMR work only on machines which follow + !! IEEE-754 floating-point standard in their handling of infinities and + !! NaNs. Normal execution may create these exceptiona values and hence + !! may abort due to a floating point exception in environments which + !! do not conform to the IEEE-754 standard. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62310,24 +62306,24 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztgsen( ijob, wantq, wantz, select, n, a, lda, b, ldb,alpha, beta, q, & - !> ZTGSEN reorders the generalized Schur decomposition of a complex - !> matrix pair (A, B) (in terms of an unitary equivalence trans- - !> formation Q**H * (A, B) * Z), so that a selected cluster of eigenvalues - !> appears in the leading diagonal blocks of the pair (A,B). The leading - !> columns of Q and Z form unitary bases of the corresponding left and - !> right eigenspaces (deflating subspaces). (A, B) must be in - !> generalized Schur canonical form, that is, A and B are both upper - !> triangular. - !> ZTGSEN also computes the generalized eigenvalues - !> w(j)= ALPHA(j) / BETA(j) - !> of the reordered matrix pair (A, B). - !> Optionally, the routine computes estimates of reciprocal condition - !> numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11), - !> (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s) - !> between the matrix pairs (A11, B11) and (A22,B22) that correspond to - !> the selected cluster and the eigenvalues outside the cluster, resp., - !> and norms of "projections" onto left and right eigenspaces w.r.t. - !> the selected cluster in the (1,1)-block. + !! ZTGSEN reorders the generalized Schur decomposition of a complex + !! matrix pair (A, B) (in terms of an unitary equivalence trans- + !! formation Q**H * (A, B) * Z), so that a selected cluster of eigenvalues + !! appears in the leading diagonal blocks of the pair (A,B). The leading + !! columns of Q and Z form unitary bases of the corresponding left and + !! right eigenspaces (deflating subspaces). (A, B) must be in + !! generalized Schur canonical form, that is, A and B are both upper + !! triangular. + !! ZTGSEN also computes the generalized eigenvalues + !! w(j)= ALPHA(j) / BETA(j) + !! of the reordered matrix pair (A, B). + !! Optionally, the routine computes estimates of reciprocal condition + !! numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11), + !! (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s) + !! between the matrix pairs (A11, B11) and (A22,B22) that correspond to + !! the selected cluster and the eigenvalues outside the cluster, resp., + !! and norms of "projections" onto left and right eigenspaces w.r.t. + !! the selected cluster in the (1,1)-block. ldq, z, ldz, m, pl, pr, dif,work, lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62589,10 +62585,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_ztgsna( job, howmny, select, n, a, lda, b, ldb, vl,ldvl, vr, ldvr, s, & - !> ZTGSNA estimates reciprocal condition numbers for specified - !> eigenvalues and/or eigenvectors of a matrix pair (A, B). - !> (A, B) must be in generalized Schur canonical form, that is, A and - !> B are both upper triangular. + !! ZTGSNA estimates reciprocal condition numbers for specified + !! eigenvalues and/or eigenvectors of a matrix pair (A, B). + !! (A, B) must be in generalized Schur canonical form, that is, A and + !! B are both upper triangular. dif, mm, m, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62746,13 +62742,13 @@ module stdlib_linalg_lapack_z subroutine stdlib_ztrsen( job, compq, select, n, t, ldt, q, ldq, w, m, s,sep, work, lwork, & - !> ZTRSEN reorders the Schur factorization of a complex matrix - !> A = Q*T*Q**H, so that a selected cluster of eigenvalues appears in - !> the leading positions on the diagonal of the upper triangular matrix - !> T, and the leading columns of Q form an orthonormal basis of the - !> corresponding right invariant subspace. - !> Optionally the routine computes the reciprocal condition numbers of - !> the cluster of eigenvalues and/or the invariant subspace. + !! ZTRSEN reorders the Schur factorization of a complex matrix + !! A = Q*T*Q**H, so that a selected cluster of eigenvalues appears in + !! the leading positions on the diagonal of the upper triangular matrix + !! T, and the leading columns of Q form an orthonormal basis of the + !! corresponding right invariant subspace. + !! Optionally the routine computes the reciprocal condition numbers of + !! the cluster of eigenvalues and/or the invariant subspace. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62883,21 +62879,21 @@ module stdlib_linalg_lapack_z subroutine stdlib_zunbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> ZUNBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, - !> M-P, or M-Q. Routines ZUNBDB2, ZUNBDB3, and ZUNBDB4 handle cases in - !> which Q is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! ZUNBDB1 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. Q must be no larger than P, + !! M-P, or M-Q. Routines ZUNBDB2, ZUNBDB3, and ZUNBDB4 handle cases in + !! which Q is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are Q-by-Q bidiagonal matrices represented implicitly by + !! angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62988,21 +62984,21 @@ module stdlib_linalg_lapack_z subroutine stdlib_zunbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> ZUNBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, - !> Q, or M-Q. Routines ZUNBDB1, ZUNBDB3, and ZUNBDB4 handle cases in - !> which P is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are P-by-P bidiagonal matrices represented implicitly by - !> angles THETA, PHI. + !! ZUNBDB2 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. P must be no larger than M-P, + !! Q, or M-Q. Routines ZUNBDB1, ZUNBDB3, and ZUNBDB4 handle cases in + !! which P is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are P-by-P bidiagonal matrices represented implicitly by + !! angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63103,21 +63099,21 @@ module stdlib_linalg_lapack_z subroutine stdlib_zunbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> ZUNBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, - !> Q, or M-Q. Routines ZUNBDB1, ZUNBDB2, and ZUNBDB4 handle cases in - !> which M-P is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! ZUNBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P, + !! Q, or M-Q. Routines ZUNBDB1, ZUNBDB2, and ZUNBDB4 handle cases in + !! which M-P is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63217,21 +63213,21 @@ module stdlib_linalg_lapack_z subroutine stdlib_zunbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, tauq1, & - !> ZUNBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny - !> matrix X with orthonomal columns: - !> [ B11 ] - !> [ X11 ] [ P1 | ] [ 0 ] - !> [-----] = [---------] [-----] Q1**T . - !> [ X21 ] [ | P2 ] [ B21 ] - !> [ 0 ] - !> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, - !> M-P, or Q. Routines ZUNBDB1, ZUNBDB2, and ZUNBDB3 handle cases in - !> which M-Q is not the minimum dimension. - !> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), - !> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by - !> Householder vectors. - !> B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented - !> implicitly by angles THETA, PHI. + !! ZUNBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny + !! matrix X with orthonomal columns: + !! [ B11 ] + !! [ X11 ] [ P1 | ] [ 0 ] + !! [-----] = [---------] [-----] Q1**T . + !! [ X21 ] [ | P2 ] [ B21 ] + !! [ 0 ] + !! X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, + !! M-P, or Q. Routines ZUNBDB1, ZUNBDB2, and ZUNBDB3 handle cases in + !! which M-Q is not the minimum dimension. + !! The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), + !! and (M-Q)-by-(M-Q), respectively. They are represented implicitly by + !! Householder vectors. + !! B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented + !! implicitly by angles THETA, PHI. phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63366,21 +63362,21 @@ module stdlib_linalg_lapack_z subroutine stdlib_zuncsd2by1( jobu1, jobu2, jobv1t, m, p, q, x11, ldx11,x21, ldx21, theta, & - !> ZUNCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with - !> orthonormal columns that has been partitioned into a 2-by-1 block - !> structure: - !> [ I1 0 0 ] - !> [ 0 C 0 ] - !> [ X11 ] [ U1 | ] [ 0 0 0 ] - !> X = [-----] = [---------] [----------] V1**T . - !> [ X21 ] [ | U2 ] [ 0 0 0 ] - !> [ 0 S 0 ] - !> [ 0 0 I2] - !> X11 is P-by-Q. The unitary matrices U1, U2, and V1 are P-by-P, - !> (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R - !> nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which - !> R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a - !> K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). + !! ZUNCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with + !! orthonormal columns that has been partitioned into a 2-by-1 block + !! structure: + !! [ I1 0 0 ] + !! [ 0 C 0 ] + !! [ X11 ] [ U1 | ] [ 0 0 0 ] + !! X = [-----] = [---------] [----------] V1**T . + !! [ X21 ] [ | U2 ] [ 0 0 0 ] + !! [ 0 S 0 ] + !! [ 0 0 I2] + !! X11 is P-by-Q. The unitary matrices U1, U2, and V1 are P-by-P, + !! (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R + !! nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which + !! R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a + !! K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0). u1, ldu1, u2, ldu2, v1t,ldv1t, work, lwork, rwork, lrwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63803,22 +63799,22 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zungbr( vect, m, n, k, a, lda, tau, work, lwork, info ) - !> ZUNGBR generates one of the complex unitary matrices Q or P**H - !> determined by ZGEBRD when reducing a complex matrix A to bidiagonal - !> form: A = Q * B * P**H. Q and P**H are defined as products of - !> elementary reflectors H(i) or G(i) respectively. - !> If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q - !> is of order M: - !> if m >= k, Q = H(1) H(2) . . . H(k) and ZUNGBR returns the first n - !> columns of Q, where m >= n >= k; - !> if m < k, Q = H(1) H(2) . . . H(m-1) and ZUNGBR returns Q as an - !> M-by-M matrix. - !> If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**H - !> is of order N: - !> if k < n, P**H = G(k) . . . G(2) G(1) and ZUNGBR returns the first m - !> rows of P**H, where n >= m >= k; - !> if k >= n, P**H = G(n-1) . . . G(2) G(1) and ZUNGBR returns P**H as - !> an N-by-N matrix. + !! ZUNGBR generates one of the complex unitary matrices Q or P**H + !! determined by ZGEBRD when reducing a complex matrix A to bidiagonal + !! form: A = Q * B * P**H. Q and P**H are defined as products of + !! elementary reflectors H(i) or G(i) respectively. + !! If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q + !! is of order M: + !! if m >= k, Q = H(1) H(2) . . . H(k) and ZUNGBR returns the first n + !! columns of Q, where m >= n >= k; + !! if m < k, Q = H(1) H(2) . . . H(m-1) and ZUNGBR returns Q as an + !! M-by-M matrix. + !! If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**H + !! is of order N: + !! if k < n, P**H = G(k) . . . G(2) G(1) and ZUNGBR returns the first m + !! rows of P**H, where n >= m >= k; + !! if k >= n, P**H = G(n-1) . . . G(2) G(1) and ZUNGBR returns P**H as + !! an N-by-N matrix. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -63952,11 +63948,11 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zungtsqr( m, n, mb, nb, a, lda, t, ldt, work, lwork,info ) - !> ZUNGTSQR generates an M-by-N complex matrix Q_out with orthonormal - !> columns, which are the first N columns of a product of comlpex unitary - !> matrices of order M which are returned by ZLATSQR - !> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). - !> See the documentation for ZLATSQR. + !! ZUNGTSQR generates an M-by-N complex matrix Q_out with orthonormal + !! columns, which are the first N columns of a product of comlpex unitary + !! matrices of order M which are returned by ZLATSQR + !! Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). + !! See the documentation for ZLATSQR. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -64050,28 +64046,28 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zunmbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, lwork, & - !> If VECT = 'Q', ZUNMBR: 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 - !> If VECT = 'P', ZUNMBR overwrites the general complex M-by-N matrix C - !> with - !> SIDE = 'L' SIDE = 'R' - !> TRANS = 'N': P * C C * P - !> TRANS = 'C': P**H * C C * P**H - !> Here Q and P**H are the unitary matrices determined by ZGEBRD when - !> reducing a complex matrix A to bidiagonal form: A = Q * B * P**H. Q - !> and P**H are defined as products of elementary reflectors H(i) and - !> G(i) respectively. - !> Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the - !> order of the unitary matrix Q or P**H that is applied. - !> If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: - !> if nq >= k, Q = H(1) H(2) . . . H(k); - !> if nq < k, Q = H(1) H(2) . . . H(nq-1). - !> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: - !> if k < nq, P = G(1) G(2) . . . G(k); - !> if k >= nq, P = G(1) G(2) . . . G(nq-1). + !! If VECT = 'Q', ZUNMBR: 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 + !! If VECT = 'P', ZUNMBR overwrites the general complex M-by-N matrix C + !! with + !! SIDE = 'L' SIDE = 'R' + !! TRANS = 'N': P * C C * P + !! TRANS = 'C': P**H * C C * P**H + !! Here Q and P**H are the unitary matrices determined by ZGEBRD when + !! reducing a complex matrix A to bidiagonal form: A = Q * B * P**H. Q + !! and P**H are defined as products of elementary reflectors H(i) and + !! G(i) respectively. + !! Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the + !! order of the unitary matrix Q or P**H that is applied. + !! If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: + !! if nq >= k, Q = H(1) H(2) . . . H(k); + !! if nq < k, Q = H(1) H(2) . . . H(nq-1). + !! If VECT = 'P', A is assumed to have been a K-by-NQ matrix: + !! if k < nq, P = G(1) G(2) . . . G(k); + !! if k >= nq, P = G(1) G(2) . . . G(nq-1). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64211,33 +64207,33 @@ module stdlib_linalg_lapack_z subroutine stdlib_zcgesv( n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work,swork, rwork, iter, & - !> ZCGESV 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. - !> ZCGESV first attempts to factorize the matrix in COMPLEX and use this - !> factorization within an iterative refinement procedure to produce a - !> solution with COMPLEX*16 normwise backward error quality (see below). - !> If the approach fails the method switches to a COMPLEX*16 - !> factorization and solve. - !> The iterative refinement is not going to be a winning strategy if - !> the ratio COMPLEX performance over COMPLEX*16 performance is too - !> small. A reasonable strategy should take the number of right-hand - !> sides and the size of the matrix into account. This might be done - !> with a call to ILAENV in the future. Up to now, we always try - !> iterative refinement. - !> The iterative refinement process is stopped if - !> ITER > ITERMAX - !> or for all the RHS we have: - !> RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX - !> where - !> o ITER is the number of the current iteration in the iterative - !> refinement process - !> o RNRM is the infinity-norm of the residual - !> o XNRM is the infinity-norm of the solution - !> o ANRM is the infinity-operator-norm of the matrix A - !> o EPS is the machine epsilon returned by DLAMCH('Epsilon') - !> The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 - !> respectively. + !! ZCGESV 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. + !! ZCGESV first attempts to factorize the matrix in COMPLEX and use this + !! factorization within an iterative refinement procedure to produce a + !! solution with COMPLEX*16 normwise backward error quality (see below). + !! If the approach fails the method switches to a COMPLEX*16 + !! factorization and solve. + !! The iterative refinement is not going to be a winning strategy if + !! the ratio COMPLEX performance over COMPLEX*16 performance is too + !! small. A reasonable strategy should take the number of right-hand + !! sides and the size of the matrix into account. This might be done + !! with a call to ILAENV in the future. Up to now, we always try + !! iterative refinement. + !! The iterative refinement process is stopped if + !! ITER > ITERMAX + !! or for all the RHS we have: + !! RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX + !! where + !! o ITER is the number of the current iteration in the iterative + !! refinement process + !! o RNRM is the infinity-norm of the residual + !! o XNRM is the infinity-norm of the solution + !! o ANRM is the infinity-operator-norm of the matrix A + !! o EPS is the machine epsilon returned by DLAMCH('Epsilon') + !! The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 + !! respectively. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64397,12 +64393,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgelq( m, n, a, lda, t, tsize, work, lwork,info ) - !> ZGELQ 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. + !! ZGELQ 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -64522,31 +64518,31 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & - !> ZGELSD 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. + !! ZGELSD 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. iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64860,18 +64856,18 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & - !> ZGELSS 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. + !! ZGELSS 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65318,38 +65314,38 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgelsy( m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank,work, lwork, rwork, & - !> ZGELSY 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. + !! ZGELSY 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65543,13 +65539,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgemlq( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & - !> ZGEMLQ 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 (ZGELQ) + !! ZGEMLQ 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 (ZGELQ) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65640,13 +65636,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgemqr( side, trans, m, n, k, a, lda, t, tsize,c, ldc, work, lwork, & - !> ZGEMQR 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 (ZGEQR) + !! ZGEMQR 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 (ZGEQR) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65737,13 +65733,13 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgeqr( m, n, a, lda, t, tsize, work, lwork,info ) - !> ZGEQR 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. + !! ZGEQR 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd. -- @@ -65852,23 +65848,23 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, iwork, & - !> ZGESDD 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. + !! ZGESDD 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67347,15 +67343,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) - !> ZGESV 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. + !! ZGESV 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -67395,17 +67391,17 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,vt, ldvt, work, lwork, rwork, & - !> ZGESVD 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. + !! ZGESVD 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69841,15 +69837,15 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgesvdq( joba, jobp, jobr, jobu, jobv, m, n, a, lda,s, u, ldu, v, ldv, & - !> ZCGESVDQ 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. + !! ZCGESVDQ 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. numrank, iwork, liwork,cwork, lcwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -70719,12 +70715,12 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgesvx( fact, trans, n, nrhs, a, lda, af, ldaf, ipiv,equed, r, c, b, ldb, & - !> ZGESVX uses the LU factorization to compute 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. - !> Error bounds on the solution and a condition estimate are also - !> provided. + !! ZGESVX uses the LU factorization to compute 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. + !! Error bounds on the solution and a condition estimate are also + !! provided. x, ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70924,24 +70920,24 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) - !> ZGETSLS 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. + !! ZGETSLS 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -71161,18 +71157,18 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgetsqrhrt( m, n, mb1, nb1, nb2, a, lda, t, ldt, work,lwork, info ) - !> ZGETSQRHRT 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 ZGEQRT - !> (Q is in blocked compact WY-representation). See the documentation - !> of ZGEQRT for more details on the format. + !! ZGETSQRHRT 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 ZGEQRT + !! (Q is in blocked compact WY-representation). See the documentation + !! of ZGEQRT for more details on the format. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71294,26 +71290,26 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgges( jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb,sdim, alpha, beta, & - !> ZGGES 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 - !> ZGGEV 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. + !! ZGGES 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 + !! ZGGEV 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. vsl, ldvsl, vsr, ldvsr, work,lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71546,28 +71542,28 @@ module stdlib_linalg_lapack_z subroutine stdlib_zggesx( jobvsl, jobvsr, sort, selctg, sense, n, a, lda,b, ldb, sdim, alpha,& - !> ZGGESX computes for a pair of N-by-N complex nonsymmetric matrices - !> (A,B), the generalized eigenvalues, the complex Schur form (S,T), - !> and, optionally, the left and/or right matrices of 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; computes - !> a reciprocal condition number for the average of the selected - !> eigenvalues (RCONDE); and computes a reciprocal condition number for - !> the right and left deflating subspaces corresponding to the selected - !> eigenvalues (RCONDV). The leading columns of VSL and VSR then form - !> an orthonormal basis for the corresponding left and right eigenspaces - !> (deflating subspaces). - !> 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 or for both being zero. - !> A pair of matrices (S,T) is in generalized complex Schur form if T is - !> upper triangular with non-negative diagonal and S is upper - !> triangular. + !! ZGGESX computes for a pair of N-by-N complex nonsymmetric matrices + !! (A,B), the generalized eigenvalues, the complex Schur form (S,T), + !! and, optionally, the left and/or right matrices of 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; computes + !! a reciprocal condition number for the average of the selected + !! eigenvalues (RCONDE); and computes a reciprocal condition number for + !! the right and left deflating subspaces corresponding to the selected + !! eigenvalues (RCONDV). The leading columns of VSL and VSR then form + !! an orthonormal basis for the corresponding left and right eigenspaces + !! (deflating subspaces). + !! 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 or for both being zero. + !! A pair of matrices (S,T) is in generalized complex Schur form if T is + !! upper triangular with non-negative diagonal and S is upper + !! triangular. beta, vsl, ldvsl, vsr,ldvsr, rconde, rcondv, work, lwork, rwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- @@ -71856,21 +71852,21 @@ module stdlib_linalg_lapack_z subroutine stdlib_zggev( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & - !> ZGGEV 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). + !! ZGGEV 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). work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72126,26 +72122,26 @@ module stdlib_linalg_lapack_z subroutine stdlib_zggevx( balanc, jobvl, jobvr, sense, n, a, lda, b, ldb,alpha, beta, vl, & - !> ZGGEVX 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. - !> Optionally, it also computes a balancing transformation to improve - !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, - !> LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for - !> the eigenvalues (RCONDE), and reciprocal condition numbers for the - !> right eigenvectors (RCONDV). - !> 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) - !> of (A,B) satisfies - !> A * v(j) = lambda(j) * B * v(j) . - !> The left eigenvector u(j) corresponding to the eigenvalue 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). + !! ZGGEVX 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. + !! Optionally, it also computes a balancing transformation to improve + !! the conditioning of the eigenvalues and eigenvectors (ILO, IHI, + !! LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for + !! the eigenvalues (RCONDE), and reciprocal condition numbers for the + !! right eigenvectors (RCONDV). + !! 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 eigenvector v(j) corresponding to the eigenvalue lambda(j) + !! of (A,B) satisfies + !! A * v(j) = lambda(j) * B * v(j) . + !! The left eigenvector u(j) corresponding to the eigenvalue 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). ldvl, vr, ldvr, ilo, ihi,lscale, rscale, abnrm, bbnrm, rconde, rcondv,work, lwork, rwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -72474,8 +72470,8 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhbev( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,rwork, info ) - !> ZHBEV computes all the eigenvalues and, optionally, eigenvectors of - !> a complex Hermitian band matrix A. + !! ZHBEV computes all the eigenvalues and, optionally, eigenvectors of + !! a complex Hermitian band matrix A. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -72578,15 +72574,15 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, rwork, lrwork, & - !> ZHBEVD 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. + !! ZHBEVD 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72728,10 +72724,10 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhbevx( jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl,vu, il, iu, abstol, & - !> ZHBEVX computes selected eigenvalues and, optionally, eigenvectors - !> of a complex Hermitian band matrix A. Eigenvalues and eigenvectors - !> can be selected by specifying either a range of values or a range of - !> indices for the desired eigenvalues. + !! ZHBEVX computes selected eigenvalues and, optionally, eigenvectors + !! of a complex Hermitian band matrix A. Eigenvalues and eigenvectors + !! can be selected by specifying either a range of values or a range of + !! indices for the desired eigenvalues. m, w, z, ldz, work, rwork,iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72959,10 +72955,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhbgv( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z,ldz, work, & - !> ZHBGV 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. + !! ZHBGV 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. rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73039,17 +73035,17 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhbgvd( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w,z, ldz, work, & - !> ZHBGVD 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. + !! ZHBGVD 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. lwork, rwork, lrwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73166,12 +73162,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhbgvx( jobz, range, uplo, n, ka, kb, ab, ldab, bb,ldbb, q, ldq, vl, & - !> ZHBGVX 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. Eigenvalues and - !> eigenvectors can be selected by specifying either all eigenvalues, - !> a range of values or a range of indices for the desired eigenvalues. + !! ZHBGVX 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. Eigenvalues and + !! eigenvectors can be selected by specifying either all eigenvalues, + !! a range of values or a range of indices for the desired eigenvalues. vu, il, iu, abstol, m, w, z,ldz, work, rwork, iwork, ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73355,15 +73351,15 @@ module stdlib_linalg_lapack_z subroutine stdlib_zheevd( jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, liwork,& - !> ZHEEVD 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. + !! ZHEEVD 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73508,17 +73504,17 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhegvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, rwork, lrwork,& - !> ZHEGVD 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. + !! ZHEGVD 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73640,15 +73636,15 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhpevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,rwork, lrwork, iwork, & - !> ZHPEVD 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. + !! ZHPEVD 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. liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73782,18 +73778,18 @@ module stdlib_linalg_lapack_z subroutine stdlib_zhpgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, rwork, lrwork,& - !> ZHPGVD 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. + !! ZHPGVD 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73915,14 +73911,14 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgees( jobvs, sort, select, n, a, lda, sdim, w, vs,ldvs, work, lwork, & - !> ZGEES 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. + !! ZGEES 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. rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74086,20 +74082,20 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgeesx( jobvs, sort, select, sense, n, a, lda, sdim, w,vs, ldvs, rconde, & - !> ZGEESX 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; - !> computes a reciprocal condition number for the average of the - !> selected eigenvalues (RCONDE); and computes a reciprocal condition - !> number for the right invariant subspace corresponding to the - !> selected eigenvalues (RCONDV). The leading columns of Z form an - !> orthonormal basis for this invariant subspace. - !> For further explanation of the reciprocal condition numbers RCONDE - !> and RCONDV, see Section 4.10_dp of the LAPACK Users' Guide (where - !> these quantities are called s and sep respectively). - !> A complex matrix is in Schur form if it is upper triangular. + !! ZGEESX 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; + !! computes a reciprocal condition number for the average of the + !! selected eigenvalues (RCONDE); and computes a reciprocal condition + !! number for the right invariant subspace corresponding to the + !! selected eigenvalues (RCONDV). The leading columns of Z form an + !! orthonormal basis for this invariant subspace. + !! For further explanation of the reciprocal condition numbers RCONDE + !! and RCONDV, see Section 4.10_dp of the LAPACK Users' Guide (where + !! these quantities are called s and sep respectively). + !! A complex matrix is in Schur form if it is upper triangular. rcondv, work, lwork, rwork,bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74288,16 +74284,16 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgeev( jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr,work, lwork, rwork, & - !> ZGEEV 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. + !! ZGEEV 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74537,31 +74533,31 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgeevx( balanc, jobvl, jobvr, sense, n, a, lda, w, vl,ldvl, vr, ldvr, ilo, & - !> ZGEEVX computes for an N-by-N complex nonsymmetric matrix A, the - !> eigenvalues and, optionally, the left and/or right eigenvectors. - !> Optionally also, it computes a balancing transformation to improve - !> the conditioning of the eigenvalues and eigenvectors (ILO, IHI, - !> SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues - !> (RCONDE), and reciprocal condition numbers for the right - !> eigenvectors (RCONDV). - !> 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. - !> Balancing a matrix means permuting the rows and columns to make it - !> more nearly upper triangular, and applying a diagonal similarity - !> transformation D * A * D**(-1), where D is a diagonal matrix, to - !> make its rows and columns closer in norm and the condition numbers - !> of its eigenvalues and eigenvectors smaller. The computed - !> reciprocal condition numbers correspond to the balanced matrix. - !> Permuting rows and columns will not change the condition numbers - !> (in exact arithmetic) but diagonal scaling will. For further - !> explanation of balancing, see section 4.10.2_dp of the LAPACK - !> Users' Guide. + !! ZGEEVX computes for an N-by-N complex nonsymmetric matrix A, the + !! eigenvalues and, optionally, the left and/or right eigenvectors. + !! Optionally also, it computes a balancing transformation to improve + !! the conditioning of the eigenvalues and eigenvectors (ILO, IHI, + !! SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues + !! (RCONDE), and reciprocal condition numbers for the right + !! eigenvectors (RCONDV). + !! 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. + !! Balancing a matrix means permuting the rows and columns to make it + !! more nearly upper triangular, and applying a diagonal similarity + !! transformation D * A * D**(-1), where D is a diagonal matrix, to + !! make its rows and columns closer in norm and the condition numbers + !! of its eigenvalues and eigenvectors smaller. The computed + !! reciprocal condition numbers correspond to the balanced matrix. + !! Permuting rows and columns will not change the condition numbers + !! (in exact arithmetic) but diagonal scaling will. For further + !! explanation of balancing, see section 4.10.2_dp of the LAPACK + !! Users' Guide. ihi, scale, abnrm, rconde,rcondv, work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74839,16 +74835,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgejsv( joba, jobu, jobv, jobr, jobt, jobp,m, n, a, lda, sva, u, ldu, & - !> ZGEJSV 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. + !! ZGEJSV 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. v, ldv,cwork, lwork, rwork, lrwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76244,15 +76240,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, cwork, lwork, & - !> ZGESVJ 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. + !! ZGESVJ 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. rwork, lrwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77096,26 +77092,26 @@ module stdlib_linalg_lapack_z subroutine stdlib_zgges3( jobvsl, jobvsr, sort, selctg, n, a, lda, b,ldb, sdim, alpha, beta, & - !> ZGGES3 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 - !> ZGGEV 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. + !! ZGGES3 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 + !! ZGGEV 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. vsl, ldvsl, vsr, ldvsr,work, lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77347,21 +77343,21 @@ module stdlib_linalg_lapack_z subroutine stdlib_zggev3( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & - !> ZGGEV3 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). + !! ZGGEV3 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). work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77619,10 +77615,10 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgsvj0( jobv, m, n, a, lda, d, sva, mv, v, ldv, eps,sfmin, tol, & - !> ZGSVJ0 is called from ZGESVJ as a pre-processor and that is its main - !> purpose. It applies Jacobi rotations in the same way as ZGESVJ does, but - !> it does not check convergence (stopping criterion). Few tuning - !> parameters (marked by [TP]) are available for the implementer. + !! ZGSVJ0 is called from ZGESVJ as a pre-processor and that is its main + !! purpose. It applies Jacobi rotations in the same way as ZGESVJ does, but + !! it does not check convergence (stopping criterion). Few tuning + !! parameters (marked by [TP]) are available for the implementer. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78160,30 +78156,30 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zgsvj1( jobv, m, n, n1, a, lda, d, sva, mv, v, ldv,eps, sfmin, tol, & - !> ZGSVJ1 is called from ZGESVJ as a pre-processor and that is its main - !> purpose. It applies Jacobi rotations in the same way as ZGESVJ 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 - !> ~~~~~~~~~~~~~~~ - !> ZGSVJ1 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. + !! ZGSVJ1 is called from ZGESVJ as a pre-processor and that is its main + !! purpose. It applies Jacobi rotations in the same way as ZGESVJ 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 + !! ~~~~~~~~~~~~~~~ + !! ZGSVJ1 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. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78533,16 +78529,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhesv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> ZHESV_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. + !! ZHESV_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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78605,12 +78601,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhetrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) - !> ZHETRF_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. + !! ZHETRF_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -78834,14 +78830,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zhseqr( job, compz, n, ilo, ihi, h, ldh, w, z, ldz,work, lwork, info ) - !> ZHSEQR 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. + !! ZHSEQR 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78979,16 +78975,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlahef_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) - !> DLAHEF_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. + !! DLAHEF_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -79223,14 +79219,14 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& - !> ZLAQR0 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. + !! ZLAQR0 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. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79570,15 +79566,15 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqr3( wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz,ihiz, z, ldz, & - !> Aggressive early deflation: - !> ZLAQR3 accepts as input an upper Hessenberg matrix - !> H and performs an unitary similarity transformation - !> designed to detect and deflate fully converged eigenvalues from - !> a trailing principal submatrix. On output H has been over- - !> written by a new Hessenberg matrix that is a perturbation of - !> an unitary similarity transformation of H. It is to be - !> hoped that the final version of H has many zero subdiagonal - !> entries. + !! Aggressive early deflation: + !! ZLAQR3 accepts as input an upper Hessenberg matrix + !! H and performs an unitary similarity transformation + !! designed to detect and deflate fully converged eigenvalues from + !! a trailing principal submatrix. On output H has been over- + !! written by a new Hessenberg matrix that is a perturbation of + !! an unitary similarity transformation of H. It is to be + !! hoped that the final version of H has many zero subdiagonal + !! entries. ns, nd, sh, v, ldv, nh, t, ldt,nv, wv, ldwv, work, lwork ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79792,20 +79788,20 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlaqr4( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, work,& - !> ZLAQR4 implements one level of recursion for ZLAQR0. - !> It is a complete implementation of the small bulge multi-shift - !> QR algorithm. It may be called by ZLAQR0 and, for large enough - !> deflation window size, it may be called by ZLAQR3. This - !> subroutine is identical to ZLAQR0 except that it calls ZLAQR2 - !> instead of ZLAQR3. - !> ZLAQR4 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. + !! ZLAQR4 implements one level of recursion for ZLAQR0. + !! It is a complete implementation of the small bulge multi-shift + !! QR algorithm. It may be called by ZLAQR0 and, for large enough + !! deflation window size, it may be called by ZLAQR3. This + !! subroutine is identical to ZLAQR0 except that it calls ZLAQR2 + !! instead of ZLAQR3. + !! ZLAQR4 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. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80140,46 +80136,46 @@ module stdlib_linalg_lapack_z recursive subroutine stdlib_zlaqz0( wants, wantq, wantz, n, ilo, ihi, a,lda, b, ldb, alpha, & - !> ZLAQZ0 computes the eigenvalues of a real 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 real matrix pair (A,B): - !> A = Q1*H*Z1**H, B = Q1*T*Z1**H, - !> as computed by ZGGHRD. - !> 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 ZGGHRD 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" + !! ZLAQZ0 computes the eigenvalues of a real 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 real matrix pair (A,B): + !! A = Q1*H*Z1**H, B = Q1*T*Z1**H, + !! as computed by ZGGHRD. + !! 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 ZGGHRD 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" beta, q, ldq, z,ldz, work, lwork, rwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -80493,7 +80489,7 @@ module stdlib_linalg_lapack_z recursive subroutine stdlib_zlaqz2( ilschur, ilq, ilz, n, ilo, ihi, nw,a, lda, b, ldb, q, & - !> ZLAQZ2 performs AED + !! ZLAQZ2 performs AED ldq, z, ldz, ns,nd, alpha, beta, qc, ldqc, zc, ldzc,work, lwork, rwork, rec, info ) ! arguments logical(lk), intent( in ) :: ilschur, ilq, ilz @@ -80682,16 +80678,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zlasyf_aa( uplo, j1, m, nb, a, lda, ipiv,h, ldh, work ) - !> 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. + !! 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -80918,16 +80914,16 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) - !> ZSYSV computes the solution to a complex system of linear equations - !> A * X = B, - !> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS - !> matrices. - !> Aasen's algorithm is used to factor A as - !> A = U**T * T * U, if UPLO = 'U', or - !> A = L * T * L**T, if UPLO = 'L', - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and T is symmetric tridiagonal. The factored - !> form of A is then used to solve the system of equations A * X = B. + !! ZSYSV computes the solution to a complex system of linear equations + !! A * X = B, + !! where A is an N-by-N symmetric matrix and X and B are N-by-NRHS + !! matrices. + !! Aasen's algorithm is used to factor A as + !! A = U**T * T * U, if UPLO = 'U', or + !! A = L * T * L**T, if UPLO = 'L', + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and T is symmetric tridiagonal. The factored + !! form of A is then used to solve the system of equations A * X = B. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80990,12 +80986,12 @@ module stdlib_linalg_lapack_z pure subroutine stdlib_zsytrf_aa( uplo, n, a, lda, ipiv, work, lwork, info) - !> ZSYTRF_AA computes the factorization of a complex symmetric matrix A - !> using the Aasen's algorithm. The form of the factorization is - !> A = U**T*T*U or A = L*T*L**T - !> where U (or L) is a product of permutation and unit upper (lower) - !> triangular matrices, and T is a complex symmetric tridiagonal matrix. - !> This is the blocked version of the algorithm, calling Level 3 BLAS. + !! ZSYTRF_AA computes the factorization of a complex symmetric matrix A + !! using the Aasen's algorithm. The form of the factorization is + !! A = U**T*T*U or A = L*T*L**T + !! where U (or L) is a product of permutation and unit upper (lower) + !! triangular matrices, and T is a complex symmetric tridiagonal matrix. + !! This is the blocked version of the algorithm, calling Level 3 BLAS. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- From 2c4f0876558fd67b2fc4f2a5da9d3d494b1610b8 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 Apr 2024 10:41:43 +0200 Subject: [PATCH 3/3] remove inadvertently added script --- src/refactor_interfaces.py | 115 ------------------------------------- 1 file changed, 115 deletions(-) delete mode 100644 src/refactor_interfaces.py diff --git a/src/refactor_interfaces.py b/src/refactor_interfaces.py deleted file mode 100644 index a07c709a3..000000000 --- a/src/refactor_interfaces.py +++ /dev/null @@ -1,115 +0,0 @@ - -import re -import copy -from platform import os - -def refactor_interfaces(file_name,interface_module): - - # Parse whole file - file_body = [] - comment_block = False - comment_body = [] - is_sub = False - is_fun = False - is_interface = False - - # FiLoad whole file; split by lines; join concatenation lines - with open(os.path.join(file_name), 'r') as file: - # Create an empty list to store the lines - - # Iterate over the lines of the file - for line in file: - - lsl = line.strip() - - is_comment = lsl.startswith('!>') - if not interface_module: - is_sub = bool(re.match(r'(?:.)*subroutine\s+stdlib_(\w+)',line)) - is_fun = bool(re.match(r'(?:.)*function stdlib_(\w+)',line)) - - - - else: - is_interface = lsl.startswith('interface') - - if is_comment: - # Start saving this new comment block - if not comment_block: comment_body = [] - - - # At the beginnging of a comment block, do not include empty comments - if lsl=='!> !' or lsl=='!>': - comment_block = False - line = '' - else: - comment_block = True - comment_body.append(line) - - elif is_interface or is_sub or is_fun: - # Comment is over and we're now at an interface: append interface line, follow - # documentaion - file_body.append(line) - - if is_interface: - interface_name = re.search(r'interface (\w+)',line).group(1) - elif is_sub: - print(line) - interface_name = re.search(r'(?:.)*subroutine\s+stdlib_(\w+)',line).group(1) - elif is_fun: - print(line) - - interface_name = re.search(r'(?:.)*function stdlib_(\w+)',line).group(1) - - axpy = interface_name.strip().upper() - search_label = r'!> '+axpy+r':\s*' - - if not comment_body is None: - for k in range(len(comment_body)): - - nointerf = re.sub(search_label,r'!> '+axpy+' ',comment_body[k]) - nointerf = re.sub(r'!> ',r'!! ',nointerf) - file_body.append(nointerf) - - comment_body = [] - - else: - # Regular body: just append line - file_body.append(line) - - - - # print file out - fid = open(file_name,"w") - - # Header - fid.write(''.join(file_body)) - fid.close() - - - -# Run refactor -refactor_interfaces('stdlib_linalg_blas.fypp',True) -refactor_interfaces('stdlib_linalg_blas_aux.fypp',False) -refactor_interfaces('stdlib_linalg_blas_s.fypp',False) -refactor_interfaces('stdlib_linalg_blas_d.fypp',False) -refactor_interfaces('stdlib_linalg_blas_q.fypp',False) -refactor_interfaces('stdlib_linalg_blas_c.fypp',False) -refactor_interfaces('stdlib_linalg_blas_z.fypp',False) -refactor_interfaces('stdlib_linalg_blas_w.fypp',False) -refactor_interfaces('stdlib_linalg_lapack.fypp',True) -refactor_interfaces('stdlib_linalg_lapack_aux.fypp',False) -refactor_interfaces('stdlib_linalg_lapack_s.fypp',False) -refactor_interfaces('stdlib_linalg_lapack_d.fypp',False) -refactor_interfaces('stdlib_linalg_lapack_q.fypp',False) -refactor_interfaces('stdlib_linalg_lapack_c.fypp',False) -refactor_interfaces('stdlib_linalg_lapack_z.fypp',False) -refactor_interfaces('stdlib_linalg_lapack_w.fypp',False) - - - - - - - - -