diff --git a/src/stdlib_linalg_blas.fypp b/src/stdlib_linalg_blas.fypp index 8c5bdb60e..0bec4e6d3 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 - !> 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 + !! 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 @@ -281,13 +281,13 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -346,12 +346,12 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -410,11 +410,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -444,11 +444,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -478,11 +478,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -512,11 +512,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -548,13 +548,13 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -586,11 +586,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -622,11 +622,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -660,11 +660,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -696,14 +696,14 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -737,14 +737,14 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -778,11 +778,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -814,11 +814,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -852,11 +852,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -888,12 +888,10 @@ module stdlib_linalg_blas - !> ! - !> - !> NRM2: returns the euclidean norm of a vector via the function - !> name, so that - !> NRM2 := sqrt( x'*x ) interface nrm2 + !! 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 @@ -921,8 +919,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,22 +950,20 @@ module stdlib_linalg_blas - !> ! - !> - !> 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. 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. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine crotg( a, b, c, s ) import sp,dp,qp,ilp,lk @@ -1022,18 +1018,18 @@ module stdlib_linalg_blas - !> 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. 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. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine drotm(n,dx,incx,dy,incy,dparam) import sp,dp,qp,ilp,lk @@ -1063,20 +1059,20 @@ module stdlib_linalg_blas - !> 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. 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. #ifdef STDLIB_EXTERNAL_BLAS pure subroutine drotmg(dd1,dd2,dx1,dy1,dparam) import sp,dp,qp,ilp,lk @@ -1106,11 +1102,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -1142,8 +1138,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 +1194,13 @@ module stdlib_linalg_blas - !> 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. 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. #ifdef STDLIB_EXTERNAL_BLAS pure real(dp) function dsdot(n,sx,incx,sy,incy) import sp,dp,qp,ilp,lk @@ -1222,11 +1218,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -1258,11 +1254,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -1294,11 +1290,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -1330,10 +1326,10 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -1349,8 +1345,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 +1362,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 +1414,13 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -1483,11 +1479,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -1519,11 +1515,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -1555,11 +1551,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -1591,14 +1587,14 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -1657,14 +1653,14 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -1723,11 +1719,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -1786,14 +1782,14 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -1852,11 +1848,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -1915,13 +1911,13 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -1980,12 +1976,12 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -2044,11 +2040,11 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -2107,13 +2103,13 @@ module stdlib_linalg_blas - !> 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 + !! 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 @@ -2172,13 +2168,13 @@ module stdlib_linalg_blas - !> 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 + !! 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 20e024487..10ce0e7cd 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. - !> 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 ) + !! 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..-- @@ -214,24 +214,24 @@ module stdlib_linalg_blas_aux end subroutine stdlib_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. 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. ! -- 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..7a6145506 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 - !> 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) + !! 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..-- @@ -412,14 +412,14 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cgbmv - !> 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) + !! 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..-- @@ -661,13 +661,13 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cgemm - !> 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) + !! 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..-- @@ -822,12 +822,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cgemv - !> 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) + !! 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..-- @@ -901,12 +901,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cgerc - !> 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) + !! 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..-- @@ -980,12 +980,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cgeru - !> 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) + !! 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..-- @@ -1143,14 +1143,14 @@ module stdlib_linalg_blas_c return end subroutine stdlib_chbmv - !> 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) + !! 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..-- @@ -1293,12 +1293,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_chemm - !> 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) + !! 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..-- @@ -1446,12 +1446,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_chemv - !> 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) + !! 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..-- @@ -1561,12 +1561,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cher - !> 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) + !! 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..-- @@ -1700,15 +1700,15 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cher2 - !> 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) + !! 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..-- @@ -1909,15 +1909,15 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cher2k - !> 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) + !! 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..-- @@ -2105,12 +2105,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cherk - !> 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) + !! 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..-- @@ -2264,12 +2264,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_chpmv - !> 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) + !! 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..-- @@ -2386,12 +2386,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_chpr - !> 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) + !! 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..-- @@ -2531,23 +2531,21 @@ module stdlib_linalg_blas_c return end subroutine stdlib_chpr2 - !> ! - !> - !> 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. 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. ! -- 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 +2646,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 +2676,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 +2720,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 +2752,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 +2792,14 @@ module stdlib_linalg_blas_c return end subroutine stdlib_cswap - !> 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) + !! 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..-- @@ -2942,15 +2940,15 @@ module stdlib_linalg_blas_c return end subroutine stdlib_csymm - !> 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) + !! 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..-- @@ -3118,15 +3116,15 @@ module stdlib_linalg_blas_c return end subroutine stdlib_csyr2k - !> 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) + !! 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..-- @@ -3286,12 +3284,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_csyrk - !> 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) + !! 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..-- @@ -3500,15 +3498,15 @@ module stdlib_linalg_blas_c return end subroutine stdlib_ctbmv - !> 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) + !! 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..-- @@ -3717,12 +3715,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_ctbsv - !> 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) + !! 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..-- @@ -3934,14 +3932,14 @@ module stdlib_linalg_blas_c return end subroutine stdlib_ctpmv - !> 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) + !! 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..-- @@ -4153,13 +4151,13 @@ module stdlib_linalg_blas_c return end subroutine stdlib_ctpsv - !> 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) + !! 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..-- @@ -4395,12 +4393,12 @@ module stdlib_linalg_blas_c return end subroutine stdlib_ctrmm - !> 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) + !! 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..-- @@ -4592,14 +4590,14 @@ module stdlib_linalg_blas_c return end subroutine stdlib_ctrmv - !> 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) + !! 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..-- @@ -4857,14 +4855,14 @@ module stdlib_linalg_blas_c return end subroutine stdlib_ctrsm - !> 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) + !! 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 125ad603c..13942ba09 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 - !> 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) + !! 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..-- @@ -451,14 +451,14 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dgbmv - !> 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) + !! 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..-- @@ -614,12 +614,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dgemm - !> 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) + !! 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..-- @@ -758,12 +758,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dgemv - !> 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) + !! 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..-- @@ -837,13 +837,11 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dger - !> ! - !> - !> 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 ) + !! 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, -- @@ -927,9 +925,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,24 +966,22 @@ module stdlib_linalg_blas_d return end subroutine stdlib_drot - !> ! - !> - !> 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). 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). ! -- 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,19 +1027,19 @@ module stdlib_linalg_blas_d return end subroutine stdlib_drotg - !> 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. 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. ! -- 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,21 +1134,21 @@ module stdlib_linalg_blas_d return end subroutine stdlib_drotm - !> 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. 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. ! -- 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 +1300,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_drotmg - !> 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) + !! 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..-- @@ -1466,10 +1462,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 +1508,14 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dscal - !> 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(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. ! -- 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 +1555,12 @@ module stdlib_linalg_blas_d return end function stdlib_dsdot - !> 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) + !! 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..-- @@ -1715,12 +1711,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dspmv - !> 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) + !! 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..-- @@ -1822,12 +1818,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dspr - !> 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) + !! 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..-- @@ -1949,10 +1945,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 +2005,14 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dswap - !> 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) + !! 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..-- @@ -2156,12 +2152,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dsymm - !> 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) + !! 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..-- @@ -2308,12 +2304,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dsymv - !> 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) + !! 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..-- @@ -2411,12 +2407,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dsyr - !> 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) + !! 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..-- @@ -2534,15 +2530,15 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dsyr2 - !> 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) + !! 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..-- @@ -2709,15 +2705,15 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dsyr2k - !> 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) + !! 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..-- @@ -2876,12 +2872,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dsyrk - !> 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) + !! 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..-- @@ -3059,15 +3055,15 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dtbmv - !> 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) + !! 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..-- @@ -3245,12 +3241,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dtbsv - !> 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) + !! 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..-- @@ -3427,14 +3423,14 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dtpmv - !> 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) + !! 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..-- @@ -3611,13 +3607,13 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dtpsv - !> 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) + !! 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..-- @@ -3817,12 +3813,12 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dtrmm - !> 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) + !! 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..-- @@ -3983,14 +3979,14 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dtrmv - !> 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) + !! 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..-- @@ -4214,14 +4210,14 @@ module stdlib_linalg_blas_d return end subroutine stdlib_dtrsm - !> 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) + !! 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..-- @@ -4382,10 +4378,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 +4412,11 @@ module stdlib_linalg_blas_d return end function stdlib_dzasum - !> ! - !> - !> 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 ) + !! 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 b7209fd35..647636ef0 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 - !> 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) + !! 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..-- @@ -454,14 +454,14 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qgbmv - !> 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) + !! 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..-- @@ -617,12 +617,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qgemm - !> 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) + !! 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..-- @@ -761,12 +761,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qgemv - !> 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) + !! 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..-- @@ -840,13 +840,11 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qger - !> ! - !> - !> 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 ) + !! 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, -- @@ -930,9 +928,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,24 +969,22 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qrot - !> ! - !> - !> 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). 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). ! -- 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,19 +1030,19 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qrotg - !> 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. 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. ! -- 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,21 +1137,21 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qrotm - !> 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. 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. ! -- 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 +1303,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qrotmg - !> 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) + !! 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..-- @@ -1469,10 +1465,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 +1511,14 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qscal - !> 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) + !! 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..-- @@ -1562,12 +1558,12 @@ module stdlib_linalg_blas_q return end function stdlib_qsdot - !> 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) + !! 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..-- @@ -1718,12 +1714,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qspmv - !> 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) + !! 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..-- @@ -1825,12 +1821,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qspr - !> 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) + !! 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..-- @@ -1952,10 +1948,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 +2008,14 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qswap - !> 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) + !! 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..-- @@ -2159,12 +2155,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qsymm - !> 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) + !! 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..-- @@ -2311,12 +2307,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qsymv - !> 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) + !! 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..-- @@ -2414,12 +2410,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qsyr - !> 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) + !! 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..-- @@ -2537,15 +2533,15 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qsyr2 - !> 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_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. ! -- 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,15 +2708,15 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qsyr2k - !> 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_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. ! -- 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 +2875,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qsyrk - !> 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) + !! 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..-- @@ -3062,15 +3058,15 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qtbmv - !> 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_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. ! -- 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 +3244,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qtbsv - !> 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) + !! 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..-- @@ -3430,14 +3426,14 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qtpmv - !> 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) + !! 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..-- @@ -3614,13 +3610,13 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qtpsv - !> 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) + !! 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..-- @@ -3820,12 +3816,12 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qtrmm - !> 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) + !! 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..-- @@ -3986,14 +3982,14 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qtrmv - !> 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) + !! 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..-- @@ -4217,14 +4213,14 @@ module stdlib_linalg_blas_q return end subroutine stdlib_qtrsm - !> 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) + !! 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..-- @@ -4385,10 +4381,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 +4415,11 @@ module stdlib_linalg_blas_q return end function stdlib_qzasum - !> ! - !> - !> 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 ) + !! 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 504af9d3a..9270500b1 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,11 @@ module stdlib_linalg_blas_s return end function stdlib_scasum - !> ! - !> - !> 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 ) + !! 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, -- @@ -321,10 +319,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 +373,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 +428,14 @@ module stdlib_linalg_blas_s return end function stdlib_sdot - !> 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. pure real(sp) function stdlib_sdsdot(n,sb,sx,incx,sy,incy) + !! Compute the inner product of two vectors with extended + !! precision accumulation. + !! Returns S.P. result with dot product accumulated in D.P. + !! SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY), + !! where LX = 1 if INCX >= 0, else LX = 1+(1-N)*INCX, and LY is + !! defined in a similar way using INCY. ! -- reference blas level1 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- @@ -478,12 +476,12 @@ module stdlib_linalg_blas_s return end function stdlib_sdsdot - !> 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) + !! 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..-- @@ -633,14 +631,14 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sgbmv - !> 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) + !! 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..-- @@ -796,12 +794,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sgemm - !> 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) + !! 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..-- @@ -940,12 +938,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sgemv - !> 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) + !! 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..-- @@ -1019,13 +1017,11 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sger - !> ! - !> - !> 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 ) + !! 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, -- @@ -1109,9 +1105,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,24 +1146,22 @@ module stdlib_linalg_blas_s return end subroutine stdlib_srot - !> ! - !> - !> 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). 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). ! -- 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,19 +1207,19 @@ module stdlib_linalg_blas_s return end subroutine stdlib_srotg - !> 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. 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. ! -- 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,21 +1314,21 @@ module stdlib_linalg_blas_s return end subroutine stdlib_srotm - !> 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. 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. ! -- 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 +1480,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_srotmg - !> 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) + !! 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..-- @@ -1648,10 +1642,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 +1688,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sscal - !> 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) + !! 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..-- @@ -1850,12 +1844,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sspmv - !> 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) + !! 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..-- @@ -1957,12 +1951,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sspr - !> 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) + !! 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..-- @@ -2084,10 +2078,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 +2138,14 @@ module stdlib_linalg_blas_s return end subroutine stdlib_sswap - !> 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) + !! 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..-- @@ -2291,12 +2285,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_ssymm - !> 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) + !! 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..-- @@ -2443,12 +2437,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_ssymv - !> 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) + !! 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..-- @@ -2546,12 +2540,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_ssyr - !> 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) + !! 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..-- @@ -2669,15 +2663,15 @@ module stdlib_linalg_blas_s return end subroutine stdlib_ssyr2 - !> 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) + !! 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..-- @@ -2844,15 +2838,15 @@ module stdlib_linalg_blas_s return end subroutine stdlib_ssyr2k - !> 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) + !! 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..-- @@ -3011,12 +3005,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_ssyrk - !> 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) + !! 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..-- @@ -3194,15 +3188,15 @@ module stdlib_linalg_blas_s return end subroutine stdlib_stbmv - !> 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) + !! 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..-- @@ -3380,12 +3374,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_stbsv - !> 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) + !! 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..-- @@ -3562,14 +3556,14 @@ module stdlib_linalg_blas_s return end subroutine stdlib_stpmv - !> 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) + !! 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..-- @@ -3746,13 +3740,13 @@ module stdlib_linalg_blas_s return end subroutine stdlib_stpsv - !> 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) + !! 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..-- @@ -3952,12 +3946,12 @@ module stdlib_linalg_blas_s return end subroutine stdlib_strmm - !> 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) + !! 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..-- @@ -4118,14 +4112,14 @@ module stdlib_linalg_blas_s return end subroutine stdlib_strmv - !> 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) + !! 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..-- @@ -4349,14 +4343,14 @@ module stdlib_linalg_blas_s return end subroutine stdlib_strsm - !> 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) + !! 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 841dd9aee..dafc4a314 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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) + !! 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..-- @@ -493,14 +493,14 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wgbmv - !> 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) + !! 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..-- @@ -742,13 +742,13 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wgemm - !> 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) + !! 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..-- @@ -903,12 +903,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wgemv - !> 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) + !! 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..-- @@ -982,12 +982,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wgerc - !> 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) + !! 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..-- @@ -1061,12 +1061,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wgeru - !> 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) + !! 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..-- @@ -1224,14 +1224,14 @@ module stdlib_linalg_blas_w return end subroutine stdlib_whbmv - !> 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) + !! 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..-- @@ -1374,12 +1374,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_whemm - !> 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) + !! 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..-- @@ -1527,12 +1527,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_whemv - !> 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) + !! 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..-- @@ -1642,12 +1642,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wher - !> 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) + !! 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..-- @@ -1781,15 +1781,15 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wher2 - !> 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_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. ! -- 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,15 +1990,15 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wher2k - !> 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_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. ! -- 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 - !> 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) + !! 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..-- @@ -2345,12 +2345,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_whpmv - !> 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) + !! 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..-- @@ -2467,12 +2467,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_whpr - !> 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) + !! 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..-- @@ -2612,23 +2612,21 @@ module stdlib_linalg_blas_w return end subroutine stdlib_whpr2 - !> ! - !> - !> 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. 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. ! -- 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 +2727,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 +2757,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 +2797,14 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wswap - !> 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) + !! 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..-- @@ -2947,15 +2945,15 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wsymm - !> 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_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. ! -- 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,15 +3121,15 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wsyr2k - !> 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_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. ! -- 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 +3289,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wsyrk - !> 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) + !! 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..-- @@ -3505,15 +3503,15 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wtbmv - !> 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_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. ! -- 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 +3720,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wtbsv - !> 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) + !! 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..-- @@ -3939,14 +3937,14 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wtpmv - !> 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) + !! 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..-- @@ -4158,13 +4156,13 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wtpsv - !> 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) + !! 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..-- @@ -4400,12 +4398,12 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wtrmm - !> 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) + !! 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..-- @@ -4597,14 +4595,14 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wtrmv - !> 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) + !! 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..-- @@ -4862,14 +4860,14 @@ module stdlib_linalg_blas_w return end subroutine stdlib_wtrsm - !> 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) + !! 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 00e4e3181..5711d23b3 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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) + !! 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..-- @@ -490,14 +490,14 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zgbmv - !> 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) + !! 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..-- @@ -739,13 +739,13 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zgemm - !> 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) + !! 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..-- @@ -900,12 +900,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zgemv - !> 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) + !! 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..-- @@ -979,12 +979,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zgerc - !> 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) + !! 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..-- @@ -1058,12 +1058,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zgeru - !> 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) + !! 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..-- @@ -1221,14 +1221,14 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zhbmv - !> 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) + !! 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..-- @@ -1371,12 +1371,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zhemm - !> 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) + !! 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..-- @@ -1524,12 +1524,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zhemv - !> 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) + !! 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..-- @@ -1639,12 +1639,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zher - !> 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) + !! 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..-- @@ -1778,15 +1778,15 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zher2 - !> 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) + !! 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..-- @@ -1987,15 +1987,15 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zher2k - !> 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) + !! 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..-- @@ -2183,12 +2183,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zherk - !> 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) + !! 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..-- @@ -2342,12 +2342,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zhpmv - !> 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) + !! 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..-- @@ -2464,12 +2464,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zhpr - !> 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) + !! 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..-- @@ -2609,23 +2609,21 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zhpr2 - !> ! - !> - !> 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. 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. ! -- 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 +2724,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 +2754,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 +2794,14 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zswap - !> 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) + !! 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..-- @@ -2944,15 +2942,15 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zsymm - !> 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) + !! 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..-- @@ -3120,15 +3118,15 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zsyr2k - !> 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) + !! 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..-- @@ -3288,12 +3286,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_zsyrk - !> 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) + !! 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..-- @@ -3502,15 +3500,15 @@ module stdlib_linalg_blas_z return end subroutine stdlib_ztbmv - !> 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) + !! 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..-- @@ -3719,12 +3717,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_ztbsv - !> 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) + !! 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..-- @@ -3936,14 +3934,14 @@ module stdlib_linalg_blas_z return end subroutine stdlib_ztpmv - !> 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) + !! 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..-- @@ -4155,13 +4153,13 @@ module stdlib_linalg_blas_z return end subroutine stdlib_ztpsv - !> 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) + !! 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..-- @@ -4397,12 +4395,12 @@ module stdlib_linalg_blas_z return end subroutine stdlib_ztrmm - !> 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) + !! 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..-- @@ -4594,14 +4592,14 @@ module stdlib_linalg_blas_z return end subroutine stdlib_ztrmv - !> 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) + !! 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..-- @@ -4859,14 +4857,14 @@ module stdlib_linalg_blas_z return end subroutine stdlib_ztrsm - !> 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) + !! 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 46c299ec7..8d0b4ce2c 100644 --- a/src/stdlib_linalg_lapack.fypp +++ b/src/stdlib_linalg_lapack.fypp @@ -16,28 +16,28 @@ module stdlib_linalg_lapack implicit none(type,external) public - !> 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. 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. #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,23 +118,23 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dbdsdc( uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq,work, iwork, & info ) @@ -170,31 +170,31 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cbdsqr( uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u,ldu, c, ldc, & rwork, info ) @@ -263,20 +263,20 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 ) @@ -383,13 +383,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -460,16 +460,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgbequ( m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,amax, info ) @@ -532,22 +532,22 @@ module stdlib_linalg_lapack - !> 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). 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). #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 - !> equations when the coefficient matrix is banded, and provides - !> error bounds and backward error estimates for the solution. 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. #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,15 +686,15 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> using partial pivoting with row interchanges. - !> This is the blocked version of the algorithm, calling Level 3 BLAS. 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. #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 - !> 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 + !! 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 ) @@ -878,10 +878,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -944,15 +944,15 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 @@ -1079,13 +1079,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -1154,16 +1154,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeequ( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) import sp,dp,qp,ilp,lk @@ -1222,22 +1222,22 @@ module stdlib_linalg_lapack - !> 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). 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgeequb( m, n, a, lda, r, c, rowcnd, colcnd, amax,info ) import sp,dp,qp,ilp,lk @@ -1296,15 +1296,15 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgees( jobvs, sort, select, n, a, lda, sdim, w, vs,ldvs, work, lwork, & rwork, bwork, info ) @@ -1381,17 +1381,17 @@ module stdlib_linalg_lapack - !> 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. 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. #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,17 +1521,17 @@ module stdlib_linalg_lapack - !> 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. 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. #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: - !> 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 + !! 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 @@ -1665,13 +1665,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -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 - !> 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 + !! 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 @@ -1854,25 +1854,25 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgels( trans, m, n, nrhs, a, lda, b, ldb, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -1935,32 +1935,32 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgelsd( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & iwork, info ) @@ -2029,19 +2029,19 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgelss( m, n, nrhs, a, lda, b, ldb, s, rcond, rank,work, lwork, rwork, & info ) @@ -2110,39 +2110,39 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 ) @@ -2293,16 +2293,16 @@ module stdlib_linalg_lapack - !> 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'. 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'. #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 - !> 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 + !! 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 ) @@ -2451,16 +2451,16 @@ module stdlib_linalg_lapack - !> 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'. 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'. #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: - !> 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 + !! 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 @@ -2658,15 +2658,15 @@ module stdlib_linalg_lapack - !> 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. 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. #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: - !> 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 + !! 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 @@ -2791,15 +2791,15 @@ module stdlib_linalg_lapack - !> 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. 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. #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, - !> 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 + !! 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 @@ -3043,10 +3043,10 @@ module stdlib_linalg_lapack - !> GERFS: improves the computed solution to a system of linear - !> equations and provides error bounds and backward error estimates for - !> the solution. interface gerfs + !! 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 ) @@ -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,24 +3180,24 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgesdd( jobz, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, rwork, & iwork, info ) @@ -3266,16 +3266,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgesv( n, nrhs, a, lda, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -3330,18 +3330,18 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt,work, lwork, & rwork, info ) @@ -3410,16 +3410,16 @@ module stdlib_linalg_lapack - !> 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. 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. #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,16 +3492,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgesvj( joba, jobu, jobv, m, n, a, lda, sva, mv, v,ldv, cwork, & lwork, rwork, lrwork, info ) @@ -3570,15 +3570,15 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgetrf( m, n, a, lda, ipiv, info ) import sp,dp,qp,ilp,lk @@ -3633,26 +3633,26 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 @@ -3770,11 +3770,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -3837,25 +3837,25 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cgetsls( trans, m, n, nrhs, a, lda, b, ldb,work, lwork, info ) import sp,dp,qp,ilp,lk @@ -3918,19 +3918,19 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 ) @@ -4064,16 +4064,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cggbal( job, n, a, lda, b, ldb, ilo, ihi, lscale,rscale, work, & info ) @@ -4140,27 +4140,27 @@ module stdlib_linalg_lapack - !> 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. 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. #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,22 +4241,22 @@ module stdlib_linalg_lapack - !> 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). 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). #ifdef STDLIB_EXTERNAL_LAPACK subroutine cggev( jobvl, jobvr, n, a, lda, b, ldb, alpha, beta,vl, ldvl, vr, ldvr, & work, lwork, rwork, info ) @@ -4329,25 +4329,25 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cggglm( n, m, p, a, lda, b, ldb, d, x, y, work, lwork,info ) @@ -4410,30 +4410,30 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgghrd( compq, compz, n, ilo, ihi, a, lda, b, ldb, q,ldq, z, ldz, & info ) @@ -4496,19 +4496,19 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cgglse( m, n, p, a, lda, b, ldb, c, d, x, work, lwork,info ) @@ -4571,25 +4571,25 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cggqrf( n, m, p, a, lda, taua, b, ldb, taub, work,lwork, info ) @@ -4652,25 +4652,25 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 ) @@ -4810,31 +4810,31 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 ) @@ -4983,10 +4983,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -5063,13 +5063,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -5124,14 +5124,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -5190,11 +5190,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -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,16 +5335,16 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 ) @@ -5429,11 +5429,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -5471,18 +5471,18 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> tridiagonal form T by a unitary similarity transformation: - !> Q**H * A * Q = T. 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. #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 - !> 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 + !! 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 @@ -5604,12 +5604,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -5649,14 +5649,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -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,16 +5730,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cheevd( jobz, uplo, n, a, lda, w, work, lwork, rwork,lrwork, iwork, & liwork, info ) @@ -5777,57 +5777,57 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 @@ -5906,12 +5906,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 & ) @@ -5949,18 +5949,18 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> equations when the coefficient matrix is Hermitian indefinite, and - !> provides error bounds and backward error estimates for the solution. 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. #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,18 +6041,18 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chesv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -6088,17 +6088,17 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chesv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -6134,21 +6134,21 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chesv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info & ) @@ -6184,23 +6184,23 @@ module stdlib_linalg_lapack - !> 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). 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). #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,16 +6268,16 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 @@ -6350,10 +6350,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -6389,10 +6389,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -6430,10 +6430,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 & ) @@ -6469,15 +6469,15 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 @@ -6551,16 +6551,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chetrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -6594,15 +6594,15 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> A using the factorization A = U*D*U**H or A = L*D*L**H computed by - !> CHETRF. 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. #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 - !> A using the factorization A = U*D*U**H or A = L*D*L**H computed by - !> CHETRF_ROOK. 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. #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 - !> Hermitian matrix A using the factorization A = U*D*U**H or - !> A = L*D*L**H computed by CHETRF. 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. #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 - !> 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 + !! 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 @@ -6784,16 +6784,16 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> hermitian matrix A using the factorization A = U**H*T*U or - !> A = L*T*L**H computed by CHETRF_AA. 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. #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 - !> Hermitian matrix A using the factorization A = U*D*U**H or - !> A = L*D*L**H computed by CHETRF_ROOK. 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. #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 - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chfrk( transr, uplo, trans, n, k, alpha, a, lda, beta,c ) import sp,dp,qp,ilp,lk @@ -6947,40 +6947,40 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 @@ -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,16 +7130,16 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 @@ -7218,12 +7218,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -7261,19 +7261,19 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> equations when the coefficient matrix is Hermitian indefinite - !> and packed, and provides error bounds and backward error estimates - !> for the solution. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine chprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx,ferr, berr, & work, rwork, info ) @@ -7355,18 +7355,18 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> real symmetric tridiagonal form T by a unitary similarity - !> transformation: Q**H * A * Q = T. 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. #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 - !> 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 + !! 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 @@ -7475,10 +7475,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -7512,10 +7512,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -7549,13 +7549,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -7632,15 +7632,15 @@ module stdlib_linalg_lapack - !> 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. 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. #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. - !> otherwise. To be replaced by the Fortran 2003 intrinsic in the - !> future. interface isnan + !! 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 @@ -7736,20 +7736,20 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cla_gbamv( trans, m, n, kl, ku, alpha, ab, ldab, x,incx, beta, y, incy ) @@ -7810,16 +7810,16 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 ) @@ -7960,20 +7960,20 @@ module stdlib_linalg_lapack - !> 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. 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. #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,16 +8030,16 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 @@ -8176,19 +8176,19 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 ) @@ -8304,12 +8304,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -8366,16 +8366,16 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 @@ -8520,19 +8520,19 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cla_syamv( uplo, n, alpha, a, lda, x, incx, beta, y,incy ) import sp,dp,qp,ilp,lk @@ -8589,16 +8589,16 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 ) @@ -8747,10 +8747,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -8805,15 +8805,15 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 @@ -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: - !> 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 + !! 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 @@ -9096,11 +9096,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -9130,10 +9130,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -9159,14 +9159,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -9250,38 +9250,38 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 ) @@ -9390,33 +9390,33 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaed1( n, d, q, ldq, indxq, rho, cutpnt, work, iwork,info ) @@ -9452,17 +9452,17 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaed4( n, i, d, z, delta, rho, dlam, info ) import sp,dp,qp,ilp,lk @@ -9494,14 +9494,14 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaed5( i, d, z, delta, rho, dlam ) import sp,dp,qp,ilp,lk @@ -9531,18 +9531,18 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaed6( kniter, orgati, rho, d, z, finit, tau, info ) import sp,dp,qp,ilp,lk @@ -9576,31 +9576,31 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 ) @@ -9762,11 +9762,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -9802,10 +9802,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -9841,10 +9841,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -9919,16 +9919,16 @@ module stdlib_linalg_lapack - !> 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 ] 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 ] #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 - !> 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 + !! 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 @@ -9997,19 +9997,19 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 ) @@ -10113,16 +10113,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlagts( job, n, a, b, c, d, in, y, tol, info ) import sp,dp,qp,ilp,lk @@ -10154,20 +10154,20 @@ module stdlib_linalg_lapack - !> 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'). 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'). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clahef( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) import sp,dp,qp,ilp,lk @@ -10201,17 +10201,17 @@ module stdlib_linalg_lapack - !> 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. 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. #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,19 +10245,19 @@ module stdlib_linalg_lapack - !> 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'). 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'). #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,20 +10291,20 @@ module stdlib_linalg_lapack - !> 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'). 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'). #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 - !> eigenvalues and Schur decomposition already computed by CHSEQR, by - !> dealing with the Hessenberg submatrix in rows and columns ILO to - !> IHI. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, iloz,ihiz, z, ldz, & info ) @@ -10409,27 +10409,27 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claic1( job, j, x, sest, w, gamma, sestpr, s, c ) import sp,dp,qp,ilp,lk @@ -10488,18 +10488,18 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure logical(lk) function dlaisnan( din1, din2 ) import sp,dp,qp,ilp,lk @@ -10525,27 +10525,27 @@ module stdlib_linalg_lapack - !> 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). 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). #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,16 +10622,16 @@ module stdlib_linalg_lapack - !> 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. 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. #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,21 +10712,21 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> of A (which is composed of two independently sorted sets) into a - !> single set which is sorted in ascending order. 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. #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 - !> 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 + !! 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 ) @@ -10912,14 +10912,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -10990,22 +10990,22 @@ module stdlib_linalg_lapack - !> 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.) 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.) #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 - !> 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 + !! 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 @@ -11095,10 +11095,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -11157,10 +11157,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -11215,10 +11215,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -11250,10 +11250,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -11285,10 +11285,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -11320,10 +11320,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -11355,10 +11355,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -11417,10 +11417,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -11452,10 +11452,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -11514,10 +11514,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -11549,10 +11549,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -11611,10 +11611,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -11644,10 +11644,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -11706,10 +11706,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -11770,10 +11770,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -11832,10 +11832,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -11894,40 +11894,40 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlaorhr_col_getrfnp( m, n, a, lda, d, info ) import sp,dp,qp,ilp,lk @@ -11959,55 +11959,55 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 @@ -12100,13 +12100,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -12165,13 +12165,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -12230,10 +12230,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -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,15 +12467,15 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claqps( m, n, offset, nb, kb, a, lda, jpvt, tau, vn1,vn2, auxv, f, & ldf ) @@ -12544,15 +12544,15 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 @@ -12680,21 +12680,21 @@ module stdlib_linalg_lapack - !> 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. 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. #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,25 +13025,25 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dlaqtr( ltran, lreal, n, t, ldt, b, w, scale, x, work,info ) import sp,dp,qp,ilp,lk @@ -13079,47 +13079,47 @@ module stdlib_linalg_lapack - !> 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" 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" #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,22 +13293,22 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 @@ -13447,11 +13447,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -13485,15 +13485,15 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 ) @@ -13699,20 +13699,20 @@ module stdlib_linalg_lapack - !> 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 . 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 . #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarfg( n, alpha, x, incx, tau ) import sp,dp,qp,ilp,lk @@ -13767,19 +13767,19 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine clarfgp( n, alpha, x, incx, tau ) import sp,dp,qp,ilp,lk @@ -13834,17 +13834,17 @@ module stdlib_linalg_lapack - !> 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 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 #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, - !> 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 + !! 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 @@ -13972,17 +13972,17 @@ module stdlib_linalg_lapack - !> 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. 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. #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,15 +14128,15 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 ) @@ -14209,19 +14209,19 @@ module stdlib_linalg_lapack - !> 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. 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. #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,20 +14259,20 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> 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 + !! 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 ) @@ -14357,14 +14357,14 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlarrj( n, d, e2, ifirst, ilast,rtol, offset, w, werr, work, iwork,& pivmin, spdiam, info ) @@ -14400,16 +14400,16 @@ module stdlib_linalg_lapack - !> 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. 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. #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 - !> Perform tests to decide whether the symmetric tridiagonal matrix T - !> warrants expensive computations which guarantee high relative accuracy - !> in the eigenvalues. interface larrr + !! 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 @@ -14476,10 +14476,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -14556,31 +14556,29 @@ module stdlib_linalg_lapack - !> ! - !> - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clartg( f, g, c, s, r ) import sp,dp,qp,ilp,lk @@ -14633,16 +14631,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlartgp( f, g, cs, sn, r ) import sp,dp,qp,ilp,lk @@ -14670,15 +14668,15 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlartgs( x, y, sigma, cs, sn ) import sp,dp,qp,ilp,lk @@ -14706,11 +14704,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -14767,10 +14765,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -14800,16 +14798,16 @@ module stdlib_linalg_lapack - !> 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. 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. #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 +14870,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -14938,19 +14936,19 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clarzt( direct, storev, n, k, v, ldv, tau, t, ldt ) import sp,dp,qp,ilp,lk @@ -15013,12 +15011,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -15081,14 +15079,14 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasd0( n, sqre, d, e, u, ldu, vt, ldvt, smlsiz, iwork,work, info ) @@ -15122,36 +15120,36 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasd1( nl, nr, sqre, d, alpha, beta, u, ldu, vt, ldvt,idxq, iwork,& work, info ) @@ -15187,18 +15185,18 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasd4( n, i, d, z, delta, rho, sigma, work, info ) import sp,dp,qp,ilp,lk @@ -15230,15 +15228,15 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasd5( i, d, z, delta, rho, dsigma, work ) import sp,dp,qp,ilp,lk @@ -15268,42 +15266,42 @@ module stdlib_linalg_lapack - !> 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. 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. #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 +15343,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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, & @@ -15396,14 +15394,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -15437,15 +15435,15 @@ module stdlib_linalg_lapack - !> 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. 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. #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,19 +15481,19 @@ module stdlib_linalg_lapack - !> 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. 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. #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 +15529,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,17 +15590,17 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dlasq1( n, d, e, work, info ) import sp,dp,qp,ilp,lk @@ -15634,9 +15632,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 +15670,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 +15708,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,58 +15740,58 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clasr( side, pivot, direct, m, n, c, s, a, lda ) import sp,dp,qp,ilp,lk @@ -15852,11 +15850,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -15888,27 +15886,25 @@ module stdlib_linalg_lapack - !> ! - !> - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine classq( n, x, incx, scl, sumsq ) import sp,dp,qp,ilp,lk @@ -15963,17 +15959,17 @@ module stdlib_linalg_lapack - !> 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. 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. #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 +16028,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,20 +16081,20 @@ module stdlib_linalg_lapack - !> 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'). 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'). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clasyf( uplo, n, nb, kb, a, lda, ipiv, w, ldw, info ) import sp,dp,qp,ilp,lk @@ -16161,17 +16157,17 @@ module stdlib_linalg_lapack - !> 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. 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. #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,19 +16230,19 @@ module stdlib_linalg_lapack - !> 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'). 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'). #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,19 +16305,19 @@ module stdlib_linalg_lapack - !> 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'). 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'). #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,17 +16380,17 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatbs( uplo, trans, diag, normin, n, kd, ab, ldab, x,scale, cnorm,& info ) @@ -16467,15 +16463,15 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatdf( ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv,jpiv ) import sp,dp,qp,ilp,lk @@ -16528,18 +16524,18 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatps( uplo, trans, diag, normin, n, ap, x, scale,cnorm, info ) @@ -16612,16 +16608,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatrd( uplo, n, nb, a, lda, e, tau, w, ldw ) import sp,dp,qp,ilp,lk @@ -16682,17 +16678,17 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clatrs( uplo, trans, diag, normin, n, a, lda, x, scale,cnorm, info & ) @@ -16765,11 +16761,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -16824,18 +16820,18 @@ module stdlib_linalg_lapack - !> 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. 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. #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,40 +16890,40 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine claunhr_col_getrfnp( m, n, a, lda, d, info ) import sp,dp,qp,ilp,lk @@ -16959,55 +16955,55 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure recursive subroutine claunhr_col_getrfnp2( m, n, a, lda, d, info ) import sp,dp,qp,ilp,lk @@ -17039,15 +17035,15 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine clauum( uplo, n, a, lda, info ) import sp,dp,qp,ilp,lk @@ -17106,12 +17102,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -17145,17 +17141,17 @@ module stdlib_linalg_lapack - !> 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). 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dopmtr( side, uplo, trans, m, n, ap, tau, c, ldc, work,info ) @@ -17193,23 +17189,23 @@ module stdlib_linalg_lapack - !> 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. 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. #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,22 +17245,22 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -17300,22 +17296,22 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -17351,22 +17347,22 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -17402,22 +17398,22 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dorbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, phantom, work, lwork,info ) @@ -17453,18 +17449,18 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) @@ -17500,16 +17496,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) @@ -17545,20 +17541,20 @@ module stdlib_linalg_lapack - !> 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). 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). #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,22 +17598,22 @@ module stdlib_linalg_lapack - !> 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). 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). #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 +17651,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -17694,12 +17690,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -17733,23 +17729,23 @@ module stdlib_linalg_lapack - !> 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. 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. #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 +17781,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -17823,12 +17819,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -17862,12 +17858,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -17901,12 +17897,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -17940,12 +17936,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -17979,12 +17975,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -18020,12 +18016,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -18059,22 +18055,22 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorgtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) @@ -18110,16 +18106,16 @@ module stdlib_linalg_lapack - !> 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). 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorhr_col( m, n, nb, a, lda, t, ldt, d, info ) import sp,dp,qp,ilp,lk @@ -18151,17 +18147,17 @@ module stdlib_linalg_lapack - !> 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'. 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) @@ -18199,17 +18195,17 @@ module stdlib_linalg_lapack - !> 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'. 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dorm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) @@ -18247,29 +18243,29 @@ module stdlib_linalg_lapack - !> 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). 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, & lwork, info ) @@ -18307,15 +18303,15 @@ module stdlib_linalg_lapack - !> 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). 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, & lwork, info ) @@ -18353,16 +18349,16 @@ module stdlib_linalg_lapack - !> 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'. 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18400,16 +18396,16 @@ module stdlib_linalg_lapack - !> 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'. 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18447,16 +18443,16 @@ module stdlib_linalg_lapack - !> 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'. 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18494,16 +18490,16 @@ module stdlib_linalg_lapack - !> 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'. 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18541,16 +18537,16 @@ module stdlib_linalg_lapack - !> 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'. 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18588,16 +18584,16 @@ module stdlib_linalg_lapack - !> 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). 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dormtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & info ) @@ -18635,13 +18631,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -18712,15 +18708,15 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbequ( uplo, n, kd, ab, ldab, s, scond, amax, info ) import sp,dp,qp,ilp,lk @@ -18783,11 +18779,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -18860,16 +18856,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbstf( uplo, n, kd, ab, ldab, info ) import sp,dp,qp,ilp,lk @@ -18928,18 +18924,18 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpbsv( uplo, n, kd, nrhs, ab, ldab, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -18998,13 +18994,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -19063,10 +19059,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -19129,14 +19125,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -19195,10 +19191,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -19257,10 +19253,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -19323,12 +19319,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -19397,15 +19393,15 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpoequ( n, a, lda, s, scond, amax, info ) import sp,dp,qp,ilp,lk @@ -19464,20 +19460,20 @@ module stdlib_linalg_lapack - !> 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). 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpoequb( n, a, lda, s, scond, amax, info ) import sp,dp,qp,ilp,lk @@ -19536,11 +19532,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -19613,17 +19609,17 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cposv( uplo, n, nrhs, a, lda, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -19682,14 +19678,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -19748,20 +19744,20 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure recursive subroutine cpotrf2( uplo, n, a, lda, info ) import sp,dp,qp,ilp,lk @@ -19820,10 +19816,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -19882,10 +19878,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -19948,13 +19944,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -20021,15 +20017,15 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cppequ( uplo, n, ap, s, scond, amax, info ) import sp,dp,qp,ilp,lk @@ -20092,11 +20088,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -20169,17 +20165,17 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cppsv( uplo, n, nrhs, ap, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -20238,13 +20234,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -20303,10 +20299,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -20365,10 +20361,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -20431,16 +20427,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpstrf( uplo, n, a, lda, piv, rank, tol, work, info ) import sp,dp,qp,ilp,lk @@ -20507,14 +20503,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -20575,22 +20571,22 @@ module stdlib_linalg_lapack - !> 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.) 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.) #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cpteqr( compz, n, d, e, z, ldz, work, info ) import sp,dp,qp,ilp,lk @@ -20655,11 +20651,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -20732,12 +20728,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -20794,10 +20790,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -20854,13 +20850,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -20923,9 +20919,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 +20953,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -20990,9 +20986,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 +21024,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,16 +21060,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsbevd( jobz, uplo, n, kd, ab, ldab, w, z, ldz, work,lwork, iwork, & liwork, info ) @@ -21109,14 +21105,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -21154,11 +21150,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -21194,18 +21190,18 @@ module stdlib_linalg_lapack - !> 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. 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. #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 +21237,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -21280,15 +21276,15 @@ module stdlib_linalg_lapack - !> 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. 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. #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 +21316,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -21392,9 +21388,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,16 +21424,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dspevd( jobz, uplo, n, ap, w, z, ldz, work, lwork,iwork, liwork, info ) @@ -21473,14 +21469,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -21514,12 +21510,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -21553,19 +21549,19 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dspgvd( itype, jobz, uplo, n, ap, bp, w, z, ldz, work,lwork, iwork, & liwork, info ) @@ -21601,11 +21597,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -21637,11 +21633,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -21673,11 +21669,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -21750,18 +21746,18 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cspsv( uplo, n, nrhs, ap, ipiv, b, ldb, info ) import sp,dp,qp,ilp,lk @@ -21820,10 +21816,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -21857,14 +21853,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -21923,10 +21919,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -21989,10 +21985,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -22055,17 +22051,17 @@ module stdlib_linalg_lapack - !> 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. 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. #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,18 +22099,18 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cstedc( compz, n, d, e, z, ldz, work, lwork, rwork,lrwork, iwork, & liwork, info ) @@ -22185,23 +22181,23 @@ module stdlib_linalg_lapack - !> 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. 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. #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,16 +22270,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cstein( n, d, e, m, w, iblock, isplit, z, ldz, work,iwork, ifail, & info ) @@ -22348,66 +22344,66 @@ module stdlib_linalg_lapack - !> 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. 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. #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 +22480,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -22554,9 +22550,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 +22582,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,16 +22618,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine dstevd( jobz, n, d, e, z, ldz, work, lwork, iwork,liwork, info ) @@ -22667,42 +22663,42 @@ module stdlib_linalg_lapack - !> 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. 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. #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 +22736,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -22814,12 +22810,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -22890,10 +22886,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -22956,24 +22952,24 @@ module stdlib_linalg_lapack - !> 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). 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyconvf( uplo, way, n, a, lda, e, ipiv, info ) import sp,dp,qp,ilp,lk @@ -23036,22 +23032,22 @@ module stdlib_linalg_lapack - !> 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). 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csyconvf_rook( uplo, way, n, a, lda, e, ipiv, info ) import sp,dp,qp,ilp,lk @@ -23110,14 +23106,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -23182,9 +23178,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,18 +23214,18 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsyevd( jobz, uplo, n, a, lda, w, work, lwork, iwork,liwork, info ) @@ -23265,57 +23261,57 @@ module stdlib_linalg_lapack - !> 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. 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. #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 +23349,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -23394,12 +23390,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -23435,18 +23431,18 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine dsygvd( itype, jobz, uplo, n, a, lda, b, ldb, w, work,lwork, iwork, & liwork, info ) @@ -23482,11 +23478,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -23518,11 +23514,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -23554,10 +23550,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -23630,18 +23626,18 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -23708,17 +23704,17 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csysv_aa( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -23785,21 +23781,21 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csysv_rk( uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work,lwork, info & ) @@ -23866,23 +23862,23 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csysv_rook( uplo, n, nrhs, a, lda, ipiv, b, ldb, work,lwork, info ) @@ -23949,9 +23945,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,16 +24002,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytf2_rk( uplo, n, a, lda, e, ipiv, info ) import sp,dp,qp,ilp,lk @@ -24078,14 +24074,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -24144,10 +24140,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -24181,10 +24177,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -24220,10 +24216,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 & ) @@ -24259,15 +24255,15 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrf( uplo, n, a, lda, ipiv, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -24330,13 +24326,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -24399,16 +24395,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrf_rk( uplo, n, a, lda, e, ipiv, work, lwork,info ) import sp,dp,qp,ilp,lk @@ -24471,15 +24467,15 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine csytrf_rook( uplo, n, a, lda, ipiv, work, lwork, info ) import sp,dp,qp,ilp,lk @@ -24542,10 +24538,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -24608,10 +24604,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -24674,10 +24670,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -24740,10 +24736,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -24806,16 +24802,16 @@ module stdlib_linalg_lapack - !> 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. 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. #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 +24874,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -24952,10 +24948,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -25018,13 +25014,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -25093,13 +25089,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -25168,11 +25164,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -25239,15 +25235,15 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctfsm( transr, side, uplo, trans, diag, m, n, alpha, a,b, ldb ) @@ -25310,10 +25306,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -25372,9 +25368,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 +25433,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,25 +25498,25 @@ module stdlib_linalg_lapack - !> 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). 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). #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,17 +25593,17 @@ module stdlib_linalg_lapack - !> 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 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 #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctgexc( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,ldz, ifst, ilst,& info ) @@ -25676,25 +25672,25 @@ module stdlib_linalg_lapack - !> 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. 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. #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,69 +25763,69 @@ module stdlib_linalg_lapack - !> 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. 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. #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 +25902,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -25983,34 +25979,34 @@ module stdlib_linalg_lapack - !> 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. 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. #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 +26079,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -26154,11 +26150,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -26217,10 +26213,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -26279,10 +26275,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -26353,10 +26349,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -26427,11 +26423,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -26490,10 +26486,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -26552,10 +26548,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -26622,13 +26618,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -26697,9 +26693,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 +26754,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -26826,9 +26822,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 +26887,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 +26952,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -27027,22 +27023,22 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine ctrevc( side, howmny, select, n, t, ldt, vl, ldvl, vr,ldvr, mm, m, & work, rwork, info ) @@ -27117,23 +27113,23 @@ module stdlib_linalg_lapack - !> 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. 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. #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 +27204,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -27277,13 +27273,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -27352,14 +27348,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -27432,10 +27428,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -27508,14 +27504,14 @@ module stdlib_linalg_lapack - !> 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 + !! 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 ) @@ -27586,10 +27582,10 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -27648,11 +27644,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -27715,9 +27711,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 +27776,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 +27841,13 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -27910,23 +27906,23 @@ module stdlib_linalg_lapack - !> 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. 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. #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,22 +27964,22 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cunbdb1( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -28019,22 +28015,22 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cunbdb2( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -28070,22 +28066,22 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cunbdb3( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, work, lwork, info ) @@ -28121,22 +28117,22 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK subroutine cunbdb4( m, p, q, x11, ldx11, x21, ldx21, theta, phi,taup1, taup2, & tauq1, phantom, work, lwork,info ) @@ -28174,18 +28170,18 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunbdb5( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) @@ -28221,16 +28217,16 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,ldq2, work, & lwork, info ) @@ -28266,20 +28262,20 @@ module stdlib_linalg_lapack - !> 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). 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). #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,22 +28321,22 @@ module stdlib_linalg_lapack - !> 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). 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). #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 +28376,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -28419,12 +28415,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -28458,23 +28454,23 @@ module stdlib_linalg_lapack - !> 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. 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. #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 +28506,11 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -28548,12 +28544,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -28587,12 +28583,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -28626,12 +28622,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -28665,12 +28661,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -28704,12 +28700,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -28745,12 +28741,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -28784,22 +28780,22 @@ module stdlib_linalg_lapack - !> 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. 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. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cungtsqr_row( m, n, mb, nb, a, lda, t, ldt, work,lwork, info ) @@ -28835,16 +28831,16 @@ module stdlib_linalg_lapack - !> 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). 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunhr_col( m, n, nb, a, lda, t, ldt, d, info ) import sp,dp,qp,ilp,lk @@ -28876,17 +28872,17 @@ module stdlib_linalg_lapack - !> 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'. 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunm2l( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) @@ -28924,17 +28920,17 @@ module stdlib_linalg_lapack - !> 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'. 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunm2r( side, trans, m, n, k, a, lda, tau, c, ldc,work, info ) @@ -28972,29 +28968,29 @@ module stdlib_linalg_lapack - !> 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). 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmbr( vect, side, trans, m, n, k, a, lda, tau, c,ldc, work, & lwork, info ) @@ -29032,15 +29028,15 @@ module stdlib_linalg_lapack - !> 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). 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmhr( side, trans, m, n, ilo, ihi, a, lda, tau, c,ldc, work, & lwork, info ) @@ -29078,16 +29074,16 @@ module stdlib_linalg_lapack - !> 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'. 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmlq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29125,16 +29121,16 @@ module stdlib_linalg_lapack - !> 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'. 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmql( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29172,16 +29168,16 @@ module stdlib_linalg_lapack - !> 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'. 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmqr( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29219,16 +29215,16 @@ module stdlib_linalg_lapack - !> 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'. 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmrq( side, trans, m, n, k, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29266,16 +29262,16 @@ module stdlib_linalg_lapack - !> 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'. 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'. #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmrz( side, trans, m, n, k, l, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29313,16 +29309,16 @@ module stdlib_linalg_lapack - !> 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). 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). #ifdef STDLIB_EXTERNAL_LAPACK pure subroutine cunmtr( side, uplo, trans, m, n, a, lda, tau, c, ldc,work, lwork, & info ) @@ -29360,12 +29356,12 @@ module stdlib_linalg_lapack - !> 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 + !! 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 @@ -29399,17 +29395,17 @@ module stdlib_linalg_lapack - !> 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). 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). #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..593bc9b58 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 - !> 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. 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. ! -- 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,18 +175,10 @@ module stdlib_linalg_lapack_aux return end function stdlib_chla_transtype - !> 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. pure real(dp) function stdlib_droundup_lwork( lwork ) + !! 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..-- @@ -205,11 +197,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 +245,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 +335,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 +368,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 +404,14 @@ module stdlib_linalg_lapack_aux return end function stdlib_ilaclr - !> 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_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. ! -- 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 +433,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 +466,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 +502,14 @@ module stdlib_linalg_lapack_aux return end function stdlib_iladlr - !> 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. 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. ! -- 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 +537,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 +570,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 +606,14 @@ module stdlib_linalg_lapack_aux return end function stdlib_ilaslr - !> 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. 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. ! -- 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 +638,14 @@ module stdlib_linalg_lapack_aux return end function stdlib_ilatrans - !> 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. 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. ! -- 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 +667,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 +700,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 +736,12 @@ module stdlib_linalg_lapack_aux return end function stdlib_ilazlr - !> 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 ) + !! 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..-- @@ -876,11 +868,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 +916,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 - !> 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 ) + !! 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..-- @@ -955,18 +947,10 @@ module stdlib_linalg_lapack_aux return end function stdlib_lsamen - !> 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. pure real(sp) function stdlib_sroundup_lwork( lwork ) + !! 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..-- @@ -987,18 +971,10 @@ module stdlib_linalg_lapack_aux #:if WITH_QP - !> 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. pure real(qp) function stdlib_qroundup_lwork( lwork ) + !! 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..-- @@ -1020,14 +996,14 @@ module stdlib_linalg_lapack_aux #:if WITH_QP - !> 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 ) + !! 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..-- @@ -1052,9 +1028,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 +1064,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 +1103,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 +1139,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 +1178,11 @@ module stdlib_linalg_lapack_aux #:if WITH_QP - !> 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 ) + !! 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..-- @@ -1251,21 +1227,21 @@ module stdlib_linalg_lapack_aux end function stdlib_iwmax1 #:endif - !> 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. 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. ! -- 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,15 +1707,15 @@ module stdlib_linalg_lapack_aux return end function stdlib_ilaenv - !> 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. 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. ! -- 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,25 +1891,25 @@ module stdlib_linalg_lapack_aux endif end function stdlib_iparam2stage - !> 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. 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. ! -- 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..b127ab4eb 100644 --- a/src/stdlib_linalg_lapack_c.fypp +++ b/src/stdlib_linalg_lapack_c.fypp @@ -497,17 +497,17 @@ module stdlib_linalg_lapack_c contains - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -632,23 +632,23 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgbequ - !> 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). 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). ! -- 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,16 +965,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgebak - !> 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. 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. ! -- 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,17 +1135,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgebal - !> 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. 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. ! -- 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,23 +1263,23 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeequ - !> 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). 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). ! -- 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 - !> 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 ) + !! 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..-- @@ -1491,16 +1491,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgetc2 - !> 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. 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. ! -- 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 - !> 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 ) + !! 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, -- @@ -1677,17 +1677,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cggbak - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -2169,12 +2169,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -2730,17 +2730,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetf2 - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -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,17 +4222,17 @@ 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 - !> 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. 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. ! -- 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 - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -4771,14 +4771,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpgst - !> 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 ) + !! 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..-- @@ -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,21 +5340,21 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chptri - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -5580,21 +5580,21 @@ module stdlib_linalg_lapack_c stdlib_cla_gbrpvgrw = rpvgrw end function stdlib_cla_gbrpvgrw - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -5813,20 +5813,20 @@ module stdlib_linalg_lapack_c stdlib_cla_gerpvgrw = rpvgrw end function stdlib_cla_gerpvgrw - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -6146,20 +6146,20 @@ module stdlib_linalg_lapack_c stdlib_cla_porpvgrw = rpvgrw end function stdlib_cla_porpvgrw - !> 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. 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. ! -- 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: - !> 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 ) + !! 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..-- @@ -6789,12 +6789,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clacrm - !> 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 ) + !! 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..-- @@ -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 - !> 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, & + !! 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, -- @@ -7058,17 +7058,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claed8 - !> 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 ] 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 ] ! -- 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,16 +7148,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claesy - !> 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 ]. 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 ]. ! -- 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. - !> 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 ) + !! 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..-- @@ -7214,13 +7214,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clag2z - !> 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 ) + !! 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, -- @@ -7350,21 +7350,21 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clagtm - !> 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'). 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'). ! -- 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,20 +7889,20 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clahef - !> 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'). 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'). ! -- 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,21 +8528,21 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clahef_rk - !> 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'). 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'). ! -- 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,28 +9200,28 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clahef_rook - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -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,23 +10121,23 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claqsy - !> 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. 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. 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 - !> 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 ) + !! 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..-- @@ -10398,12 +10398,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clar2v - !> 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 ) + !! 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..-- @@ -10452,16 +10452,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarcm - !> 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. 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. ! -- 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 - !> 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 ) + !! 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, -- @@ -10999,21 +10999,21 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarfb_gett - !> 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 . 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 . ! -- 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,20 +11073,20 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarfg - !> 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. 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. ! -- 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,18 +11209,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarfgp - !> 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 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 ! -- 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 - !> 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 ) + !! 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..-- @@ -11840,14 +11840,14 @@ module stdlib_linalg_lapack_c 410 return end subroutine stdlib_clarfx - !> 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 ) + !! 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..-- @@ -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,32 +11939,30 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarnv - !> ! - !> - !> 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. 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. ! -- 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 +12057,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clartg - !> 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 ) + !! 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..-- @@ -12096,17 +12094,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clartv - !> 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. 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. ! -- 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 +12153,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,20 +12255,20 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarzb - !> 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. 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. ! -- 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 +12319,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarzt - !> 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 ) + !! 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..-- @@ -12491,10 +12489,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,59 +12545,59 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claset - !> 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. 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. ! -- 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,28 +12805,26 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clasr - !> ! - !> - !> 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. 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. ! -- 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 +12929,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,21 +12996,21 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claswp - !> 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'). 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'). ! -- 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,20 +13440,20 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clasyf - !> 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'). 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'). ! -- 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,20 +13886,20 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clasyf_rk - !> 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'). 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'). ! -- 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,18 +14352,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clasyf_rook - !> 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. 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. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -14911,19 +14907,19 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clatbs - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15461,17 +15457,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clatps - !> 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. 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. ! -- 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,18 +15573,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clatrd - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16105,12 +16101,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clatrs - !> 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 ) + !! 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..-- @@ -16151,56 +16147,56 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clatrz - !> 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. 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. ! -- 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,16 +16283,16 @@ 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 - !> 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. 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. ! -- 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,16 +16361,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clauu2 - !> 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. 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. ! -- 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,16 +16445,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clauum - !> 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. 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. ! -- 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,17 +16532,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpbequ - !> 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. 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. ! -- 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,16 +16666,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpbstf - !> 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. 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. ! -- 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 +16761,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,16 +16829,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpbtrs - !> 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. 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. ! -- 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,21 +16903,21 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpoequ - !> 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). 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). ! -- 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 +16985,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpoequb - !> 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 ) + !! 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..-- @@ -17083,21 +17079,21 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpotf2 - !> 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. 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. ! -- 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 +17180,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,16 +17242,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpotrs - !> 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. 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. ! -- 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 +17335,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cppequ - !> 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 ) + !! 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..-- @@ -17425,11 +17421,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,17 +17485,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpptrs - !> 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. 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. ! -- 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,17 +17679,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpstf2 - !> 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. 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. ! -- 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 +17905,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpstrf - !> 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 ) + !! 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..-- @@ -17983,11 +17979,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 +18078,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpttrf - !> 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 ) + !! 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..-- @@ -18182,10 +18178,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 +18223,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_crot - !> 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 ) + !! 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..-- @@ -18385,12 +18381,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cspmv - !> 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 ) + !! 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..-- @@ -18505,15 +18501,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cspr - !> 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 ) + !! 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..-- @@ -18834,11 +18830,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 +19041,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 +19261,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,17 +19315,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csrscl - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19529,13 +19525,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cstein - !> 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 ) + !! 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..-- @@ -19849,11 +19845,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,25 +20050,25 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csyconv - !> 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). 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). ! -- 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,23 +20307,23 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csyconvf - !> 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). 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). ! -- 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 +20562,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csyconvf_rook - !> 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 ) + !! 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..-- @@ -20748,12 +20744,12 @@ module stdlib_linalg_lapack_c scond = max( smin, smlnum ) / min( smax, bignum ) end subroutine stdlib_csyequb - !> 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 ) + !! 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..-- @@ -20902,12 +20898,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csymv - !> 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 ) + !! 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..-- @@ -21006,10 +21002,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 +21070,15 @@ module stdlib_linalg_lapack_c endif end subroutine stdlib_csyswapr - !> 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 ) + !! 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..-- @@ -21365,17 +21361,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytf2 - !> 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. 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. ! -- 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 +21818,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytf2_rk - !> 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 ) + !! 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..-- @@ -22238,16 +22234,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytf2_rook - !> 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. 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. ! -- 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,17 +22360,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytrf - !> 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. 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. ! -- 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,16 +22526,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytrf_rk - !> 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. 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. ! -- 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 +22654,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 +22842,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 +23070,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 +23280,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,17 +23458,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytrs2 - !> 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. 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. ! -- 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 +23615,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 +23734,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 +23956,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csytrs_rook - !> 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,& + !! 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, -- @@ -24203,12 +24199,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctbrfs - !> 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 ) + !! 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, -- @@ -24276,16 +24272,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctbtrs - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -24778,10 +24774,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 +25033,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,26 +25283,26 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctfttr - !> 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). 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). mm, m, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25700,17 +25696,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctgevc - !> 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 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 ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25840,18 +25836,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctgex2 - !> 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 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 info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25924,11 +25920,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 +26036,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 +26127,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 +26547,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctprfb - !> 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, & + !! 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, -- @@ -26802,10 +26798,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 +26888,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctptri - !> 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 ) + !! 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..-- @@ -26965,10 +26961,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 +27219,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,23 +27273,23 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctpttr - !> 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. 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. work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27477,24 +27473,24 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrevc - !> 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. 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. work, lwork, rwork, lrwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27774,14 +27770,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrevc3 - !> 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 ) + !! 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..-- @@ -27853,14 +27849,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrexc - !> 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,& + !! 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, -- @@ -28094,11 +28090,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 +28239,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 +28313,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 +28400,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrtri - !> 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 ) + !! 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..-- @@ -28464,10 +28460,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 +28709,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 +28763,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrttp - !> 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 ) + !! 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..-- @@ -28883,24 +28879,24 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctzrzf - !> 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. 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. ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29206,17 +29202,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunbdb - !> 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. 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. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29334,13 +29330,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunbdb6 - !> 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 ) + !! 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..-- @@ -29398,13 +29394,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cung2l - !> 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 ) + !! 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..-- @@ -29463,13 +29459,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cung2r - !> 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 ) + !! 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..-- @@ -29534,13 +29530,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungl2 - !> 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 ) + !! 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..-- @@ -29650,13 +29646,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunglq - !> 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 ) + !! 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..-- @@ -29771,13 +29767,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungql - !> 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 ) + !! 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..-- @@ -29887,13 +29883,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungqr - !> 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 ) + !! 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..-- @@ -29955,13 +29951,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungr2 - !> 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 ) + !! 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..-- @@ -30077,23 +30073,23 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungrq - !> 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. 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. ! -- 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,18 +30398,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunm22 - !> 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'. 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'. ! -- 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,18 +30497,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunm2l - !> 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'. 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'. ! -- 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,18 +30600,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunm2r - !> 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'. 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'. ! -- 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,17 +30706,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunml2 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30858,17 +30854,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmlq - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30996,17 +30992,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmql - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31133,18 +31129,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmqr - !> 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'. 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'. ! -- 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,18 +31230,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmr2 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31339,17 +31335,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmr3 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31482,17 +31478,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmrq - !> 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'. 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'. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31636,29 +31632,29 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmrz - !> 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. 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. ldu1, u2, ldu2, v1t, ldv1t,v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e,b22d, b22e, rwork, & lrwork, info ) ! -- lapack computational routine -- @@ -32249,32 +32245,32 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cbbcsd - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32712,14 +32708,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cbdsqr - !> 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, & + !! 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, -- @@ -32846,11 +32842,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 +33092,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_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. 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. ! -- 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 +33205,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 +33303,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgebd2 - !> 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 ) + !! 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..-- @@ -33413,10 +33409,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 +33461,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgehd2 - !> 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 ) + !! 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..-- @@ -33521,14 +33517,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelq2 - !> 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 ) + !! 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..-- @@ -33618,12 +33614,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelqf - !> 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 ) + !! 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..-- @@ -33708,17 +33704,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelqt3 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33806,17 +33802,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgemlqt - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33904,10 +33900,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 +33949,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 +34055,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeqlf - !> 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 ) + !! 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..-- @@ -34114,16 +34110,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeqr2 - !> 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. 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. ! -- 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 +34166,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeqr2p - !> 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 ) + !! 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..-- @@ -34272,16 +34268,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeqrf - !> 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. 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. ! -- 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 +34367,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 +34435,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, - !> 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 ) + !! 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..-- @@ -34527,10 +34523,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 +34574,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 +34680,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgerqf - !> 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 ) + !! 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..-- @@ -34743,27 +34739,27 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgesc2 - !> 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. 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. ! -- 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 +34855,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgetrf2 - !> 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 ) + !! 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..-- @@ -34961,12 +34957,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgetri - !> 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 ) + !! 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..-- @@ -35030,31 +35026,31 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgetrs - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35162,26 +35158,26 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgghrd - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35240,26 +35236,26 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cggqrf - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35318,12 +35314,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cggrqf - !> 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 ) + !! 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..-- @@ -35384,10 +35380,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 +35525,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chb2st_kernels - !> 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 ) + !! 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..-- @@ -35711,15 +35707,15 @@ module stdlib_linalg_lapack_c scond = max( smin, smlnum ) / min( smax, bignum ) end subroutine stdlib_cheequb - !> 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 ) + !! 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..-- @@ -35844,15 +35840,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chegs2 - !> 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 ) + !! 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..-- @@ -35983,11 +35979,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 +36083,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 +36211,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 +36484,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,16 +36660,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrd_he2hb - !> 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. 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. ! -- 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,17 +36786,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrf - !> 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. 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. ! -- 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,16 +36952,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrf_rk - !> 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. 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. ! -- 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 +37080,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 +37311,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 +37492,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 +37621,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 +37860,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 +37964,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 +38205,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 +38353,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 +38494,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 +38644,14 @@ module stdlib_linalg_lapack_c return end function stdlib_cla_hercond_c - !> 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 ) + !! 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..-- @@ -38837,10 +38833,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 +38983,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 +39134,14 @@ module stdlib_linalg_lapack_c return end function stdlib_cla_syrcond_c - !> 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 ) + !! 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..-- @@ -39327,15 +39323,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 - !> 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 ) + !! 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..-- @@ -39477,32 +39473,32 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clabrd - !> 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. 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. 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 +39600,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,32 +39744,32 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claein - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -39935,12 +39931,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clags2 - !> 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 & + !! 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, -- @@ -40221,14 +40217,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) - !> 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 ) + !! 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..-- @@ -40311,28 +40307,28 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clahr2 - !> 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). 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). 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,17 +40552,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clals0 - !> 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. 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. 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,22 +40855,22 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clalsa - !> 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. 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. iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41270,11 +41266,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 +41341,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 +41413,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 +41489,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 +41608,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 +41718,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 +42938,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 +43066,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 +43138,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 +43201,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 +43306,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 +43439,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 +43535,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 +43728,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 +43934,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 +44120,14 @@ module stdlib_linalg_lapack_c return end function stdlib_clantr - !> 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 ) + !! 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..-- @@ -44168,11 +44164,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,16 +44244,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claqp2 - !> 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. 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. ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -44391,10 +44387,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 +44785,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 +44839,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,18 +45079,18 @@ module stdlib_linalg_lapack_c end if end subroutine stdlib_claqz3 - !> 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. 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. ! -- 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 +45233,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,16 +45883,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clarrv - !> 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. 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. ! -- 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,41 +45997,41 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clatdf - !> 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. 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. ! -- 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 +46091,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claunhr_col_getrfnp - !> 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 ) + !! 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, -- @@ -46199,12 +46195,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpbcon - !> 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, & + !! 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, -- @@ -46397,14 +46393,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpbrfs - !> 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 ) + !! 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..-- @@ -46597,11 +46593,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 +46647,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpftrs - !> 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 ) + !! 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..-- @@ -46751,12 +46747,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpocon - !> 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, & + !! 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, -- @@ -46944,15 +46940,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cporfs - !> 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 ) + !! 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..-- @@ -47039,11 +47035,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 +47076,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpotri - !> 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 ) + !! 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..-- @@ -47179,12 +47175,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cppcon - !> 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, & + !! 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, -- @@ -47375,18 +47371,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpprfs - !> 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. 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. ! -- 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 +47420,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 - !> 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,& + !! 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, -- @@ -47564,11 +47560,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,23 +47624,23 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpptri - !> 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.) 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.) ! -- 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 +47719,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpteqr - !> 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 ) + !! 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..-- @@ -47790,13 +47786,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpttrs - !> 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 ) + !! 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..-- @@ -47871,12 +47867,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cspcon - !> 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,& + !! 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, -- @@ -48068,19 +48064,19 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csprfs - !> 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. 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. ! -- 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 +48115,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cspsv - !> 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, & + !! 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, -- @@ -48197,67 +48193,67 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cspsvx - !> 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. 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. isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48631,13 +48627,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cstemr - !> 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 ) + !! 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..-- @@ -48712,13 +48708,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csycon - !> 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 ) + !! 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..-- @@ -48794,11 +48790,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,19 +48983,19 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csyrfs - !> 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. 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. ! -- 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,22 +49061,22 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csysv - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49141,24 +49137,24 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csysv_rk - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49220,14 +49216,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csysv_rook - !> 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, & + !! 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, -- @@ -49317,14 +49313,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csysvx - !> 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 ) + !! 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, -- @@ -49426,11 +49422,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,70 +49605,70 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctftri - !> 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. 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. 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,33 +49854,33 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctgsja - !> 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. 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. ldf, scale, rdsum, rdscal,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50048,35 +50044,35 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctgsy2 - !> 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. 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. ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50398,14 +50394,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctgsyl - !> 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 ) + !! 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..-- @@ -50502,12 +50498,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctpcon - !> 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 ) + !! 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..-- @@ -50564,11 +50560,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 +50678,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 +50798,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctpmqrt - !> 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 ) + !! 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..-- @@ -50864,14 +50860,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctpqrt - !> 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 ) + !! 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..-- @@ -50970,15 +50966,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrcon - !> 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 ) + !! 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, -- @@ -51196,19 +51192,19 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrsyl - !> 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. 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. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51295,21 +51291,21 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunbdb5 - !> 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). 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). 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 +51581,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 - !> 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 ) + !! 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..-- @@ -51675,13 +51671,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunghr - !> 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 ) + !! 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..-- @@ -51776,17 +51772,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungtr - !> 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). 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). ! -- 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,16 +51909,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunhr_col - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52012,17 +52008,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmhr - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52128,13 +52124,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmtr - !> 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 ) + !! 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..-- @@ -52215,18 +52211,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cupgtr - !> 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). 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). ! -- 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 +52368,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 - !> 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, & + !! 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, -- @@ -52649,11 +52645,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,16 +52851,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgbrfs - !> 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. 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. ! -- 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 +52903,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgbsv - !> 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, & + !! 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, -- @@ -53134,11 +53130,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 +53237,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 +53367,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,26 +53418,26 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelqt - !> 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. 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. ! -- 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 +53636,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 +53788,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 +53845,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,16 +54042,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgerfs - !> 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. 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. ! -- 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,26 +54120,26 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgetrf - !> 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. 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. ! -- 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,33 +54256,33 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cggglm - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54790,20 +54786,20 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgghd3 - !> 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. 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. ! -- 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 +54918,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgglse - !> 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 ) + !! 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, -- @@ -55006,11 +55002,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 +55209,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgtrfs - !> 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, & + !! 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, -- @@ -55301,15 +55297,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgtsvx - !> 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,& + !! 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, -- @@ -56233,11 +56229,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 +56593,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chbtrd - !> 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 ) + !! 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..-- @@ -56678,13 +56674,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_checon - !> 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 ) + !! 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..-- @@ -56759,10 +56755,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,58 +56866,58 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cheev - !> 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. 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. isuppz, work, lwork,rwork, lrwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57209,12 +57205,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cheevr - !> 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, & + !! 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, -- @@ -57456,13 +57452,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cheevx - !> 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 ) + !! 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, -- @@ -57557,14 +57553,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chegv - !> 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,& + !! 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, -- @@ -57685,11 +57681,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,19 +57874,19 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cherfs - !> 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. 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. ! -- 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,22 +57952,22 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chesv - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58032,24 +58028,24 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chesv_rk - !> 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). 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). ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58111,14 +58107,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chesv_rook - !> 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, & + !! 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, -- @@ -58208,41 +58204,41 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chesvx - !> 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. 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. z, ldz, work, lwork,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58708,13 +58704,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chgeqz - !> 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 ) + !! 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..-- @@ -58789,10 +58785,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 +58882,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpev - !> 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, & + !! 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, -- @@ -59103,13 +59099,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpevx - !> 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 ) + !! 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..-- @@ -59188,15 +59184,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpgv - !> 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, & + !! 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, -- @@ -59300,12 +59296,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpgvx - !> 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,& + !! 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, -- @@ -59497,19 +59493,19 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chprfs - !> 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. 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. ! -- 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 +59544,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpsv - !> 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, & + !! 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, -- @@ -59626,14 +59622,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpsvx - !> 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, & + !! 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, -- @@ -59800,12 +59796,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chsein - !> 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 ) + !! 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, -- @@ -59978,15 +59974,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claed0 - !> 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, & + !! 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, -- @@ -60136,15 +60132,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clamswlq - !> 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, & + !! 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, -- @@ -60298,19 +60294,19 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clamtsqr - !> 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. 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. 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,18 +60508,18 @@ 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 - !> 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. 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. ! -- 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,19 +60592,19 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_claswlq - !> 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. 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. ! -- 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,19 +60677,19 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clatsqr - !> 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. 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. ! -- 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 +60731,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 - !> 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, & + !! 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, -- @@ -60892,15 +60888,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpbsvx - !> 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 ) + !! 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..-- @@ -61068,11 +61064,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,18 +61223,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cpftri - !> 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. 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. ! -- 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 +61274,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 - !> 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, & + !! 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, -- @@ -61422,12 +61418,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cposvx - !> 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, & + !! 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, -- @@ -61640,13 +61636,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cptrfs - !> 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 ) + !! 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..-- @@ -61682,14 +61678,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cptsv - !> 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,& + !! 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, -- @@ -61759,19 +61755,19 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cptsvx - !> 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. 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. liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61973,24 +61969,24 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cstedc - !> 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. 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. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62015,26 +62011,26 @@ module stdlib_linalg_lapack_c tryrac, work, lwork,iwork, liwork, info ) end subroutine stdlib_cstegr - !> 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. 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. 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 +62290,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctgsen - !> 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, & + !! 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, -- @@ -62451,15 +62447,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctgsna - !> 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, & + !! 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, -- @@ -62588,23 +62584,23 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_ctrsen - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62693,23 +62689,23 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunbdb1 - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62808,23 +62804,23 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunbdb2 - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62922,23 +62918,23 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunbdb3 - !> 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. 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. phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63071,23 +63067,23 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunbdb4 - !> 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). 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). 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,24 +63504,24 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cuncsd2by1 - !> 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. 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. ! -- 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 +63653,13 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungbr - !> 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 ) + !! 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..-- @@ -63755,30 +63751,30 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cungtsqr - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63916,14 +63912,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cunmbr - !> 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 ) + !! 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. -- @@ -64041,33 +64037,33 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelq - !> 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. 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. iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64379,20 +64375,20 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelsd - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64837,40 +64833,40 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelss - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65062,15 +65058,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgelsy - !> 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, & + !! 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, -- @@ -65159,15 +65155,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgemlq - !> 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, & + !! 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, -- @@ -65256,15 +65252,15 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgemqr - !> 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 ) + !! 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. -- @@ -65371,25 +65367,25 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeqr - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66866,17 +66862,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgesdd - !> 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. 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. ! -- 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,19 +66910,19 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgesv - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69361,17 +69357,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgesvd - !> 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. 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. numrank, iwork, liwork,cwork, lcwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -70240,14 +70236,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgesvdq - !> 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, & + !! 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, -- @@ -70445,26 +70441,26 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgesvx - !> 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. 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. ! -- 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,20 +70678,20 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgetsls - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70815,28 +70811,28 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgetsqrhrt - !> 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. 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. vsl, ldvsl, vsr, ldvsr, work,lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71067,30 +71063,30 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgges - !> 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. 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. beta, vsl, ldvsl, vsr,ldvsr, rconde, rcondv, work, lwork, rwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- @@ -71377,23 +71373,23 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cggesx - !> 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). 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). work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71647,28 +71643,28 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cggev - !> 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). 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). ldvl, vr, ldvr, ilo, ihi,lscale, rscale, abnrm, bbnrm, rconde, rcondv,work, lwork, rwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -71995,10 +71991,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,17 +72095,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chbev - !> 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. 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72249,12 +72245,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chbevd - !> 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, & + !! 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, -- @@ -72480,12 +72476,12 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chbevx - !> 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, & + !! 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, -- @@ -72560,19 +72556,19 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chbgv - !> 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. 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. lwork, rwork, lrwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72687,14 +72683,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chbgvd - !> 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, & + !! 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, -- @@ -72876,17 +72872,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chbgvx - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73029,19 +73025,19 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cheevd - !> 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. 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73161,17 +73157,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chegvd - !> 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. 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. liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73303,20 +73299,20 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpevd - !> 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. 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73436,16 +73432,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chpgvd - !> 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. 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. rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73607,22 +73603,22 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgees - !> 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. 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. rcondv, work, lwork, rwork,bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73809,18 +73805,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeesx - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74058,33 +74054,33 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeev - !> 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. 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. ihi, scale, abnrm, rconde,rcondv, work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74360,18 +74356,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgeevx - !> 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. 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. v, ldv,cwork, lwork, rwork, lrwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75767,17 +75763,17 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgejsv - !> 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. 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. rwork, lrwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76619,28 +76615,28 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgesvj - !> 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. 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. vsl, ldvsl, vsr, ldvsr,work, lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76870,23 +76866,23 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgges3 - !> 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). 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). work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77142,12 +77138,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 - !> 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, & + !! 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, -- @@ -77683,32 +77679,32 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgsvj0 - !> 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. 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. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78056,18 +78052,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_cgsvj1 - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78128,14 +78124,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chesv_aa - !> 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) + !! 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..-- @@ -78357,16 +78353,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_chetrf_aa - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78502,18 +78498,18 @@ module stdlib_linalg_lapack_c end if end subroutine stdlib_chseqr - !> 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. 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. ! -- 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,16 +78742,16 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clahef_aa - !> 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. 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. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79093,17 +79089,17 @@ module stdlib_linalg_lapack_c work( 1 ) = cmplx( lwkopt, 0,KIND=sp) end subroutine stdlib_claqr0 - !> 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. 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. 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,22 +79311,22 @@ module stdlib_linalg_lapack_c work( 1 ) = cmplx( lwkopt, 0,KIND=sp) end subroutine stdlib_claqr3 - !> 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. 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. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79663,48 +79659,48 @@ 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), - !> 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" 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" beta, q, ldq, z,ldz, work, lwork, rwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -80016,9 +80012,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,18 +80201,18 @@ module stdlib_linalg_lapack_c end if end subroutine stdlib_claqz2 - !> 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. 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. ! -- 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,18 +80437,18 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_clasyf_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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80513,14 +80509,14 @@ module stdlib_linalg_lapack_c return end subroutine stdlib_csysv_aa - !> 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) + !! 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 e1eed9a92..897f6750c 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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, -- @@ -912,14 +912,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggbak - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -1183,12 +1183,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -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,16 +1402,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dla_wwaddw - !> 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. 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. ! -- 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 - !> [ 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 ) + !! 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..-- @@ -1814,39 +1814,39 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlae2 - !> 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. 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. e, e2, nval, ab, c, mout,nab, work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2085,15 +2085,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaebz - !> 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. 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. ! -- 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,16 +2261,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaeda - !> 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 ]. 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 ]. ! -- 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 - !> 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 ) + !! 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..-- @@ -2544,14 +2544,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlag2 - !> 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 ) + !! 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..-- @@ -2581,13 +2581,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlag2s - !> 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 ) + !! 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, -- @@ -2683,19 +2683,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlagtm - !> 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. 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. ! -- 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,56 +2839,56 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlamrg - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -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,18 +3273,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaqge - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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, -- @@ -4092,18 +4092,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarfb_gett - !> 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 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 ! -- 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 - !> 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 ) + !! 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..-- @@ -4722,14 +4722,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarfx - !> 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 ) + !! 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..-- @@ -4756,12 +4756,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarfy - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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, -- @@ -4961,20 +4961,20 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarrc - !> 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. 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. 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,15 +5432,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarrd - !> 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. 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. pivmin, spdiam, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5610,17 +5610,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarrj - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -5772,32 +5772,30 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarrr - !> ! - !> - !> 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. 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. ! -- 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,17 +5839,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlartg - !> 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. 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. ! -- 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,16 +5933,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlartgp - !> 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. 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. ! -- 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 +5989,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 - !> 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 ) + !! 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..-- @@ -6025,11 +6023,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 +6225,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaruv - !> 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 ) + !! 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..-- @@ -6282,11 +6280,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,20 +6369,20 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarzb - !> 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. 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. ! -- 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 +6431,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarzt - !> 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 ) + !! 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..-- @@ -6497,16 +6495,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlas2 - !> 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. 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. ! -- 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 +6590,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 +6641,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 +6691,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 +6899,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 +7127,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,59 +7237,59 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasq6 - !> 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. 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. ! -- 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 +7496,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasr - !> 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 ) + !! 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..-- @@ -7672,28 +7670,26 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasrt - !> ! - !> - !> 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. 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. ! -- 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,17 +7785,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlassq - !> 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 ]. 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 ]. ! -- 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 +7930,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 +7997,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 - !> 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, & + !! 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, -- @@ -8261,20 +8257,20 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasy2 - !> 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'). 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'). ! -- 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,20 +8694,20 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasyf - !> 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'). 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'). ! -- 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,20 +9135,20 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasyf_rk - !> 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'). 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'). ! -- 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 +9596,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasyf_rook - !> 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 ) + !! 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..-- @@ -9651,18 +9647,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlat2s - !> 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. 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. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10071,18 +10067,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlatbs - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10489,18 +10485,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlatps - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10890,16 +10886,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlatrs - !> 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. 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. ! -- 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,16 +10958,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlauu2 - !> 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. 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. ! -- 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,17 +11041,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlauum - !> 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. 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. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -11173,13 +11169,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorbdb6 - !> 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 ) + !! 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..-- @@ -11237,13 +11233,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorg2l - !> 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 ) + !! 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..-- @@ -11302,13 +11298,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorg2r - !> 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 ) + !! 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..-- @@ -11371,13 +11367,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgl2 - !> 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 ) + !! 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..-- @@ -11487,13 +11483,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorglq - !> 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 ) + !! 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..-- @@ -11608,13 +11604,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgql - !> 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 ) + !! 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..-- @@ -11724,13 +11720,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgqr - !> 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 ) + !! 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..-- @@ -11790,13 +11786,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgr2 - !> 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 ) + !! 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..-- @@ -11911,23 +11907,23 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgrq - !> 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. 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. ! -- 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,18 +12232,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorm22 - !> 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'. 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'. ! -- 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,18 +12326,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorm2l - !> 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'. 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'. ! -- 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,18 +12425,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorm2r - !> 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'. 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'. ! -- 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,17 +12524,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorml2 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12671,17 +12667,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormlq - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12808,17 +12804,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormql - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12945,18 +12941,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormqr - !> 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'. 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'. ! -- 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,18 +13035,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormr2 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13138,17 +13134,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormr3 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13281,17 +13277,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormrq - !> 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'. 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'. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13434,16 +13430,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormrz - !> 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. 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. ! -- 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,17 +13517,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpbequ - !> 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. 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. ! -- 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,16 +13635,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpbstf - !> 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. 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. ! -- 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 +13722,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,16 +13790,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpbtrs - !> 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. 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. ! -- 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,21 +13864,21 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpoequ - !> 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). 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). ! -- 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 +13946,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,16 +14008,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpotrs - !> 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. 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. ! -- 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 +14101,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dppequ - !> 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 ) + !! 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..-- @@ -14190,11 +14186,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 +14248,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpptrs - !> 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 ) + !! 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..-- @@ -14325,11 +14321,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 +14404,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpttrf - !> 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 ) + !! 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..-- @@ -14449,11 +14445,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 +14499,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_drscl - !> 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 ) + !! 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, -- @@ -15416,11 +15412,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 +15743,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsbtrd - !> 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. 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. ! -- 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 +15999,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsfrk - !> 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 ) + !! 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..-- @@ -16125,14 +16121,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspgst - !> 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 ) + !! 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..-- @@ -16448,11 +16444,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 +16655,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,18 +16875,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsptrs - !> 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. 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. iblock, isplit, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17272,11 +17268,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,23 +17473,23 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyconv - !> 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. 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. ! -- 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,21 +17728,21 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyconvf - !> 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. 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. ! -- 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 +17981,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyconvf_rook - !> 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 ) + !! 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..-- @@ -18161,15 +18157,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 - !> 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 ) + !! 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..-- @@ -18284,15 +18280,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsygs2 - !> 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 ) + !! 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..-- @@ -18423,10 +18419,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,17 +18487,17 @@ module stdlib_linalg_lapack_d endif end subroutine stdlib_dsyswapr - !> 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. 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. ! -- 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 +18939,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytf2_rk - !> 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 ) + !! 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..-- @@ -19354,17 +19350,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytf2_rook - !> 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. 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. ! -- 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,16 +19516,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrf_rk - !> 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. 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. ! -- 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 +19644,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 +19832,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 +20060,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 +20270,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,17 +20448,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrs2 - !> 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. 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. ! -- 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 +20605,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 +20724,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 +20946,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrs_rook - !> 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,& + !! 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, -- @@ -21188,12 +21184,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtbrfs - !> 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 ) + !! 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, -- @@ -21261,16 +21257,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtbtrs - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21763,10 +21759,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 +22015,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 +22244,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 +22662,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtprfb - !> 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, & + !! 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, -- @@ -22911,10 +22907,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 +22997,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtptri - !> 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 ) + !! 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..-- @@ -23074,10 +23070,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 +23312,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 +23366,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtpttr - !> 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,& + !! 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, -- @@ -23605,11 +23601,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 +23675,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 +23762,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrtri - !> 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 ) + !! 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..-- @@ -23826,10 +23822,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 +24050,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 +24104,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrttp - !> 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 ) + !! 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..-- @@ -24151,14 +24147,14 @@ module stdlib_linalg_lapack_d end function stdlib_dzsum1 #:if WITH_QP - !> 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 ) + !! 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..-- @@ -24181,29 +24177,29 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlag2q #:endif - !> 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. 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. ldu1, u2, ldu2, v1t, ldv1t,v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e,b22d, b22e, work, & lwork, info ) ! -- lapack computational routine -- @@ -24789,21 +24785,21 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dbbcsd - !> 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. 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. ! -- 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 +24890,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_ddisna - !> 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, & + !! 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, -- @@ -25151,14 +25147,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbbrd - !> 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, & + !! 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, -- @@ -25280,17 +25276,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbcon - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25410,23 +25406,23 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbequ - !> 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). 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). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25555,11 +25551,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 +25752,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 +26002,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbtrf - !> 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 ) + !! 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..-- @@ -26107,17 +26103,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgecon - !> 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. 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. ! -- 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,23 +26226,23 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeequ - !> 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). 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). ! -- 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,17 +26365,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeequb - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26467,17 +26463,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgemlqt - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26565,12 +26561,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgemqrt - !> 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 ) + !! 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..-- @@ -26623,13 +26619,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgesc2 - !> 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 ) + !! 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..-- @@ -26707,16 +26703,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetc2 - !> 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. 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. ! -- 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,27 +26776,27 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetf2 - !> 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. 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. ! -- 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 +26891,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetrf2 - !> 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 ) + !! 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..-- @@ -26997,12 +26993,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetri - !> 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 ) + !! 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..-- @@ -27066,17 +27062,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetrs - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27360,31 +27356,31 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggbal - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27490,12 +27486,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgghrd - !> 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 ) + !! 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..-- @@ -27554,11 +27550,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,21 +27566,21 @@ module stdlib_linalg_lapack_d return end function stdlib_disnan - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27756,17 +27752,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dla_gbamv - !> 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. 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. info, work, iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27914,21 +27910,21 @@ module stdlib_linalg_lapack_d return end function stdlib_dla_gbrcond - !> 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. 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. ! -- 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,17 +28089,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dla_geamv - !> 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. 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. iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28243,13 +28239,13 @@ module stdlib_linalg_lapack_d return end function stdlib_dla_gercond - !> 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 ) + !! 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..-- @@ -28284,17 +28280,17 @@ 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) - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28443,20 +28439,20 @@ module stdlib_linalg_lapack_d return end function stdlib_dla_porcond - !> 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. 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. ! -- 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,17 +28628,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dla_syamv - !> 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. 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. iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28799,14 +28795,14 @@ module stdlib_linalg_lapack_d return end function stdlib_dla_syrcond - !> 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 ) + !! 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..-- @@ -29005,19 +29001,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dladiv1 - !> 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. 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. ! -- 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,25 +29227,25 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed6 - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29391,20 +29387,20 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlags2 - !> 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. 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. ! -- 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,17 +29478,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlagtf - !> 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. 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. ! -- 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,28 +29675,28 @@ module stdlib_linalg_lapack_d end if end subroutine stdlib_dlagts - !> 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. 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. ! -- 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,23 +29887,23 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaic1 - !> 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.) 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.) ! -- 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 +29992,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 +30067,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 +30139,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 +30215,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 +30287,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 +30392,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 +31096,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 +31220,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 +31282,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 +31378,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 +31571,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 +31777,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,41 +31963,41 @@ module stdlib_linalg_lapack_d return end function stdlib_dlantr - !> 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. 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. ! -- 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 +32057,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,17 +32094,17 @@ module stdlib_linalg_lapack_d return end function stdlib_dlapy2 - !> 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. 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. ! arguments integer(ilp), intent( in ) :: lda, ldb real(dp), intent( in ) :: a( lda, * ), b( ldb, * ), sr1,sr2, si, beta1, beta2 @@ -32153,9 +32149,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 +32260,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,23 +32517,23 @@ module stdlib_linalg_lapack_d end if end subroutine stdlib_dlaqz4 - !> 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. 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. negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32743,21 +32739,21 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlar1v - !> 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. 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. ! -- 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,20 +32808,20 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarfg - !> 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. 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. ! -- 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 +32916,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,16 +32972,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarnv - !> 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. 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. work, iwork,pivmin, spdiam, twist, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33149,13 +33145,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarrb - !> 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, & + !! 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, -- @@ -33408,11 +33404,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 +34035,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarrv - !> 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 ) + !! 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..-- @@ -34209,19 +34205,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlascl - !> 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. 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. ! -- 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 +34933,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd4 - !> 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, & + !! 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 -- @@ -35176,15 +35172,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd7 - !> 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, & + !! 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, -- @@ -35312,11 +35308,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,16 +35478,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasq3 - !> 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. 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. ! -- 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,17 +35588,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlatdf - !> 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. 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. ! -- 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 +35690,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlatrd - !> 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 ) + !! 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..-- @@ -35734,24 +35730,24 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlatrz - !> 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. 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. ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36062,19 +36058,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorbdb - !> 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. 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. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36161,21 +36157,21 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorbdb5 - !> 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). 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). 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 +36432,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 - !> 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 ) + !! 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..-- @@ -36526,17 +36522,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorghr - !> 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). 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). ! -- 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,16 +36659,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorhr_col - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36762,13 +36758,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormhr - !> 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 ) + !! 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, -- @@ -36860,12 +36856,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpbcon - !> 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, & + !! 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, -- @@ -37054,11 +37050,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 +37104,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpftrs - !> 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 ) + !! 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..-- @@ -37203,12 +37199,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpocon - !> 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, & + !! 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, -- @@ -37392,15 +37388,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dporfs - !> 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 ) + !! 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..-- @@ -37479,21 +37475,21 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpotf2 - !> 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. 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. ! -- 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 +37573,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 +37614,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpotri - !> 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 ) + !! 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..-- @@ -37712,12 +37708,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dppcon - !> 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, & + !! 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, -- @@ -37904,18 +37900,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpprfs - !> 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. 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. ! -- 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 +37949,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 - !> 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,& + !! 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, -- @@ -38092,11 +38088,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,17 +38150,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpptri - !> 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. 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. ! -- 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,17 +38329,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpstf2 - !> 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. 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. ! -- 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 +38540,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpstrf - !> 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 ) + !! 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..-- @@ -38599,10 +38595,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 +38740,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsb2st_kernels - !> 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 ) + !! 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..-- @@ -38826,12 +38822,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspcon - !> 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,& + !! 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, -- @@ -39019,19 +39015,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsprfs - !> 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. 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. ! -- 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 +39066,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspsv - !> 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, & + !! 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, -- @@ -39148,11 +39144,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 +39241,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsptrd - !> 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, & + !! 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, -- @@ -39443,13 +39439,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dstein - !> 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 ) + !! 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..-- @@ -39760,10 +39756,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 +39991,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 +40074,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dstev - !> 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, & + !! 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, -- @@ -40272,13 +40268,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dstevx - !> 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 ) + !! 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, -- @@ -40355,13 +40351,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsycon - !> 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 ) + !! 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, -- @@ -40438,11 +40434,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,22 +40623,22 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyrfs - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40704,24 +40700,24 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsysv_rk - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40783,10 +40779,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 +40873,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytd2 - !> 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 ) + !! 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..-- @@ -41162,11 +41158,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 +41284,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,16 +41530,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrd_sb2st - !> 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. 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. ! -- 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 +41656,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrf - !> 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 ) + !! 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, -- @@ -41764,11 +41760,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,36 +41943,36 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtftri - !> 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. 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. ldf, scale, rdsum, rdscal,iwork, pq, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42587,36 +42583,36 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgsy2 - !> 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. 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. ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42916,14 +42912,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgsyl - !> 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 ) + !! 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..-- @@ -43015,11 +43011,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 +43108,11 @@ module stdlib_linalg_lapack_d end do end subroutine stdlib_dtplqt2 - !> 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, & + !! 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, -- @@ -43230,11 +43226,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 +43346,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 +43437,14 @@ module stdlib_linalg_lapack_d end do end subroutine stdlib_dtpqrt2 - !> 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 ) + !! 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..-- @@ -43542,14 +43538,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrcon - !> 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 ) + !! 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..-- @@ -43658,16 +43654,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtzrzf - !> 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. 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. ! -- 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 +43706,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbsv - !> 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, & + !! 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, -- @@ -43933,16 +43929,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgbsvx - !> 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. 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. ! -- 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 +44097,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 +44189,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 +44241,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgehd2 - !> 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 ) + !! 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..-- @@ -44299,14 +44295,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgelq2 - !> 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 ) + !! 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..-- @@ -44396,12 +44392,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgelqf - !> 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 ) + !! 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..-- @@ -44483,10 +44479,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 +44528,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 +44634,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeqlf - !> 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 ) + !! 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..-- @@ -44693,16 +44689,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeqr2 - !> 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. 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. ! -- 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 +44745,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeqr2p - !> 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 ) + !! 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..-- @@ -44851,16 +44847,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeqrf - !> 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. 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. ! -- 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 +44946,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 +45014,12 @@ module stdlib_linalg_lapack_d end do end subroutine stdlib_dgeqrt2 - !> 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 ) + !! 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..-- @@ -45103,11 +45099,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 +45292,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 +45341,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,16 +45447,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgerqf - !> 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. 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. ! -- 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,33 +45525,33 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetrf - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46056,26 +46052,26 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgghd3 - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46134,26 +46130,26 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggqrf - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46212,12 +46208,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 - !> 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, & + !! 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, -- @@ -46860,32 +46856,32 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgsvj0 - !> 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. 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. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47291,13 +47287,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgsvj1 - !> 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 & + !! 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, -- @@ -47374,11 +47370,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 +47572,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgtrfs - !> 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, & + !! 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, -- @@ -47665,51 +47661,51 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgtsvx - !> 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. 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. beta, q, ldq, z, ldz, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48540,15 +48536,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dhgeqz - !> 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 ) + !! 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..-- @@ -48670,15 +48666,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlabrd - !> 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 ) + !! 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..-- @@ -48738,18 +48734,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dladiv - !> 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. 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. ! -- 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 +49339,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed4 - !> 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, & + !! 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, -- @@ -49566,12 +49562,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed8 - !> 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 ) + !! 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, -- @@ -49672,11 +49668,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,25 +50014,25 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaein - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50182,14 +50178,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) - !> 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 ) + !! 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..-- @@ -50270,33 +50266,33 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlahr2 - !> 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.) 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.) ldx, scale, xnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50595,28 +50591,28 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaln2 - !> 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). 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). 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 +50788,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlals0 - !> 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, & + !! 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, -- @@ -50950,15 +50946,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlamswlq - !> 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, & + !! 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, -- @@ -51112,16 +51108,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlamtsqr - !> 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. 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. ! -- 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 +51254,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlanv2 - !> 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 ) + !! 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..-- @@ -51298,11 +51294,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,16 +51371,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaqp2 - !> 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. 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. ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51509,10 +51505,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,26 +51912,26 @@ module stdlib_linalg_lapack_d end do loop_180 end subroutine stdlib_dlaqr5 - !> 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. 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. ! -- 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,19 +52358,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaqtr - !> 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. 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. vt2, ldvt2, idxc, ctot, z,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52564,43 +52560,43 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd3 - !> 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. 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. givptr, givcol, ldgcol, givnum,ldgnum, poles, difl, difr, z, k, c, s, work,iwork, info ) ! -- lapack auxiliary routine -- @@ -52692,13 +52688,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd6 - !> 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 ) + !! 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..-- @@ -52779,18 +52775,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dopgtr - !> 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). 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). ! -- 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,23 +52922,23 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dopmtr - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53029,23 +53025,23 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorbdb1 - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53142,23 +53138,23 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorbdb2 - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53254,23 +53250,23 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorbdb3 - !> 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. 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. phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -53396,23 +53392,23 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorbdb4 - !> 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). 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). 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 +53807,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorcsd2by1 - !> 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 ) + !! 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..-- @@ -53912,13 +53908,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgtr - !> 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 ) + !! 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..-- @@ -54010,17 +54006,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgtsqr - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54126,14 +54122,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormtr - !> 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 ) + !! 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..-- @@ -54325,11 +54321,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 +54479,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpftri - !> 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 ) + !! 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..-- @@ -54577,12 +54573,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpotrf - !> 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 ) + !! 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, -- @@ -54749,13 +54745,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dptrfs - !> 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 ) + !! 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..-- @@ -54790,14 +54786,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dptsv - !> 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,& + !! 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, -- @@ -54864,10 +54860,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 +54962,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsbev - !> 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, & + !! 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, -- @@ -55192,12 +55188,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsbevx - !> 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, & + !! 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, -- @@ -55270,14 +55266,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsbgv - !> 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, & + !! 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, -- @@ -55455,35 +55451,35 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsbgvx - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55635,10 +55631,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 +55724,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspev - !> 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, & + !! 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, -- @@ -55941,13 +55937,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspevx - !> 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 ) + !! 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..-- @@ -56025,15 +56021,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspgv - !> 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, & + !! 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, -- @@ -56137,36 +56133,36 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspgvx - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56316,10 +56312,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 +56419,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyev - !> 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, & + !! 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, -- @@ -56670,13 +56666,13 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyevx - !> 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 ) + !! 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..-- @@ -56770,14 +56766,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsygv - !> 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,& + !! 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, -- @@ -56898,19 +56894,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsygvx - !> 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. 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. ! -- 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 +56972,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsysv - !> 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, & + !! 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, -- @@ -57073,11 +57069,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,26 +57245,26 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsytrd_sy2sb - !> 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). 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). mm, m, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57979,18 +57975,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgevc - !> 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 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 work, lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58344,20 +58340,20 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgex2 - !> 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 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 work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58593,28 +58589,28 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgexc - !> 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. 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. 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,69 +58915,69 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgsen - !> 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. 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. 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,16 +59156,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgsja - !> 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. 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. dif, mm, m, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59408,12 +59404,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtgsna - !> 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 ) + !! 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..-- @@ -59470,12 +59466,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtplqt - !> 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 ) + !! 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..-- @@ -59532,23 +59528,23 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtpqrt - !> 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. 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. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60145,24 +60141,24 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrevc - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60967,19 +60963,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrevc3 - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61628,11 +61624,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 +61729,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 +61858,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,26 +61909,26 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgelqt - !> 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. 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. ! -- 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 +62126,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgels - !> 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, & + !! 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, -- @@ -62227,15 +62223,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgemlq - !> 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, & + !! 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, -- @@ -62324,10 +62320,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 +62470,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,17 +62527,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeqrt - !> 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. 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. ! -- 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,19 +62575,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgesv - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63558,14 +63554,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgesvj - !> 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, & + !! 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, -- @@ -63762,34 +63758,34 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgesvx - !> 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. 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. alphai, beta, vsl, ldvsl, vsr,ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64081,36 +64077,36 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgges - !> 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. 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. alphar, alphai, beta, vsl, ldvsl,vsr, ldvsr, rconde, rcondv, work, lwork, iwork,liwork, & bwork, info ) ! -- lapack driver routine -- @@ -64451,23 +64447,23 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggesx - !> 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). 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). ldvr, work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64749,28 +64745,28 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggev - !> 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). 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). beta, vl, ldvl, vr, ldvr, ilo,ihi, lscale, rscale, abnrm, bbnrm, rconde,rcondv, work, lwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -65144,26 +65140,26 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggevx - !> 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. 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. ! -- 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,20 +65276,20 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggglm - !> 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. 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. ! -- 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 +65408,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgglse - !> 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, & + !! 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, -- @@ -65627,14 +65623,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dhsein - !> 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 ) + !! 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..-- @@ -65715,20 +65711,20 @@ 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 - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65850,34 +65846,34 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed3 - !> 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. 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. 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 +65980,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 - !> 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 ) + !! 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..-- @@ -66182,12 +66178,12 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaexc - !> 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, & + !! 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, -- @@ -66491,15 +66487,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlahqr - !> 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, & + !! 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, -- @@ -66776,18 +66772,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd2 - !> 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. 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. ! -- 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,19 +66856,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaswlq - !> 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. 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. ! -- 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,24 +66941,24 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlatsqr - !> 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. 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. ! -- 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,30 +67090,30 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dorgbr - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67252,19 +67248,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dormbr - !> 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. 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. ! -- 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 +67302,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 - !> 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, & + !! 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, -- @@ -67462,15 +67458,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpbsvx - !> 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 ) + !! 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..-- @@ -67637,18 +67633,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpftrf - !> 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. 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. ! -- 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 +67684,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 - !> 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, & + !! 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, -- @@ -67831,18 +67827,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dposvx - !> 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. 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. ! -- 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,19 +68031,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrexc - !> 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. 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. lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68230,16 +68226,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrsen - !> 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. 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. work, ldwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68475,20 +68471,20 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dtrsna - !> 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. 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. v, ldv,work, lwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69565,14 +69561,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgejsv - !> 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 ) + !! 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. -- @@ -69690,40 +69686,40 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgelq - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69923,15 +69919,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgelsy - !> 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 ) + !! 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. -- @@ -70038,26 +70034,26 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeqr - !> 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. 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. ! -- 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,20 +70270,20 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetsls - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70407,14 +70403,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgetsqrhrt - !> 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,& + !! 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, -- @@ -70664,19 +70660,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed2 - !> 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. 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. 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,37 +70963,37 @@ 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, - !> 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. 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. work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71082,34 +71078,34 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd1 - !> 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. 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. ! -- 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 +71181,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,19 +71385,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlaed0 - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71615,17 +71611,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dstedc - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71720,19 +71716,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dstevd - !> 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. 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. ! -- 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,19 +71850,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyevd - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71975,17 +71971,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsygvd - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72107,19 +72103,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsbevd - !> 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. 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. lwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72224,17 +72220,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsbgvd - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72349,20 +72345,20 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspevd - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72473,24 +72469,24 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dspgvd - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72731,32 +72727,32 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dbdsdc - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73197,21 +73193,21 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dbdsqr - !> 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). 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). bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73443,27 +73439,27 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgees - !> 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). 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). rconde, rcondv, work, lwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73737,18 +73733,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeesx - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73996,33 +73992,33 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeev - !> 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. 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. ilo, ihi, scale, abnrm,rconde, rcondv, work, lwork, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74308,33 +74304,33 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgeevx - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74631,20 +74627,20 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgelsd - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75073,27 +75069,27 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgelss - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76044,19 +76040,19 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgesdd - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78303,17 +78299,17 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgesvd - !> 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. 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. numrank, iwork, liwork,work, lwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -79168,34 +79164,34 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgesvdq - !> 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. 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. alphai, beta, vsl, ldvsl,vsr, ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79482,23 +79478,23 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dgges3 - !> 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). 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). ldvr, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79782,16 +79778,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dggev3 - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79929,17 +79925,17 @@ module stdlib_linalg_lapack_d end if end subroutine stdlib_dhseqr - !> 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. 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. 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,22 +80109,22 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlalsa - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80386,16 +80382,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlalsd - !> 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. 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. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80756,17 +80752,17 @@ module stdlib_linalg_lapack_d work( 1 ) = real( lwkopt,KIND=dp) end subroutine stdlib_dlaqr0 - !> 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. 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. 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,22 +81063,22 @@ module stdlib_linalg_lapack_d work( 1 ) = real( lwkopt,KIND=dp) end subroutine stdlib_dlaqr3 - !> 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. 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. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -81438,56 +81434,56 @@ 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), - !> 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" 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" alphai, beta,q, ldq, z, ldz, work, lwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -81830,9 +81826,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,21 +82098,21 @@ module stdlib_linalg_lapack_d end if end subroutine stdlib_dlaqz3 - !> 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. 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. 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,15 +82623,15 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlarre - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82766,16 +82762,16 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasd0 - !> 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. 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. 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,20 +82964,20 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasda - !> 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. 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. work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83133,18 +83129,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasdq - !> 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. 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. ! -- 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,21 +83221,21 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasq1 - !> 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. 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. ! -- 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,18 +83609,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasq2 - !> 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. 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. ! -- 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,23 +83843,23 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dlasyf_aa - !> 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.) 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.) ! -- 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,24 +83937,24 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dpteqr - !> 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. 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. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83983,53 +83979,53 @@ module stdlib_linalg_lapack_d tryrac, work, lwork,iwork, liwork, info ) end subroutine stdlib_dstegr - !> 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. 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. isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84403,43 +84399,43 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dstemr - !> 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. 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. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84653,58 +84649,58 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dstevr - !> 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. 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. isuppz, work, lwork,iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84975,18 +84971,18 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsyevr - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -85047,14 +85043,14 @@ module stdlib_linalg_lapack_d return end subroutine stdlib_dsysv_aa - !> 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) + !! 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 66a9ecd67..a95edf203 100644 --- a/src/stdlib_linalg_lapack_q.fypp +++ b/src/stdlib_linalg_lapack_q.fypp @@ -523,29 +523,29 @@ module stdlib_linalg_lapack_q contains - !> 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. 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. ldu1, u2, ldu2, v1t, ldv1t,v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e,b22d, b22e, work, & lwork, info ) ! -- lapack computational routine -- @@ -1131,24 +1131,24 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qbbcsd - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1389,32 +1389,32 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qbdsdc - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1855,21 +1855,21 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qbdsqr - !> 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. 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. ! -- 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 - !> 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, & + !! 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, -- @@ -2217,14 +2217,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbbrd - !> 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, & + !! 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, -- @@ -2346,17 +2346,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbcon - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2476,23 +2476,23 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbequ - !> 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). 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). ! -- 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 - !> 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, & + !! 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, -- @@ -2822,16 +2822,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbrfs - !> 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. 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. ! -- 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 - !> 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, & + !! 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, -- @@ -3097,11 +3097,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbsvx - !> 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 ) + !! 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..-- @@ -3183,11 +3183,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbtf2 - !> 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 ) + !! 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..-- @@ -3433,12 +3433,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbtrf - !> 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 ) + !! 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..-- @@ -3527,11 +3527,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgbtrs - !> 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 ) + !! 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..-- @@ -3624,16 +3624,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgebak - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -3884,11 +3884,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgebd2 - !> 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 ) + !! 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..-- @@ -3989,14 +3989,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgebrd - !> 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 ) + !! 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..-- @@ -4090,17 +4090,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgecon - !> 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. 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. ! -- 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,23 +4213,23 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeequ - !> 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). 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). ! -- 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,21 +4352,21 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeequb - !> 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). 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). bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4598,27 +4598,27 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgees - !> 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). 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). rconde, rcondv, work, lwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4892,18 +4892,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeesx - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5151,33 +5151,33 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeev - !> 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. 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. 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,20 +5644,20 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgehrd - !> 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. 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. 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 - !> 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 ) + !! 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. -- @@ -6859,14 +6859,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgelq - !> 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 ) + !! 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..-- @@ -6913,14 +6913,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgelq2 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -7148,26 +7148,26 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgelqt3 - !> 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. 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. ! -- 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,33 +7365,33 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgels - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -7688,20 +7688,20 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgelsd - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8130,40 +8130,40 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgelss - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8363,15 +8363,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgelsy - !> 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_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) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8460,17 +8460,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgemlq - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8558,15 +8558,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgemlqt - !> 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_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) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8655,17 +8655,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgemqr - !> 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'. 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'. ! -- 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,15 +9058,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeqp3 - !> 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_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. ! -- 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,15 +9173,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeqr - !> 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_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. ! -- 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,16 +9228,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeqr2 - !> 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. 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. ! -- 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,15 +9284,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeqr2p - !> 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_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. ! -- 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,16 +9386,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeqrf - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -9695,11 +9695,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgeqrt3 - !> 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, & + !! 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, -- @@ -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 - !> 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 ) + !! 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..-- @@ -10101,27 +10101,27 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgesc2 - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -11072,17 +11072,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgesdd - !> 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. 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. ! -- 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,19 +11120,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgesv - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13379,17 +13379,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgesvd - !> 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. 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. numrank, iwork, liwork,work, lwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -14244,19 +14244,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgesvdq - !> 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. 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. 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 - !> 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, & + !! 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, -- @@ -15427,13 +15427,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgesvx - !> 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 ) + !! 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..-- @@ -15511,16 +15511,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgetc2 - !> 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. 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. ! -- 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,16 +15584,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgetf2 - !> 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. 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. ! -- 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,27 +15662,27 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgetrf - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -15879,12 +15879,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgetri - !> 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 ) + !! 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..-- @@ -15948,26 +15948,26 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgetrs - !> 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. 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. ! -- 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,20 +16184,20 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgetsls - !> 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. 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. ! -- 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 - !> 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 ) + !! 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, -- @@ -16430,17 +16430,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggbak - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16724,34 +16724,34 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggbal - !> 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. 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. alphai, beta, vsl, ldvsl, vsr,ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17043,34 +17043,34 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgges - !> 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. 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. alphai, beta, vsl, ldvsl,vsr, ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17357,36 +17357,36 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgges3 - !> 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. 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. alphar, alphai, beta, vsl, ldvsl,vsr, ldvsr, rconde, rcondv, work, lwork, iwork,liwork, & bwork, info ) ! -- lapack driver routine -- @@ -17727,23 +17727,23 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggesx - !> 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). 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). ldvr, work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -18025,23 +18025,23 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggev - !> 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). 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). ldvr, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -18325,28 +18325,28 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggev3 - !> 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). 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). beta, vl, ldvl, vr, ldvr, ilo,ihi, lscale, rscale, abnrm, bbnrm, rconde,rcondv, work, lwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -18720,26 +18720,26 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggevx - !> 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. 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. ! -- 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,33 +18856,33 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggglm - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19383,31 +19383,31 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgghd3 - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19513,20 +19513,20 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgghrd - !> 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. 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. ! -- 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,26 +19645,26 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgglse - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19723,26 +19723,26 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qggqrf - !> 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. 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. ! -- 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 - !> 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, & + !! 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, -- @@ -20449,32 +20449,32 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgsvj0 - !> 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. 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. 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 - !> 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 & + !! 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, -- @@ -20963,11 +20963,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgtcon - !> 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, & + !! 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, -- @@ -21165,14 +21165,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgtrfs - !> 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 ) + !! 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..-- @@ -21344,14 +21344,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgtsv - !> 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, & + !! 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, -- @@ -21433,15 +21433,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qgtsvx - !> 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_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. ! -- 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 - !> 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 ) + !! 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..-- @@ -21589,12 +21589,12 @@ module stdlib_linalg_lapack_q end if end subroutine stdlib_qgttrs - !> 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 ) + !! 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..-- @@ -21702,51 +21702,51 @@ module stdlib_linalg_lapack_q end if end subroutine stdlib_qgtts2 - !> 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. 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. 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 - !> 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, & + !! 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, -- @@ -22792,16 +22792,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qhsein - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -22955,21 +22955,21 @@ module stdlib_linalg_lapack_q return end function stdlib_qisnan - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -23141,17 +23141,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qla_gbamv - !> 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. 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. 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 - !> 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 ) + !! 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..-- @@ -23339,21 +23339,21 @@ module stdlib_linalg_lapack_q stdlib_qla_gbrpvgrw = rpvgrw end function stdlib_qla_gbrpvgrw - !> 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. 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. ! -- 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,17 +23518,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qla_geamv - !> 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. 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. 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 - !> 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 ) + !! 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..-- @@ -23707,13 +23707,13 @@ module stdlib_linalg_lapack_q stdlib_qla_gerpvgrw = rpvgrw end function stdlib_qla_gerpvgrw - !> 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 ) + !! 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..-- @@ -23748,17 +23748,17 @@ module stdlib_linalg_lapack_q end do end subroutine stdlib_qla_lin_berr - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -23995,20 +23995,20 @@ module stdlib_linalg_lapack_q stdlib_qla_porpvgrw = rpvgrw end function stdlib_qla_porpvgrw - !> 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. 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. ! -- 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,17 +24184,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qla_syamv - !> 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. 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. 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 - !> 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 ) + !! 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..-- @@ -24535,11 +24535,11 @@ module stdlib_linalg_lapack_q stdlib_qla_syrpvgrw = rpvgrw end function stdlib_qla_syrpvgrw - !> 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 ) + !! 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..-- @@ -24562,16 +24562,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qla_wwaddw - !> 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. 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. ! -- 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,15 +24590,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlabad - !> 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_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 ! -- 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,15 +25015,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlacpy - !> 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_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" ! -- 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 - !> 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 ) + !! 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..-- @@ -25194,39 +25194,39 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlae2 - !> 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. 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. 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,34 +25669,34 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed0 - !> 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. 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. ! -- 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 - !> 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,& + !! 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, -- @@ -26029,20 +26029,20 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed2 - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26164,18 +26164,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed3 - !> 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. 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. ! -- 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,15 +26769,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed4 - !> 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. 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. ! -- 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,19 +26840,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed5 - !> 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. 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. ! -- 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,34 +27066,34 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed6 - !> 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. 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. 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 - !> 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, & + !! 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, -- @@ -27423,12 +27423,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed8 - !> 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 ) + !! 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, -- @@ -27529,11 +27529,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaed9 - !> 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,& + !! 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, -- @@ -27634,11 +27634,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaeda - !> 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, & + !! 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, -- @@ -27980,16 +27980,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaein - !> 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 ]. 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 ]. ! -- 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,15 +28079,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaev2 - !> 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_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. ! -- 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 - !> 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 ) + !! 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..-- @@ -28461,14 +28461,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlag2 - !> 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 ) + !! 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..-- @@ -28498,25 +28498,25 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlag2s - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28658,20 +28658,20 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlags2 - !> 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. 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. ! -- 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 - !> 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 ) + !! 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, -- @@ -28851,17 +28851,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlagtm - !> 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. 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. ! -- 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,25 +29048,25 @@ module stdlib_linalg_lapack_q end if end subroutine stdlib_qlagts - !> 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. 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. ! -- 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 - !> 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, & + !! 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, -- @@ -29521,14 +29521,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlahqr - !> 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 ) + !! 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..-- @@ -29609,28 +29609,28 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlahr2 - !> 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. 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. ! -- 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,19 +29821,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaic1 - !> 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. 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. ! -- 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,33 +29845,33 @@ module stdlib_linalg_lapack_q return end function stdlib_qlaisnan - !> 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.) 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.) ldx, scale, xnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -30170,28 +30170,28 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaln2 - !> 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). 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). 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,17 +30367,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlals0 - !> 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. 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. 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,22 +30551,22 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlalsa - !> 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. 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. 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 - !> 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 ) + !! 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..-- @@ -30956,15 +30956,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlamrg - !> 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_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) lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31114,15 +31114,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlamswlq - !> 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_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) lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31276,23 +31276,23 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlamtsqr - !> 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.) 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.) ! -- 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 - !> 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 ) + !! 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..-- @@ -31456,11 +31456,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlangb - !> 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 ) + !! 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..-- @@ -31528,11 +31528,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlange - !> 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 ) + !! 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..-- @@ -31604,11 +31604,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlangt - !> 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 ) + !! 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..-- @@ -31676,11 +31676,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlanhs - !> 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 ) + !! 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..-- @@ -31781,11 +31781,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlansb - !> 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 ) + !! 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..-- @@ -32485,11 +32485,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlansf - !> 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 ) + !! 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..-- @@ -32609,11 +32609,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlansp - !> 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 ) + !! 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..-- @@ -32671,11 +32671,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlanst - !> 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 ) + !! 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..-- @@ -32767,11 +32767,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlansy - !> 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 ) + !! 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..-- @@ -32960,11 +32960,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlantb - !> 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 ) + !! 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..-- @@ -33166,11 +33166,11 @@ module stdlib_linalg_lapack_q return end function stdlib_qlantp - !> 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 ) + !! 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..-- @@ -33352,16 +33352,16 @@ module stdlib_linalg_lapack_q return end function stdlib_qlantr - !> 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. 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. ! -- 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,41 +33498,41 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlanv2 - !> 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. 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. ! -- 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,56 +33592,56 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaorhr_col_getrfnp - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -33762,14 +33762,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlapll - !> 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 ) + !! 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..-- @@ -33830,14 +33830,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlapmr - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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, -- @@ -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 - !> 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 ) + !! 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..-- @@ -34180,16 +34180,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaqp2 - !> 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. 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. ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34314,16 +34314,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaqps - !> 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. 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. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34684,18 +34684,18 @@ module stdlib_linalg_lapack_q work( 1 ) = real( lwkopt,KIND=qp) end subroutine stdlib_qlaqr0 - !> 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. 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. ! -- 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,19 +34744,19 @@ module stdlib_linalg_lapack_q end if end subroutine stdlib_qlaqr1 - !> 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. 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. 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,17 +35047,17 @@ module stdlib_linalg_lapack_q work( 1 ) = real( lwkopt,KIND=qp) end subroutine stdlib_qlaqr2 - !> 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. 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. 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,22 +35358,22 @@ module stdlib_linalg_lapack_q work( 1 ) = real( lwkopt,KIND=qp) end subroutine stdlib_qlaqr3 - !> 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. 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. 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,26 +36316,26 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaqsy - !> 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. 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. ! -- 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,56 +36762,56 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaqtr - !> 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" 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" alphai, beta,q, ldq, z, ldz, work, lwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -37154,17 +37154,17 @@ module stdlib_linalg_lapack_q info = norm_info end subroutine stdlib_qlaqz0 - !> 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. 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. ! 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,23 +37849,23 @@ module stdlib_linalg_lapack_q end if end subroutine stdlib_qlaqz4 - !> 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. 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. 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 - !> 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 ) + !! 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..-- @@ -38114,13 +38114,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlar2v - !> 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 ) + !! 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..-- @@ -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,15 +38513,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarfb - !> 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_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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -38650,21 +38650,21 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarfb_gett - !> 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. 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. ! -- 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,20 +38719,20 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarfg - !> 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. 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. ! -- 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,18 +38827,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarfgp - !> 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 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 ! -- 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,15 +38954,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarft - !> 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_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. ! -- 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 - !> 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 ) + !! 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..-- @@ -39491,12 +39491,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarfy - !> 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 ) + !! 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..-- @@ -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,16 +39659,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarra - !> 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. 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. 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 - !> 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 ) + !! 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, -- @@ -39925,20 +39925,20 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarrc - !> 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. 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. 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,21 +40396,21 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarrd - !> 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. 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. 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 - !> 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, & + !! 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, -- @@ -41180,15 +41180,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarrf - !> 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. 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. pivmin, spdiam, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41358,17 +41358,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarrj - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -41520,11 +41520,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarrr - !> 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, & + !! 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, -- @@ -42151,32 +42151,30 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarrv - !> ! - !> - !> 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. 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. ! -- 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,17 +42218,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlartg - !> 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. 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. ! -- 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,16 +42312,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlartgp - !> 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. 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. ! -- 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 +42368,12 @@ module stdlib_linalg_lapack_q ! end stdlib_qlartgs end subroutine stdlib_qlartgs - !> 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 ) + !! 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..-- @@ -42404,11 +42402,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlartv - !> 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 ) + !! 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..-- @@ -42606,15 +42604,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaruv - !> 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_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. ! -- 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 +42659,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarz - !> 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, & + !! 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, -- @@ -42750,20 +42748,20 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarzb - !> 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. 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. ! -- 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 +42810,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlarzt - !> 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 ) + !! 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..-- @@ -42876,13 +42874,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlas2 - !> 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 ) + !! 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..-- @@ -43046,15 +43044,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlascl - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43185,37 +43183,37 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd0 - !> 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. 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. work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43300,15 +43298,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd1 - !> 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_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. u2, ldu2, vt2, ldvt2, idxp, idx,idxc, idxq, coltyp, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43585,19 +43583,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd2 - !> 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. 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. vt2, ldvt2, idxc, ctot, z,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -43787,19 +43785,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd3 - !> 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. 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. ! -- 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,16 +44513,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd4 - !> 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. 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. ! -- 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,43 +44608,43 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd5 - !> 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. 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. givptr, givcol, ldgcol, givnum,ldgnum, poles, difl, difr, z, k, c, s, work,iwork, info ) ! -- lapack auxiliary routine -- @@ -44738,15 +44736,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd6 - !> 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_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. beta, dsigma, idx, idxp, idxq,perm, givptr, givcol, ldgcol, givnum, ldgnum,c, s, info ) ! -- lapack auxiliary routine -- @@ -44977,15 +44975,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd7 - !> 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_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. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45113,16 +45111,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasd8 - !> 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. 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. 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,20 +45313,20 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasda - !> 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. 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. work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45480,10 +45478,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 +45529,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,18 +45579,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaset - !> 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. 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. ! -- 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,21 +45671,21 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasq1 - !> 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. 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. ! -- 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 +46059,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasq2 - !> 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, & + !! 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, -- @@ -46231,10 +46229,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 +46437,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 +46665,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,59 +46775,59 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasq6 - !> 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. 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. ! -- 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 +47034,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasr - !> 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 ) + !! 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..-- @@ -47210,28 +47208,26 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasrt - !> ! - !> - !> 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. 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. ! -- 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,17 +47323,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlassq - !> 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 ]. 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 ]. ! -- 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,18 +47468,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasv2 - !> 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. 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. ! -- 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 +47552,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 +47619,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlaswp - !> 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, & + !! 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, -- @@ -47883,20 +47879,20 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasy2 - !> 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'). 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'). ! -- 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,18 +48316,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasyf - !> 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. 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. ! -- 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,20 +48550,20 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasyf_aa - !> 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'). 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'). ! -- 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,20 +48991,20 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasyf_rk - !> 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'). 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'). ! -- 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 +49452,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlasyf_rook - !> 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 ) + !! 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..-- @@ -49507,18 +49503,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlat2s - !> 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. 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. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49927,16 +49923,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlatbs - !> 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. 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. ! -- 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,18 +50033,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlatdf - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50455,17 +50451,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlatps - !> 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. 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. ! -- 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,18 +50553,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlatrd - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50958,12 +50954,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlatrs - !> 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 ) + !! 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..-- @@ -50998,19 +50994,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlatrz - !> 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. 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. ! -- 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,16 +51079,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlatsqr - !> 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. 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. ! -- 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,16 +51151,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlauu2 - !> 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. 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. ! -- 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 +51234,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qlauum - !> 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 ) + !! 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..-- @@ -51325,18 +51321,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qopgtr - !> 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). 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). ! -- 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,24 +51468,24 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qopmtr - !> 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. 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. ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51800,23 +51796,23 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorbdb - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51903,23 +51899,23 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorbdb1 - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52016,23 +52012,23 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorbdb2 - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52128,23 +52124,23 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorbdb3 - !> 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. 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. phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52270,19 +52266,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorbdb4 - !> 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. 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. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52369,17 +52365,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorbdb5 - !> 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. 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. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52497,21 +52493,21 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorbdb6 - !> 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). 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). ldx11, x12,ldx12, x21, ldx21, x22, ldx22, theta,u1, ldu1, u2, ldu2, v1t, ldv1t, v2t,ldv2t, & work, lwork, iwork, info ) ! -- lapack computational routine -- @@ -52772,23 +52768,23 @@ module stdlib_linalg_lapack_q ! end stdlib_qorcsd end subroutine stdlib_qorcsd - !> 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). 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). 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 +53183,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorcsd2by1 - !> 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 ) + !! 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..-- @@ -53251,13 +53247,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorg2l - !> 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 ) + !! 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..-- @@ -53316,24 +53312,24 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorg2r - !> 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. 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. ! -- 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 +53461,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgbr - !> 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 ) + !! 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..-- @@ -53555,13 +53551,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorghr - !> 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 ) + !! 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..-- @@ -53624,13 +53620,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgl2 - !> 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 ) + !! 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..-- @@ -53740,13 +53736,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorglq - !> 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 ) + !! 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..-- @@ -53861,13 +53857,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgql - !> 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 ) + !! 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..-- @@ -53977,13 +53973,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgqr - !> 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 ) + !! 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..-- @@ -54043,13 +54039,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgr2 - !> 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 ) + !! 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..-- @@ -54164,13 +54160,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgrq - !> 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 ) + !! 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..-- @@ -54265,13 +54261,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgtr - !> 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 ) + !! 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..-- @@ -54363,23 +54359,23 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgtsqr - !> 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. 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. ! -- 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,17 +54502,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorgtsqr_row - !> 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). 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). ! -- 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,18 +54821,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorm22 - !> 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'. 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'. ! -- 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,18 +54915,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorm2l - !> 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'. 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'. ! -- 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,30 +55014,30 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorm2r - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55176,16 +55172,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormbr - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55275,18 +55271,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormhr - !> 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'. 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'. ! -- 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,17 +55370,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qorml2 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55517,17 +55513,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormlq - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55654,17 +55650,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormql - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55791,18 +55787,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormqr - !> 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'. 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'. ! -- 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,18 +55881,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormr2 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55984,17 +55980,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormr3 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56127,17 +56123,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormrq - !> 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'. 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'. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56280,17 +56276,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormrz - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56396,13 +56392,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qormtr - !> 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 ) + !! 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, -- @@ -56494,16 +56490,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbcon - !> 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. 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. ! -- 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 +56577,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbequ - !> 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, & + !! 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, -- @@ -56775,17 +56771,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbrfs - !> 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. 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. ! -- 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,19 +56889,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbstf - !> 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. 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. ! -- 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,15 +56943,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbsv - !> 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_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. ldx, rcond, ferr, berr,work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57103,16 +57099,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbsvx - !> 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. 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. ! -- 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 +57186,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbtf2 - !> 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 ) + !! 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..-- @@ -57389,11 +57385,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbtrf - !> 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 ) + !! 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..-- @@ -57457,15 +57453,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpbtrs - !> 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_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. ! -- 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 +57628,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpftrf - !> 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 ) + !! 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..-- @@ -57790,11 +57786,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpftri - !> 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 ) + !! 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..-- @@ -57844,13 +57840,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpftrs - !> 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 ) + !! 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..-- @@ -57939,16 +57935,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpocon - !> 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. 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. ! -- 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,21 +58009,21 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpoequ - !> 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). 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). ! -- 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 +58091,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpoequb - !> 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, & + !! 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, -- @@ -58284,18 +58280,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qporfs - !> 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. 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. ! -- 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,15 +58331,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qposv - !> 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_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. rcond, ferr, berr, work,iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58478,15 +58474,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qposvx - !> 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_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. ! -- 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,15 +58561,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpotf2 - !> 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_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. ! -- 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,21 +58655,21 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpotrf - !> 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. 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. ! -- 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 +58753,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpotrf2 - !> 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 ) + !! 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..-- @@ -58798,11 +58794,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpotri - !> 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 ) + !! 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..-- @@ -58860,14 +58856,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpotrs - !> 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 ) + !! 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..-- @@ -58954,16 +58950,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qppcon - !> 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. 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. ! -- 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 +59043,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qppequ - !> 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, & + !! 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, -- @@ -59239,18 +59235,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpprfs - !> 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. 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. ! -- 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,15 +59284,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qppsv - !> 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_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. berr, work, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59427,14 +59423,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qppsvx - !> 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 ) + !! 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..-- @@ -59512,11 +59508,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpptrf - !> 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 ) + !! 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..-- @@ -59574,11 +59570,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpptri - !> 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 ) + !! 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..-- @@ -59636,17 +59632,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpptrs - !> 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. 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. ! -- 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,17 +59811,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpstf2 - !> 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. 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. ! -- 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,15 +60022,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpstrf - !> 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_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))). ! -- 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,23 +60095,23 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qptcon - !> 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.) 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.) ! -- 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 +60189,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpteqr - !> 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 ) + !! 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, -- @@ -60365,13 +60361,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qptrfs - !> 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 ) + !! 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..-- @@ -60406,14 +60402,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qptsv - !> 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,& + !! 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, -- @@ -60480,11 +60476,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qptsvx - !> 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 ) + !! 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..-- @@ -60563,14 +60559,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpttrf - !> 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 ) + !! 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..-- @@ -60618,14 +60614,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qpttrs - !> 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 ) + !! 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..-- @@ -60659,11 +60655,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qptts2 - !> 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 ) + !! 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..-- @@ -60713,10 +60709,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 +60854,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,17 +60956,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsbev - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61092,12 +61088,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsbevd - !> 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, & + !! 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, -- @@ -61318,15 +61314,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsbevx - !> 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_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62231,12 +62227,12 @@ module stdlib_linalg_lapack_q go to 490 end subroutine stdlib_qsbgst - !> 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, & + !! 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, -- @@ -62309,19 +62305,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsbgv - !> 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. 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. lwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62426,14 +62422,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsbgvd - !> 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, & + !! 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, -- @@ -62611,11 +62607,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsbgvx - !> 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 ) + !! 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..-- @@ -62942,16 +62938,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsbtrd - !> 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. 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. ! -- 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,35 +63194,35 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsfrk - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63378,13 +63374,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsgesv - !> 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 ) + !! 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..-- @@ -63460,10 +63456,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,17 +63549,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspev - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63678,12 +63674,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspevd - !> 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, & + !! 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, -- @@ -63891,15 +63887,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspevx - !> 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_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. ! -- 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 +64009,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspgst - !> 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 ) + !! 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..-- @@ -64097,20 +64093,20 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspgv - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64221,15 +64217,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspgvd - !> 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_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. z, ldz, work, iwork,ifail, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64333,36 +64329,36 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspgvx - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64512,12 +64508,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsposv - !> 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,& + !! 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, -- @@ -64705,19 +64701,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsprfs - !> 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. 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. ! -- 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 +64752,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspsv - !> 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, & + !! 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, -- @@ -64834,11 +64830,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qspsvx - !> 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 ) + !! 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..-- @@ -64931,14 +64927,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsptrd - !> 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 ) + !! 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..-- @@ -65254,11 +65250,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsptrf - !> 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 ) + !! 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..-- @@ -65465,11 +65461,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsptri - !> 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 ) + !! 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..-- @@ -65685,18 +65681,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsptrs - !> 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. 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. iblock, isplit, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66078,19 +66074,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstebz - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66304,24 +66300,24 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstedc - !> 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. 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. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66346,13 +66342,13 @@ module stdlib_linalg_lapack_q tryrac, work, lwork,iwork, liwork, info ) end subroutine stdlib_qstegr - !> 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, & + !! 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, -- @@ -66544,53 +66540,53 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstein - !> 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. 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. isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66964,13 +66960,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstemr - !> 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 ) + !! 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..-- @@ -67281,10 +67277,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 +67512,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,17 +67595,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstev - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67704,43 +67700,43 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstevd - !> 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. 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. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67954,12 +67950,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstevr - !> 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, & + !! 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, -- @@ -68148,13 +68144,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qstevx - !> 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 ) + !! 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, -- @@ -68231,13 +68227,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsycon - !> 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 ) + !! 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, -- @@ -68314,11 +68310,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsycon_rook - !> 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 ) + !! 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..-- @@ -68519,23 +68515,23 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyconv - !> 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. 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. ! -- 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,21 +68770,21 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyconvf - !> 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. 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. ! -- 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,15 +69023,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyconvf_rook - !> 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_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. ! -- 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 +69199,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,19 +69306,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyev - !> 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. 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. ! -- 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,58 +69440,58 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyevd - !> 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. 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. isuppz, work, lwork,iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69766,12 +69762,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyevr - !> 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, & + !! 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, -- @@ -70013,15 +70009,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyevx - !> 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_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. ! -- 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,15 +70132,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsygs2 - !> 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_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. ! -- 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 +70271,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsygst - !> 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 ) + !! 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..-- @@ -70375,19 +70371,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsygv - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70496,14 +70492,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsygvd - !> 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,& + !! 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, -- @@ -70624,11 +70620,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsygvx - !> 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, & + !! 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, -- @@ -70813,19 +70809,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsyrfs - !> 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. 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. ! -- 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,18 +70887,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsysv - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70963,22 +70959,22 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsysv_aa - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71040,24 +71036,24 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsysv_rk - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71119,14 +71115,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsysv_rook - !> 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, & + !! 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, -- @@ -71216,10 +71212,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 +71280,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,15 +71374,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytd2 - !> 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_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. ! -- 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,17 +71659,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytf2 - !> 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. 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. ! -- 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,15 +72111,15 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytf2_rk - !> 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_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. ! -- 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 +72522,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytf2_rook - !> 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 ) + !! 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..-- @@ -72652,11 +72648,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrd - !> 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, & + !! 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, -- @@ -72898,11 +72894,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrd_sb2st - !> 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 ) + !! 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, -- @@ -73074,16 +73070,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrd_sy2sb - !> 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. 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. ! -- 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 +73196,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrf - !> 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) + !! 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..-- @@ -73424,17 +73420,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrf_aa - !> 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. 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. ! -- 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,16 +73586,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrf_rk - !> 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. 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. ! -- 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 +73714,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrf_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_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. ! -- 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 +73902,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytri - !> 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 ) + !! 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..-- @@ -74134,11 +74130,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytri_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_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. ! -- 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 +74340,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrs - !> 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 ) + !! 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..-- @@ -74522,17 +74518,17 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrs2 - !> 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. 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. ! -- 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 +74675,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrs_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_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74798,11 +74794,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrs_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_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. ! -- 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 +75016,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qsytrs_rook - !> 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 ) + !! 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, -- @@ -75124,14 +75120,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtbcon - !> 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,& + !! 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, -- @@ -75362,12 +75358,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtbrfs - !> 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 ) + !! 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, -- @@ -75435,16 +75431,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtbtrs - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75937,11 +75933,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtfsm - !> 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 ) + !! 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..-- @@ -76120,10 +76116,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 +76372,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,26 +76601,26 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtfttr - !> 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). 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). mm, m, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77335,18 +77331,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgevc - !> 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 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 work, lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77700,20 +77696,20 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgex2 - !> 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 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 work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77949,28 +77945,28 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgexc - !> 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. 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. 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,69 +78271,69 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgsen - !> 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. 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. 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,16 +78512,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgsja - !> 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. 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. dif, mm, m, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78764,36 +78760,36 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgsna - !> 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. 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. ldf, scale, rdsum, rdscal,iwork, pq, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79404,36 +79400,36 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgsy2 - !> 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. 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. ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79733,14 +79729,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtgsyl - !> 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 ) + !! 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..-- @@ -79832,12 +79828,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtpcon - !> 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 ) + !! 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..-- @@ -79894,11 +79890,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtplqt - !> 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 ) + !! 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..-- @@ -79991,11 +79987,11 @@ module stdlib_linalg_lapack_q end do end subroutine stdlib_qtplqt2 - !> 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, & + !! 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, -- @@ -80109,11 +80105,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtpmlqt - !> 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, & + !! 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, -- @@ -80229,12 +80225,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtpmqrt - !> 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 ) + !! 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..-- @@ -80291,11 +80287,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtpqrt - !> 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 ) + !! 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..-- @@ -80382,11 +80378,11 @@ module stdlib_linalg_lapack_q end do end subroutine stdlib_qtpqrt2 - !> 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, & + !! 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, -- @@ -80800,14 +80796,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtprfb - !> 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, & + !! 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, -- @@ -81045,10 +81041,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 +81131,13 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtptri - !> 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 ) + !! 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..-- @@ -81208,10 +81204,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 +81446,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 +81500,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtpttr - !> 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 ) + !! 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..-- @@ -81605,23 +81601,23 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrcon - !> 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. 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. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82218,24 +82214,24 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrevc - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83040,18 +83036,18 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrevc3 - !> 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. 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. ! -- 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 +83240,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrexc - !> 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,& + !! 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, -- @@ -83479,19 +83475,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrrfs - !> 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. 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. lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83674,16 +83670,16 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrsen - !> 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. 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. work, ldwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83919,19 +83915,19 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrsna - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84580,11 +84576,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrsyl - !> 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 ) + !! 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..-- @@ -84654,11 +84650,11 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrti2 - !> 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 ) + !! 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..-- @@ -84741,12 +84737,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrtri - !> 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 ) + !! 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..-- @@ -84801,10 +84797,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 +85025,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 +85079,14 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtrttp - !> 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 ) + !! 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..-- @@ -85199,12 +85195,12 @@ module stdlib_linalg_lapack_q return end subroutine stdlib_qtzrzf - !> 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 ) + !! 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..-- @@ -85241,14 +85237,14 @@ module stdlib_linalg_lapack_q return end function stdlib_qzsum1 - !> 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 ) + !! 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 51897399a..fffe5f62b 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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, -- @@ -946,14 +946,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggbak - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -1217,12 +1217,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -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,16 +1436,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sla_wwaddw - !> 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. 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. ! -- 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 - !> [ 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 ) + !! 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..-- @@ -1848,39 +1848,39 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slae2 - !> 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. 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. e, e2, nval, ab, c, mout,nab, work, iwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2119,15 +2119,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaebz - !> 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. 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. ! -- 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,16 +2295,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaeda - !> 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 ]. 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 ]. ! -- 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 - !> 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 ) + !! 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..-- @@ -2578,14 +2578,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slag2 - !> 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 ) + !! 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..-- @@ -2608,13 +2608,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slag2d - !> 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 ) + !! 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, -- @@ -2710,19 +2710,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slagtm - !> 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. 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. ! -- 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,56 +2866,56 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slamrg - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -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,18 +3300,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaqge - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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, -- @@ -4119,18 +4119,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarfb_gett - !> 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 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 ! -- 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 - !> 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 ) + !! 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..-- @@ -4748,14 +4748,14 @@ module stdlib_linalg_lapack_s 410 return end subroutine stdlib_slarfx - !> 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 ) + !! 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..-- @@ -4782,12 +4782,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarfy - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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, -- @@ -4987,20 +4987,20 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarrc - !> 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. 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. 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,15 +5458,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarrd - !> 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. 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. pivmin, spdiam, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5636,17 +5636,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarrj - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -5798,32 +5798,30 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarrr - !> ! - !> - !> 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. 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. ! -- 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,17 +5865,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slartg - !> 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. 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. ! -- 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,16 +5959,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slartgp - !> 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. 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. ! -- 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 +6015,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 - !> 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 ) + !! 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..-- @@ -6051,11 +6049,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 +6252,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaruv - !> 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 ) + !! 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..-- @@ -6309,11 +6307,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,20 +6396,20 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarzb - !> 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. 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. ! -- 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 +6458,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarzt - !> 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 ) + !! 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..-- @@ -6524,16 +6522,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slas2 - !> 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. 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. ! -- 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 +6617,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 +6668,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 +6718,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 +6926,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 +7154,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,59 +7264,59 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasq6 - !> 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. 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. ! -- 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 +7523,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasr - !> 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 ) + !! 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..-- @@ -7699,28 +7697,26 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasrt - !> ! - !> - !> 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. 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. ! -- 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,17 +7812,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slassq - !> 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 ]. 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 ]. ! -- 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 +7957,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 +8024,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 - !> 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, & + !! 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, -- @@ -8288,20 +8284,20 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasy2 - !> 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'). 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'). ! -- 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,20 +8721,20 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasyf - !> 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'). 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'). ! -- 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,20 +9162,20 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasyf_rk - !> 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'). 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'). ! -- 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,18 +9623,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasyf_rook - !> 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. 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. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10047,18 +10043,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slatbs - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10465,18 +10461,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slatps - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -10866,16 +10862,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slatrs - !> 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. 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. ! -- 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,16 +10934,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slauu2 - !> 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. 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. ! -- 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,17 +11017,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slauum - !> 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. 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. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -11149,13 +11145,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorbdb6 - !> 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 ) + !! 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..-- @@ -11213,13 +11209,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorg2l - !> 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 ) + !! 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..-- @@ -11278,13 +11274,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorg2r - !> 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 ) + !! 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..-- @@ -11347,13 +11343,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgl2 - !> 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 ) + !! 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..-- @@ -11463,13 +11459,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorglq - !> 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 ) + !! 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..-- @@ -11584,13 +11580,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgql - !> 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 ) + !! 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..-- @@ -11700,13 +11696,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgqr - !> 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 ) + !! 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..-- @@ -11766,13 +11762,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgr2 - !> 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 ) + !! 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..-- @@ -11887,23 +11883,23 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgrq - !> 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. 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. ! -- 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,18 +12208,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorm22 - !> 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'. 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'. ! -- 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,18 +12302,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorm2l - !> 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'. 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'. ! -- 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,18 +12401,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorm2r - !> 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'. 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'. ! -- 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,17 +12500,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorml2 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12647,17 +12643,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormlq - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12784,17 +12780,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormql - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -12921,18 +12917,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormqr - !> 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'. 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'. ! -- 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,18 +13011,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormr2 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13114,17 +13110,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormr3 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13257,17 +13253,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormrq - !> 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'. 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'. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -13409,16 +13405,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormrz - !> 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. 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. ! -- 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,17 +13492,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spbequ - !> 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. 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. ! -- 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,16 +13610,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spbstf - !> 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. 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. ! -- 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 +13697,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,16 +13765,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spbtrs - !> 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. 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. ! -- 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,21 +13839,21 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spoequ - !> 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). 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). ! -- 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 +13921,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,16 +13983,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spotrs - !> 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. 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. ! -- 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 +14076,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sppequ - !> 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 ) + !! 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..-- @@ -14165,11 +14161,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 +14223,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spptrs - !> 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 ) + !! 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..-- @@ -14300,11 +14296,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 +14379,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spttrf - !> 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 ) + !! 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..-- @@ -14424,11 +14420,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 +14474,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_srscl - !> 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 ) + !! 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, -- @@ -15391,11 +15387,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 +15718,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssbtrd - !> 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. 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. ! -- 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 +15974,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssfrk - !> 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 ) + !! 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..-- @@ -16100,14 +16096,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspgst - !> 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 ) + !! 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..-- @@ -16423,11 +16419,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 +16630,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,18 +16850,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssptrs - !> 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. 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. iblock, isplit, work, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17247,11 +17243,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,23 +17448,23 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyconv - !> 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. 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. ! -- 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,21 +17703,21 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyconvf - !> 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. 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. ! -- 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 +17956,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyconvf_rook - !> 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 ) + !! 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..-- @@ -18136,15 +18132,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 - !> 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 ) + !! 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..-- @@ -18259,15 +18255,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssygs2 - !> 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 ) + !! 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..-- @@ -18398,10 +18394,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,17 +18462,17 @@ module stdlib_linalg_lapack_s endif end subroutine stdlib_ssyswapr - !> 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. 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. ! -- 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 +18914,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytf2_rk - !> 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 ) + !! 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..-- @@ -19329,17 +19325,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytf2_rook - !> 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. 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. ! -- 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,16 +19491,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrf_rk - !> 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. 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. ! -- 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 +19619,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 +19807,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 +20035,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 +20245,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,17 +20423,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrs2 - !> 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. 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. ! -- 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 +20580,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 +20707,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 +20929,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrs_rook - !> 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,& + !! 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, -- @@ -21171,12 +21167,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stbrfs - !> 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 ) + !! 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, -- @@ -21244,16 +21240,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stbtrs - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -21746,10 +21742,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 +21998,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 +22227,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 +22645,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stprfb - !> 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, & + !! 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, -- @@ -22894,10 +22890,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 +22980,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stptri - !> 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 ) + !! 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..-- @@ -23057,10 +23053,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 +23295,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 +23349,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stpttr - !> 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,& + !! 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, -- @@ -23588,11 +23584,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 +23658,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 +23745,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strtri - !> 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 ) + !! 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..-- @@ -23809,10 +23805,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 +24033,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,29 +24087,29 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strttp - !> 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. 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. ldu1, u2, ldu2, v1t, ldv1t,v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e,b22d, b22e, work, & lwork, info ) ! -- lapack computational routine -- @@ -24699,21 +24695,21 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sbbcsd - !> 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. 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. ! -- 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 +24800,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sdisna - !> 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, & + !! 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, -- @@ -25061,14 +25057,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbbrd - !> 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, & + !! 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, -- @@ -25190,17 +25186,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbcon - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25320,23 +25316,23 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbequ - !> 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). 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). ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25465,11 +25461,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 +25662,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 +25912,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbtrf - !> 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 ) + !! 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..-- @@ -26017,17 +26013,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgecon - !> 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. 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. ! -- 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,23 +26136,23 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeequ - !> 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). 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). ! -- 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,17 +26275,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeequb - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26377,17 +26373,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgemlqt - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26475,12 +26471,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgemqrt - !> 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 ) + !! 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..-- @@ -26533,13 +26529,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgesc2 - !> 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 ) + !! 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..-- @@ -26617,16 +26613,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetc2 - !> 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. 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. ! -- 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,27 +26686,27 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetf2 - !> 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. 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. ! -- 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 +26801,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetrf2 - !> 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 ) + !! 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..-- @@ -26907,12 +26903,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetri - !> 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 ) + !! 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..-- @@ -26976,17 +26972,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetrs - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27270,31 +27266,31 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggbal - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27400,12 +27396,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgghrd - !> 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 ) + !! 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..-- @@ -27464,11 +27460,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,21 +27476,21 @@ module stdlib_linalg_lapack_s return end function stdlib_sisnan - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27666,17 +27662,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sla_gbamv - !> 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. 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. info, work, iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27824,21 +27820,21 @@ module stdlib_linalg_lapack_s return end function stdlib_sla_gbrcond - !> 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. 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. ! -- 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,17 +27999,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sla_geamv - !> 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. 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. iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28153,13 +28149,13 @@ module stdlib_linalg_lapack_s return end function stdlib_sla_gercond - !> 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 ) + !! 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..-- @@ -28194,17 +28190,17 @@ 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) - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28353,20 +28349,20 @@ module stdlib_linalg_lapack_s return end function stdlib_sla_porcond - !> 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. 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. ! -- 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,17 +28538,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sla_syamv - !> 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. 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. iwork ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28709,14 +28705,14 @@ module stdlib_linalg_lapack_s return end function stdlib_sla_syrcond - !> 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 ) + !! 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..-- @@ -28915,19 +28911,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sladiv1 - !> 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. 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. ! -- 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,25 +29137,25 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed6 - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29301,20 +29297,20 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slags2 - !> 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. 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. ! -- 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,17 +29388,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slagtf - !> 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. 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. ! -- 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,28 +29585,28 @@ module stdlib_linalg_lapack_s end if end subroutine stdlib_slagts - !> 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. 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. ! -- 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,23 +29797,23 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaic1 - !> 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.) 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.) ! -- 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 +29902,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 +29977,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 +30049,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 +30125,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 +30197,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 +30302,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 +31006,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 +31130,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 +31192,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 +31288,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 +31481,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 +31687,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,41 +31873,41 @@ module stdlib_linalg_lapack_s return end function stdlib_slantr - !> 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. 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. ! -- 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 +31967,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,17 +32004,17 @@ module stdlib_linalg_lapack_s return end function stdlib_slapy2 - !> 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. 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. ! arguments integer(ilp), intent( in ) :: lda, ldb real(sp), intent( in ) :: a( lda, * ), b( ldb, * ), sr1, sr2, si,beta1, beta2 @@ -32063,9 +32059,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 +32170,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,23 +32427,23 @@ module stdlib_linalg_lapack_s end if end subroutine stdlib_slaqz4 - !> 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. 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. negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32653,21 +32649,21 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slar1v - !> 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. 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. ! -- 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,20 +32718,20 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarfg - !> 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. 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. ! -- 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 +32826,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,16 +32882,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarnv - !> 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. 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. work, iwork,pivmin, spdiam, twist, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33059,13 +33055,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarrb - !> 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, & + !! 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, -- @@ -33318,11 +33314,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 +33945,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarrv - !> 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 ) + !! 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..-- @@ -34119,19 +34115,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slascl - !> 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. 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. ! -- 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 +34843,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd4 - !> 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, & + !! 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 -- @@ -35086,15 +35082,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd7 - !> 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, & + !! 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, -- @@ -35222,11 +35218,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,16 +35388,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasq3 - !> 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. 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. ! -- 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,17 +35498,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slatdf - !> 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. 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. ! -- 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 +35600,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slatrd - !> 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 ) + !! 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..-- @@ -35644,24 +35640,24 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slatrz - !> 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. 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. ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35973,19 +35969,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorbdb - !> 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. 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. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36072,21 +36068,21 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorbdb5 - !> 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). 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). 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 +36343,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 - !> 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 ) + !! 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..-- @@ -36437,17 +36433,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorghr - !> 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). 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). ! -- 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,16 +36570,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorhr_col - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -36673,13 +36669,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormhr - !> 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 ) + !! 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, -- @@ -36771,12 +36767,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spbcon - !> 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, & + !! 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, -- @@ -36965,11 +36961,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 +37015,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spftrs - !> 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 ) + !! 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..-- @@ -37114,12 +37110,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spocon - !> 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, & + !! 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, -- @@ -37303,15 +37299,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sporfs - !> 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 ) + !! 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..-- @@ -37390,21 +37386,21 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spotf2 - !> 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. 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. ! -- 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 +37484,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 +37525,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spotri - !> 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 ) + !! 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..-- @@ -37623,12 +37619,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sppcon - !> 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, & + !! 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, -- @@ -37815,18 +37811,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spprfs - !> 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. 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. ! -- 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 +37860,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 - !> 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,& + !! 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, -- @@ -38003,11 +37999,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,17 +38061,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spptri - !> 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. 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. ! -- 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,17 +38240,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spstf2 - !> 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. 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. ! -- 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 +38451,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spstrf - !> 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 ) + !! 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..-- @@ -38510,10 +38506,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 +38651,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssb2st_kernels - !> 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 ) + !! 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..-- @@ -38737,12 +38733,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspcon - !> 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,& + !! 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, -- @@ -38930,19 +38926,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssprfs - !> 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. 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. ! -- 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 +38977,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspsv - !> 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, & + !! 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, -- @@ -39059,11 +39055,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 +39152,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssptrd - !> 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, & + !! 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, -- @@ -39354,13 +39350,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sstein - !> 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 ) + !! 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..-- @@ -39671,10 +39667,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 +39901,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 +39984,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sstev - !> 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, & + !! 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, -- @@ -40182,13 +40178,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sstevx - !> 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 ) + !! 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, -- @@ -40265,13 +40261,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssycon - !> 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 ) + !! 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, -- @@ -40348,11 +40344,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,22 +40533,22 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyrfs - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40614,24 +40610,24 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssysv_rk - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40693,10 +40689,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 +40783,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytd2 - !> 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 ) + !! 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..-- @@ -41072,11 +41068,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 +41194,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,16 +41440,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrd_sb2st - !> 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. 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. ! -- 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 +41566,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrf - !> 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 ) + !! 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, -- @@ -41674,11 +41670,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,36 +41853,36 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stftri - !> 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. 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. ldf, scale, rdsum, rdscal,iwork, pq, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42497,36 +42493,36 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgsy2 - !> 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. 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. ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42826,14 +42822,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgsyl - !> 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 ) + !! 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..-- @@ -42925,11 +42921,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 +43018,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 +43136,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 +43256,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 +43347,14 @@ module stdlib_linalg_lapack_s end do end subroutine stdlib_stpqrt2 - !> 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 ) + !! 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..-- @@ -43452,14 +43448,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strcon - !> 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 ) + !! 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..-- @@ -43568,16 +43564,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stzrzf - !> 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. 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. ! -- 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 +43616,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbsv - !> 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, & + !! 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, -- @@ -43846,16 +43842,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgbsvx - !> 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. 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. ! -- 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 +44010,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 +44102,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 +44154,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgehd2 - !> 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 ) + !! 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..-- @@ -44212,14 +44208,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgelq2 - !> 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 ) + !! 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..-- @@ -44309,12 +44305,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgelqf - !> 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 ) + !! 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..-- @@ -44396,10 +44392,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 +44441,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 +44547,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeqlf - !> 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 ) + !! 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..-- @@ -44606,16 +44602,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeqr2 - !> 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. 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. ! -- 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 +44658,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeqr2p - !> 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 ) + !! 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..-- @@ -44764,16 +44760,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeqrf - !> 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. 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. ! -- 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 +44859,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 +44927,12 @@ module stdlib_linalg_lapack_s end do end subroutine stdlib_sgeqrt2 - !> 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 ) + !! 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..-- @@ -45016,11 +45012,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 +45205,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 +45254,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,16 +45360,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgerqf - !> 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. 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. ! -- 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,33 +45438,33 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetrf - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45969,26 +45965,26 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgghd3 - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46047,26 +46043,26 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggqrf - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -46125,13 +46121,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggrqf - !> 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 & + !! 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, -- @@ -46208,11 +46204,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 +46406,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgtrfs - !> 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, & + !! 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, -- @@ -46499,51 +46495,51 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgtsvx - !> 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. 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. beta, q, ldq, z, ldz, work,lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -47374,15 +47370,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_shgeqz - !> 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 ) + !! 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..-- @@ -47504,15 +47500,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slabrd - !> 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 ) + !! 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..-- @@ -47572,18 +47568,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sladiv - !> 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. 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. ! -- 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 +48173,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed4 - !> 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, & + !! 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, -- @@ -48400,12 +48396,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed8 - !> 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 ) + !! 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, -- @@ -48506,11 +48502,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,25 +48848,25 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaein - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49016,14 +49012,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) - !> 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 ) + !! 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..-- @@ -49104,33 +49100,33 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slahr2 - !> 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.) 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.) ldx, scale, xnorm, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49429,28 +49425,28 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaln2 - !> 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). 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). 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 +49622,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slals0 - !> 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, & + !! 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, -- @@ -49784,15 +49780,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slamswlq - !> 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, & + !! 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, -- @@ -49946,16 +49942,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slamtsqr - !> 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. 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. ! -- 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 +50088,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slanv2 - !> 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 ) + !! 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..-- @@ -50132,11 +50128,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,16 +50205,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaqp2 - !> 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. 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. ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50343,10 +50339,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,26 +50746,26 @@ module stdlib_linalg_lapack_s end do loop_180 end subroutine stdlib_slaqr5 - !> 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. 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. ! -- 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,19 +51192,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaqtr - !> 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. 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. vt2, ldvt2, idxc, ctot, z,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51398,43 +51394,43 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd3 - !> 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. 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. givptr, givcol, ldgcol, givnum,ldgnum, poles, difl, difr, z, k, c, s, work,iwork, info ) ! -- lapack auxiliary routine -- @@ -51526,13 +51522,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd6 - !> 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 ) + !! 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..-- @@ -51613,18 +51609,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sopgtr - !> 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). 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). ! -- 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,23 +51756,23 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sopmtr - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51863,23 +51859,23 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorbdb1 - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51976,23 +51972,23 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorbdb2 - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52088,23 +52084,23 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorbdb3 - !> 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. 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. phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52230,23 +52226,23 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorbdb4 - !> 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). 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). 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 +52641,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorcsd2by1 - !> 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 ) + !! 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..-- @@ -52746,13 +52742,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgtr - !> 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 ) + !! 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..-- @@ -52844,17 +52840,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgtsqr - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52960,14 +52956,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormtr - !> 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 ) + !! 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..-- @@ -53159,11 +53155,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 +53313,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spftri - !> 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 ) + !! 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..-- @@ -53411,12 +53407,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spotrf - !> 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 ) + !! 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, -- @@ -53583,13 +53579,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sptrfs - !> 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 ) + !! 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..-- @@ -53624,14 +53620,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sptsv - !> 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,& + !! 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, -- @@ -53698,10 +53694,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 +53796,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssbev - !> 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, & + !! 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, -- @@ -54026,12 +54022,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssbevx - !> 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, & + !! 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, -- @@ -54104,14 +54100,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssbgv - !> 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, & + !! 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, -- @@ -54289,10 +54285,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 +54378,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspev - !> 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, & + !! 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, -- @@ -54595,13 +54591,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspevx - !> 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 ) + !! 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..-- @@ -54679,15 +54675,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspgv - !> 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, & + !! 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, -- @@ -54791,10 +54787,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 +54894,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyev - !> 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, & + !! 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, -- @@ -55145,13 +55141,13 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyevx - !> 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 ) + !! 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..-- @@ -55245,14 +55241,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssygv - !> 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,& + !! 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, -- @@ -55373,19 +55369,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssygvx - !> 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. 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. ! -- 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 +55447,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssysv - !> 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, & + !! 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, -- @@ -55548,11 +55544,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,26 +55720,26 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssytrd_sy2sb - !> 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). 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). mm, m, work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56454,18 +56450,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgevc - !> 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 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 work, lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -56819,20 +56815,20 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgex2 - !> 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 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 work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57068,28 +57064,28 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgexc - !> 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. 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. 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,69 +57390,69 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgsen - !> 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. 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. 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,16 +57631,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgsja - !> 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. 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. dif, mm, m, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57883,12 +57879,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stgsna - !> 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 ) + !! 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..-- @@ -57945,12 +57941,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stplqt - !> 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 ) + !! 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..-- @@ -58007,23 +58003,23 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_stpqrt - !> 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. 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. work, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58620,24 +58616,24 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strevc - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59442,19 +59438,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strevc3 - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -60103,11 +60099,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 +60204,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 +60333,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,26 +60384,26 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgelqt - !> 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. 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. ! -- 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 +60601,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgels - !> 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, & + !! 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, -- @@ -60702,15 +60698,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgemlq - !> 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, & + !! 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, -- @@ -60799,10 +60795,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 +60944,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,17 +61001,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeqrt - !> 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. 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. ! -- 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 +61049,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgesv - !> 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, & + !! 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, -- @@ -61257,34 +61253,34 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgesvx - !> 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. 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. alphai, beta, vsl, ldvsl, vsr,ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -61576,36 +61572,36 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgges - !> 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. 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. alphar, alphai, beta, vsl, ldvsl,vsr, ldvsr, rconde, rcondv, work, lwork, iwork,liwork, & bwork, info ) ! -- lapack driver routine -- @@ -61946,23 +61942,23 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggesx - !> 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). 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). ldvr, work, lwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62244,28 +62240,28 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggev - !> 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). 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). beta, vl, ldvl, vr, ldvr, ilo,ihi, lscale, rscale, abnrm, bbnrm, rconde,rcondv, work, lwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -62638,26 +62634,26 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggevx - !> 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. 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. ! -- 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,20 +62770,20 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sggglm - !> 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. 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. ! -- 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 +62902,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgglse - !> 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, & + !! 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, -- @@ -63121,14 +63117,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_shsein - !> 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 ) + !! 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..-- @@ -63209,20 +63205,20 @@ 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 - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63344,34 +63340,34 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed3 - !> 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. 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. 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 +63474,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 - !> 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 ) + !! 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..-- @@ -63675,12 +63671,12 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaexc - !> 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, & + !! 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, -- @@ -63984,15 +63980,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slahqr - !> 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, & + !! 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, -- @@ -64269,18 +64265,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd2 - !> 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. 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. ! -- 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,19 +64349,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaswlq - !> 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. 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. ! -- 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,24 +64434,24 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slatsqr - !> 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. 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. ! -- 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,30 +64583,30 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sorgbr - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64745,19 +64741,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sormbr - !> 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. 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. ! -- 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 +64795,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 - !> 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, & + !! 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, -- @@ -64955,15 +64951,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spbsvx - !> 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 ) + !! 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..-- @@ -65130,18 +65126,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spftrf - !> 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. 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. ! -- 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 +65177,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 - !> 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, & + !! 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, -- @@ -65324,18 +65320,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sposvx - !> 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. 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. ! -- 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,19 +65524,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strexc - !> 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. 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. lwork, iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65723,16 +65719,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strsen - !> 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. 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. work, ldwork, iwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65968,14 +65964,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_strsna - !> 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 ) + !! 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. -- @@ -66093,40 +66089,40 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgelq - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66326,15 +66322,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgelsy - !> 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 ) + !! 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. -- @@ -66441,26 +66437,26 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeqr - !> 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. 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. ! -- 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,20 +66673,20 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetsls - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -66810,14 +66806,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgetsqrhrt - !> 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,& + !! 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, -- @@ -67067,19 +67063,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed2 - !> 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. 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. 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,37 +67366,37 @@ 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, - !> 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. 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. work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67485,34 +67481,34 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd1 - !> 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. 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. ! -- 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 +67584,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,19 +67788,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slaed0 - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68018,17 +68014,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sstedc - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68123,19 +68119,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sstevd - !> 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. 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. ! -- 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,19 +68253,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyevd - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68378,17 +68374,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssygvd - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68510,19 +68506,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssbevd - !> 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. 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. lwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68627,17 +68623,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssbgvd - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68752,20 +68748,20 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspevd - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68876,24 +68872,24 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sspgvd - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69134,32 +69130,32 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sbdsdc - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69600,21 +69596,21 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sbdsqr - !> 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). 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). bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69846,27 +69842,27 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgees - !> 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). 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). rconde, rcondv, work, lwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70140,18 +70136,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeesx - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70399,33 +70395,33 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeev - !> 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. 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. ilo, ihi, scale, abnrm,rconde, rcondv, work, lwork, iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70711,20 +70707,20 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgeevx - !> 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. 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. v, ldv,work, lwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71801,33 +71797,33 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgejsv - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72127,20 +72123,20 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgelsd - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72566,27 +72562,27 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgelss - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73537,19 +73533,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgesdd - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75797,17 +75793,17 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgesvd - !> 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. 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. numrank, iwork, liwork,work, lwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -76663,19 +76659,19 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgesvdq - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77642,34 +77638,34 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgesvj - !> 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. 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. alphai, beta, vsl, ldvsl,vsr, ldvsr, work, lwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77956,23 +77952,23 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgges3 - !> 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). 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). ldvr, work, lwork,info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78251,12 +78247,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 - !> 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, & + !! 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, -- @@ -78899,32 +78895,32 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgsvj0 - !> 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. 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. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79330,16 +79326,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sgsvj1 - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79477,17 +79473,17 @@ module stdlib_linalg_lapack_s end if end subroutine stdlib_shseqr - !> 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. 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. 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,22 +79657,22 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slalsa - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79934,16 +79930,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slalsd - !> 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. 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. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80304,17 +80300,17 @@ module stdlib_linalg_lapack_s work( 1 ) = real( lwkopt,KIND=sp) end subroutine stdlib_slaqr0 - !> 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. 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. 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,22 +80611,22 @@ module stdlib_linalg_lapack_s work( 1 ) = real( lwkopt,KIND=sp) end subroutine stdlib_slaqr3 - !> 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. 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. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80986,56 +80982,56 @@ 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), - !> 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" 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" alphai, beta,q, ldq, z, ldz, work, lwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -81378,9 +81374,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,21 +81646,21 @@ module stdlib_linalg_lapack_s end if end subroutine stdlib_slaqz3 - !> 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. 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. 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,15 +82175,15 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slarre - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82318,16 +82314,16 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasd0 - !> 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. 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. 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,20 +82516,20 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasda - !> 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. 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. work, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -82685,18 +82681,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasdq - !> 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. 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. ! -- 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,21 +82773,21 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasq1 - !> 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. 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. ! -- 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,18 +83166,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasq2 - !> 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. 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. ! -- 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,23 +83400,23 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_slasyf_aa - !> 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.) 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.) ! -- 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,24 +83494,24 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_spteqr - !> 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. 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. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83540,53 +83536,53 @@ module stdlib_linalg_lapack_s tryrac, work, lwork,iwork, liwork, info ) end subroutine stdlib_sstegr - !> 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. 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. isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -83960,43 +83956,43 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sstemr - !> 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. 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. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84207,58 +84203,58 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_sstevr - !> 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. 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. isuppz, work, lwork,iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84536,18 +84532,18 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssyevr - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -84608,14 +84604,14 @@ module stdlib_linalg_lapack_s return end subroutine stdlib_ssysv_aa - !> 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) + !! 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 a685fd87f..62ff5a694 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 - !> 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 ) + !! 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..-- @@ -535,29 +535,29 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlag2w - !> 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. 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. ldu1, u2, ldu2, v1t, ldv1t,v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e,b22d, b22e, rwork, & lrwork, info ) ! -- lapack computational routine -- @@ -1148,32 +1148,32 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wbbcsd - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1611,35 +1611,35 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wbdsqr - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -1797,36 +1797,36 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wcgesv - !> 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. 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. 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 - !> 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 ) + !! 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..-- @@ -2038,12 +2038,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wdrscl - !> 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, & + !! 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, -- @@ -2315,14 +2315,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbbrd - !> 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, & + !! 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, -- @@ -2449,17 +2449,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbcon - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -2584,23 +2584,23 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbequ - !> 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). 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). ! -- 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 - !> 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, & + !! 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, -- @@ -2940,16 +2940,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbrfs - !> 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. 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. ! -- 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 - !> 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, & + !! 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, -- @@ -3219,11 +3219,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbsvx - !> 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 ) + !! 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..-- @@ -3305,11 +3305,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbtf2 - !> 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 ) + !! 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..-- @@ -3555,12 +3555,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbtrf - !> 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 ) + !! 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..-- @@ -3668,11 +3668,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgbtrs - !> 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 ) + !! 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..-- @@ -3765,16 +3765,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgebak - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -4033,11 +4033,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgebd2 - !> 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 ) + !! 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..-- @@ -4140,14 +4140,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgebrd - !> 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 ) + !! 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..-- @@ -4246,17 +4246,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgecon - !> 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. 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. ! -- 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,23 +4374,23 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeequ - !> 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). 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). ! -- 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,16 +4518,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeequb - !> 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. 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. rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4689,22 +4689,22 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgees - !> 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. 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. rcondv, work, lwork, rwork,bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -4891,18 +4891,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeesx - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -5140,33 +5140,33 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeev - !> 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. 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. 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,18 +5624,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgehrd - !> 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. 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. 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 - !> 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 ) + !! 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. -- @@ -7154,14 +7154,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgelq - !> 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 ) + !! 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..-- @@ -7210,14 +7210,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgelq2 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -7448,26 +7448,26 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgelqt3 - !> 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. 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. ! -- 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,33 +7666,33 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgels - !> 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. 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. iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8004,20 +8004,20 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgelsd - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8462,40 +8462,40 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgelss - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8687,15 +8687,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgelsy - !> 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_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) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8784,17 +8784,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgemlq - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8882,15 +8882,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgemlqt - !> 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_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) info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -8979,17 +8979,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgemqr - !> 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'. 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'. ! -- 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,15 +9384,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeqp3 - !> 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_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. ! -- 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,15 +9499,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeqr - !> 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_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. ! -- 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,16 +9554,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeqr2 - !> 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. 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. ! -- 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,15 +9610,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeqr2p - !> 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_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. ! -- 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,16 +9712,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeqrf - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -10024,11 +10024,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgeqrt3 - !> 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, & + !! 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, -- @@ -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 - !> 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 ) + !! 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..-- @@ -10437,25 +10437,25 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgesc2 - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -11932,17 +11932,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgesdd - !> 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. 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. ! -- 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,19 +11980,19 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgesv - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -14426,17 +14426,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgesvd - !> 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. 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. numrank, iwork, liwork,cwork, lcwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -15304,17 +15304,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgesvdq - !> 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. 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. 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 - !> 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, & + !! 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, -- @@ -16361,13 +16361,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgesvx - !> 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 ) + !! 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..-- @@ -16445,16 +16445,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgetc2 - !> 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. 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. ! -- 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,16 +16518,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgetf2 - !> 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. 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. ! -- 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,27 +16596,27 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgetrf - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -16814,12 +16814,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgetri - !> 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 ) + !! 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..-- @@ -16883,26 +16883,26 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgetrs - !> 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. 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. ! -- 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,20 +17120,20 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgetsls - !> 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. 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. ! -- 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 - !> 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 ) + !! 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, -- @@ -17366,17 +17366,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggbak - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17670,28 +17670,28 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggbal - !> 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. 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. vsl, ldvsl, vsr, ldvsr, work,lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -17922,28 +17922,28 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgges - !> 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. 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. vsl, ldvsl, vsr, ldvsr,work, lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -18173,30 +18173,30 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgges3 - !> 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. 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. beta, vsl, ldvsl, vsr,ldvsr, rconde, rcondv, work, lwork, rwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- @@ -18483,23 +18483,23 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggesx - !> 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). 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). work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -18753,23 +18753,23 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggev - !> 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). 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). work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19025,28 +19025,28 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggev3 - !> 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). 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). ldvl, vr, ldvr, ilo, ihi,lscale, rscale, abnrm, bbnrm, rconde, rcondv,work, lwork, rwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -19373,26 +19373,26 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggevx - !> 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. 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. ! -- 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,33 +19509,33 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggglm - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20039,31 +20039,31 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgghd3 - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20171,20 +20171,20 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgghrd - !> 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. 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. ! -- 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,26 +20303,26 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgglse - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -20381,26 +20381,26 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wggqrf - !> 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. 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. ! -- 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 - !> 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, & + !! 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, -- @@ -21000,32 +21000,32 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgsvj0 - !> 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. 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. 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 - !> 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 ) + !! 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, -- @@ -21457,11 +21457,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgtcon - !> 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, & + !! 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, -- @@ -21664,14 +21664,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgtrfs - !> 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 ) + !! 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..-- @@ -21756,14 +21756,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgtsv - !> 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, & + !! 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, -- @@ -21844,15 +21844,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wgtsvx - !> 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_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. ! -- 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 - !> 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 ) + !! 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..-- @@ -22006,12 +22006,12 @@ module stdlib_linalg_lapack_w end if end subroutine stdlib_wgttrs - !> 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 ) + !! 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..-- @@ -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,17 +22426,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whbev - !> 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. 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. 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 - !> 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, & + !! 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, -- @@ -22807,15 +22807,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whbevx - !> 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_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. 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 - !> 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, & + !! 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, -- @@ -23819,19 +23819,19 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whbgv - !> 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. 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. 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 - !> 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, & + !! 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, -- @@ -24135,11 +24135,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whbgvx - !> 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 ) + !! 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..-- @@ -24499,13 +24499,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whbtrd - !> 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 ) + !! 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..-- @@ -24580,13 +24580,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whecon - !> 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 ) + !! 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..-- @@ -24661,15 +24661,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whecon_rook - !> 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_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. ! -- 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,17 +24954,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wheev - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25107,58 +25107,58 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wheevd - !> 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. 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. 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 - !> 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, & + !! 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, -- @@ -25693,15 +25693,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wheevx - !> 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_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. ! -- 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,15 +25826,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whegs2 - !> 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_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. ! -- 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 - !> 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 ) + !! 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, -- @@ -26066,19 +26066,19 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whegv - !> 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. 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. 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 - !> 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,& + !! 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, -- @@ -26326,11 +26326,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whegvx - !> 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, & + !! 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, -- @@ -26519,19 +26519,19 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wherfs - !> 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. 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. ! -- 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,18 +26597,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whesv - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26669,22 +26669,22 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whesv_aa - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26746,24 +26746,24 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whesv_rk - !> 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). 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). ! -- 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 - !> 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, & + !! 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, -- @@ -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 - !> 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 ) + !! 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..-- @@ -27098,15 +27098,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetd2 - !> 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_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. ! -- 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,17 +27424,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetf2 - !> 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. 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. ! -- 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,15 +27955,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetf2_rk - !> 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_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. ! -- 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 - !> 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 ) + !! 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..-- @@ -28572,11 +28572,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrd - !> 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, & + !! 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, -- @@ -28845,11 +28845,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrd_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_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29021,16 +29021,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrd_he2hb - !> 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. 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. ! -- 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 - !> 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) + !! 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..-- @@ -29376,17 +29376,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrf_aa - !> 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. 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. ! -- 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,16 +29542,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrf_rk - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -29874,11 +29874,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetri - !> 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 ) + !! 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..-- @@ -30142,11 +30142,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetri_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_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. ! -- 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 - !> 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 ) + !! 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..-- @@ -30554,17 +30554,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrs2 - !> 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. 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. ! -- 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 - !> 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 ) + !! 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, -- @@ -30835,11 +30835,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrs_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_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. ! -- 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,16 +31074,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whetrs_rook - !> 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. 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. ! -- 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,41 +31334,41 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whfrk - !> 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. 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. 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 - !> 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 ) + !! 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..-- @@ -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,17 +32012,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whpev - !> 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. 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. 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 - !> 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, & + !! 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, -- @@ -32371,15 +32371,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whpevx - !> 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_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. ! -- 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 - !> 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 ) + !! 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..-- @@ -32585,20 +32585,20 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whpgv - !> 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. 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32718,15 +32718,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whpgvd - !> 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_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. 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 - !> 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,& + !! 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, -- @@ -33027,19 +33027,19 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whprfs - !> 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. 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. ! -- 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 - !> 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, & + !! 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, -- @@ -33156,11 +33156,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whpsvx - !> 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 ) + !! 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..-- @@ -33260,14 +33260,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whptrd - !> 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 ) + !! 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..-- @@ -33610,11 +33610,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whptrf - !> 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 ) + !! 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..-- @@ -33829,11 +33829,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whptri - !> 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 ) + !! 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..-- @@ -34070,14 +34070,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whptrs - !> 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, & + !! 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, -- @@ -34244,16 +34244,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_whsein - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34389,21 +34389,21 @@ module stdlib_linalg_lapack_w end if end subroutine stdlib_whseqr - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -34777,21 +34777,21 @@ module stdlib_linalg_lapack_w stdlib_wla_gbrpvgrw = rpvgrw end function stdlib_wla_gbrpvgrw - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -35151,20 +35151,20 @@ module stdlib_linalg_lapack_w stdlib_wla_gerpvgrw = rpvgrw end function stdlib_wla_gerpvgrw - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -35684,13 +35684,13 @@ module stdlib_linalg_lapack_w stdlib_wla_herpvgrw = rpvgrw end function stdlib_wla_herpvgrw - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -35973,20 +35973,20 @@ module stdlib_linalg_lapack_w stdlib_wla_porpvgrw = rpvgrw end function stdlib_wla_porpvgrw - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -36508,11 +36508,11 @@ module stdlib_linalg_lapack_w stdlib_wla_syrpvgrw = rpvgrw end function stdlib_wla_syrpvgrw - !> 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 ) + !! 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..-- @@ -36535,15 +36535,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wla_wwaddw - !> 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_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 ! -- 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 - !> 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 ) + !! 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..-- @@ -37106,12 +37106,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlacrm - !> 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 ) + !! 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..-- @@ -37150,11 +37150,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlacrt - !> 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 ) + !! 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..-- @@ -37172,12 +37172,12 @@ module stdlib_linalg_lapack_w return end function stdlib_wladiv - !> 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 ) + !! 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, -- @@ -37350,32 +37350,32 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaed0 - !> 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. 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. 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 - !> 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, & + !! 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, -- @@ -37680,11 +37680,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaed8 - !> 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, & + !! 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, -- @@ -37824,17 +37824,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaein - !> 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 ] 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 ] ! -- 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,16 +37914,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaesy - !> 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 ]. 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 ]. ! -- 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 - !> 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 ) + !! 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..-- @@ -37990,32 +37990,32 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlag2c - !> 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. 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. ! -- 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 - !> 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 ) + !! 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, -- @@ -38313,21 +38313,21 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlagtm - !> 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'). 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'). ! -- 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,18 +38852,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlahef - !> 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. 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. ! -- 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,20 +39096,20 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlahef_aa - !> 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'). 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'). ! -- 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,21 +39736,21 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlahef_rk - !> 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'). 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'). ! -- 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 - !> 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 & + !! 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, -- @@ -40694,14 +40694,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlahqr - !> 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 ) + !! 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..-- @@ -40784,28 +40784,28 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlahr2 - !> 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. 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. ! -- 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,28 +41000,28 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaic1 - !> 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). 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). 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,17 +41245,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlals0 - !> 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. 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. 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,22 +41548,22 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlalsa - !> 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. 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. iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41959,15 +41959,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlalsd - !> 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_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) lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -42117,15 +42117,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlamswlq - !> 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_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) 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 - !> 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 ) + !! 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..-- @@ -42354,11 +42354,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlangb - !> 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 ) + !! 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..-- @@ -42426,11 +42426,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlange - !> 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 ) + !! 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..-- @@ -42502,11 +42502,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlangt - !> 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 ) + !! 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..-- @@ -42621,11 +42621,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlanhb - !> 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 ) + !! 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..-- @@ -42731,11 +42731,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlanhe - !> 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 ) + !! 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..-- @@ -43951,11 +43951,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlanhf - !> 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 ) + !! 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..-- @@ -44079,11 +44079,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlanhp - !> 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 ) + !! 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..-- @@ -44151,11 +44151,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlanhs - !> 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 ) + !! 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..-- @@ -44214,11 +44214,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlanht - !> 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 ) + !! 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..-- @@ -44319,11 +44319,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlansb - !> 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 ) + !! 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..-- @@ -44452,11 +44452,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlansp - !> 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 ) + !! 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..-- @@ -44548,11 +44548,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlansy - !> 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 ) + !! 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..-- @@ -44741,11 +44741,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlantb - !> 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 ) + !! 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..-- @@ -44947,11 +44947,11 @@ module stdlib_linalg_lapack_w return end function stdlib_wlantp - !> 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 ) + !! 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..-- @@ -45133,14 +45133,14 @@ module stdlib_linalg_lapack_w return end function stdlib_wlantr - !> 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 ) + !! 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..-- @@ -45177,14 +45177,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlapll - !> 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 ) + !! 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..-- @@ -45245,14 +45245,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlapmr - !> 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 ) + !! 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..-- @@ -45313,11 +45313,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlapmt - !> 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 ) + !! 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, -- @@ -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 - !> 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 ) + !! 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..-- @@ -45719,16 +45719,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaqp2 - !> 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. 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. ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -45862,16 +45862,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaqps - !> 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. 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. 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 - !> 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 ) + !! 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..-- @@ -46272,19 +46272,19 @@ module stdlib_linalg_lapack_w end if end subroutine stdlib_wlaqr1 - !> 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. 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. 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,17 +46486,17 @@ module stdlib_linalg_lapack_w work( 1 ) = cmplx( lwkopt, 0,KIND=qp) end subroutine stdlib_wlaqr2 - !> 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. 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. 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,22 +46708,22 @@ module stdlib_linalg_lapack_w work( 1 ) = cmplx( lwkopt, 0,KIND=qp) end subroutine stdlib_wlaqr3 - !> 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. 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. 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,48 +47634,48 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaqsy - !> 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" 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" 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,23 +48470,23 @@ module stdlib_linalg_lapack_w end if end subroutine stdlib_wlaqz3 - !> 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. 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. negcnt, ztz, mingma,r, isuppz, nrminv, resid, rqcorr, work ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48693,15 +48693,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlar1v - !> 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_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) ) ! -- 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 - !> 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 ) + !! 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..-- @@ -48801,16 +48801,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarcm - !> 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. 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. ! -- 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,15 +49209,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarfb - !> 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_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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49348,21 +49348,21 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarfb_gett - !> 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 . 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 . ! -- 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,20 +49422,20 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarfg - !> 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. 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. ! -- 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,18 +49558,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarfgp - !> 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 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 ! -- 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,15 +49685,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarft - !> 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_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. ! -- 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 - !> 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 ) + !! 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..-- @@ -50224,18 +50224,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarfy - !> 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. 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. ! -- 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 - !> 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, & + !! 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, -- @@ -51093,32 +51093,30 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarrv - !> ! - !> - !> 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. 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. ! -- 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 +51211,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlartg - !> 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 ) + !! 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..-- @@ -51250,17 +51248,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlartv - !> 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. 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. ! -- 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 +51307,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarz - !> 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, & + !! 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, -- @@ -51411,20 +51409,20 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarzb - !> 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. 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. ! -- 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 +51473,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlarzt - !> 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 ) + !! 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..-- @@ -51645,10 +51643,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,59 +51699,59 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaset - !> 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. 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. ! -- 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,28 +51959,26 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlasr - !> ! - !> - !> 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. 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. ! -- 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,18 +52083,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlassq - !> 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. 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. ! -- 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 +52167,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,21 +52234,21 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaswp - !> 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'). 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'). ! -- 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,18 +52674,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlasyf - !> 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. 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. ! -- 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,20 +52910,20 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlasyf_aa - !> 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'). 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'). ! -- 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,20 +53356,20 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlasyf_rk - !> 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'). 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'). ! -- 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 +53822,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlasyf_rook - !> 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 ) + !! 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..-- @@ -53883,18 +53879,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlat2c - !> 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. 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. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -54439,16 +54435,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlatbs - !> 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. 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. ! -- 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,19 +54549,19 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlatdf - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55104,17 +55100,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlatps - !> 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. 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. ! -- 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,18 +55216,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlatrd - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55749,12 +55745,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlatrs - !> 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 ) + !! 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..-- @@ -55795,19 +55791,19 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlatrz - !> 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. 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. ! -- 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,41 +55876,41 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlatsqr - !> 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. 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. ! -- 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,56 +55970,56 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaunhr_col_getrfnp - !> 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. 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. ! -- 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,16 +56106,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlaunhr_col_getrfnp2 - !> 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. 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. ! -- 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,16 +56184,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlauu2 - !> 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. 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. ! -- 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 +56268,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wlauum - !> 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 ) + !! 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, -- @@ -56376,16 +56372,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbcon - !> 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. 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. ! -- 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 +56459,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbequ - !> 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, & + !! 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, -- @@ -56661,17 +56657,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbrfs - !> 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. 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. ! -- 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,19 +56791,19 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbstf - !> 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. 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. ! -- 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,15 +56845,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbsv - !> 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_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. ldx, rcond, ferr, berr,work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57006,16 +57002,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbsvx - !> 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. 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. ! -- 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 +57097,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbtf2 - !> 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 ) + !! 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..-- @@ -57301,11 +57297,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbtrf - !> 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 ) + !! 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..-- @@ -57369,15 +57365,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpbtrs - !> 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_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. ! -- 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 +57541,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpftrf - !> 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 ) + !! 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..-- @@ -57704,11 +57700,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpftri - !> 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 ) + !! 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..-- @@ -57758,13 +57754,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpftrs - !> 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 ) + !! 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..-- @@ -57858,16 +57854,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpocon - !> 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. 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. ! -- 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,21 +57928,21 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpoequ - !> 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). 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). ! -- 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 +58010,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpoequb - !> 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, & + !! 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, -- @@ -58207,18 +58203,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wporfs - !> 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. 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. ! -- 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,15 +58254,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wposv - !> 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_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. rcond, ferr, berr, work,rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58402,15 +58398,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wposvx - !> 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_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. ! -- 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,15 +58492,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpotf2 - !> 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_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. ! -- 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,21 +58587,21 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpotrf - !> 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. 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. ! -- 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 +58688,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpotrf2 - !> 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 ) + !! 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..-- @@ -58733,11 +58729,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpotri - !> 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 ) + !! 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..-- @@ -58795,14 +58791,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpotrs - !> 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 ) + !! 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..-- @@ -58894,16 +58890,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wppcon - !> 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. 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. ! -- 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 +58983,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wppequ - !> 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, & + !! 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, -- @@ -59183,18 +59179,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpprfs - !> 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. 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. ! -- 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,15 +59228,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wppsv - !> 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_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. berr, work, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59372,14 +59368,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wppsvx - !> 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 ) + !! 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..-- @@ -59458,11 +59454,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpptrf - !> 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 ) + !! 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..-- @@ -59522,11 +59518,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpptri - !> 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 ) + !! 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..-- @@ -59586,17 +59582,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpptrs - !> 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. 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. ! -- 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,17 +59776,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpstf2 - !> 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. 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. ! -- 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,15 +60002,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpstrf - !> 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_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))). ! -- 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,23 +60076,23 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wptcon - !> 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.) 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.) ! -- 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 +60171,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpteqr - !> 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, & + !! 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, -- @@ -60393,13 +60389,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wptrfs - !> 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 ) + !! 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..-- @@ -60435,14 +60431,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wptsv - !> 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,& + !! 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, -- @@ -60512,11 +60508,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wptsvx - !> 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 ) + !! 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..-- @@ -60611,14 +60607,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpttrf - !> 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 ) + !! 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..-- @@ -60678,14 +60674,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wpttrs - !> 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 ) + !! 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..-- @@ -60778,10 +60774,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 +60819,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wrot - !> 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 ) + !! 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..-- @@ -60904,12 +60900,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wspcon - !> 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 ) + !! 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..-- @@ -61062,12 +61058,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wspmv - !> 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 ) + !! 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..-- @@ -61182,12 +61178,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wspr - !> 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,& + !! 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, -- @@ -61379,19 +61375,19 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsprfs - !> 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. 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. ! -- 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 +61426,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wspsv - !> 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, & + !! 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, -- @@ -61508,15 +61504,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wspsvx - !> 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_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. ! -- 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 +61833,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsptrf - !> 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 ) + !! 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..-- @@ -62048,11 +62044,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsptri - !> 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 ) + !! 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..-- @@ -62268,19 +62264,19 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsptrs - !> 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. 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. liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62482,24 +62478,24 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wstedc - !> 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. 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. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62524,17 +62520,17 @@ module stdlib_linalg_lapack_w tryrac, work, lwork,iwork, liwork, info ) end subroutine stdlib_wstegr - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62734,67 +62730,67 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wstein - !> 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. 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. isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63168,13 +63164,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wstemr - !> 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 ) + !! 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..-- @@ -63488,13 +63484,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsteqr - !> 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 ) + !! 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..-- @@ -63569,13 +63565,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsycon - !> 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 ) + !! 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..-- @@ -63651,11 +63647,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsycon_rook - !> 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 ) + !! 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..-- @@ -63856,25 +63852,25 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsyconv - !> 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). 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). ! -- 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,23 +64109,23 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsyconvf - !> 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). 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). ! -- 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,15 +64364,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsyconvf_rook - !> 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_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. ! -- 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 +64546,12 @@ module stdlib_linalg_lapack_w scond = max( smin, smlnum ) / min( smax, bignum ) end subroutine stdlib_wsyequb - !> 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 ) + !! 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..-- @@ -64704,12 +64700,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsymv - !> 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 ) + !! 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..-- @@ -64808,11 +64804,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsyr - !> 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, & + !! 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, -- @@ -65001,19 +64997,19 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsyrfs - !> 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. 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. ! -- 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,18 +65075,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsysv - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65151,22 +65147,22 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsysv_aa - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65228,24 +65224,24 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsysv_rk - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65307,14 +65303,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsysv_rook - !> 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, & + !! 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, -- @@ -65404,10 +65400,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,15 +65468,15 @@ module stdlib_linalg_lapack_w endif end subroutine stdlib_wsyswapr - !> 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_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. ! -- 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,17 +65759,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytf2 - !> 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. 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. ! -- 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,15 +66216,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytf2_rk - !> 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_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. ! -- 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,16 +66632,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytf2_rook - !> 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. 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. ! -- 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 +66758,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrf - !> 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) + !! 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..-- @@ -66987,17 +66983,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrf_aa - !> 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. 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. ! -- 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,16 +67149,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrf_rk - !> 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. 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. ! -- 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 +67277,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrf_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_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. ! -- 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 +67465,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytri - !> 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 ) + !! 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..-- @@ -67697,11 +67693,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytri_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_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. ! -- 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 +67903,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrs - !> 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 ) + !! 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..-- @@ -68085,17 +68081,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrs2 - !> 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. 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. ! -- 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 +68238,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrs_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_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -68361,11 +68357,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrs_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_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. ! -- 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 +68579,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wsytrs_rook - !> 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 ) + !! 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, -- @@ -68692,14 +68688,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtbcon - !> 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,& + !! 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, -- @@ -68935,12 +68931,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtbrfs - !> 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 ) + !! 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, -- @@ -69008,16 +69004,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtbtrs - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69510,11 +69506,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtfsm - !> 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 ) + !! 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..-- @@ -69693,10 +69689,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 +69948,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,26 +70198,26 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtfttr - !> 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). 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). mm, m, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70615,17 +70611,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgevc - !> 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 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 ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70757,18 +70753,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgex2 - !> 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 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 info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -70841,26 +70837,26 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgexc - !> 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. 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. 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,70 +71116,70 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgsen - !> 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. 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. 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 +71365,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgsja - !> 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, & + !! 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, -- @@ -71526,33 +71522,33 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgsna - !> 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. 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. ldf, scale, rdsum, rdscal,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71716,35 +71712,35 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgsy2 - !> 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. 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. ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72066,14 +72062,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtgsyl - !> 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 ) + !! 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..-- @@ -72170,12 +72166,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtpcon - !> 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 ) + !! 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..-- @@ -72232,11 +72228,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtplqt - !> 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 ) + !! 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..-- @@ -72348,11 +72344,11 @@ module stdlib_linalg_lapack_w end do end subroutine stdlib_wtplqt2 - !> 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, & + !! 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, -- @@ -72466,11 +72462,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtpmlqt - !> 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, & + !! 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, -- @@ -72586,12 +72582,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtpmqrt - !> 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 ) + !! 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..-- @@ -72648,11 +72644,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtpqrt - !> 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 ) + !! 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..-- @@ -72739,11 +72735,11 @@ module stdlib_linalg_lapack_w end do end subroutine stdlib_wtpqrt2 - !> 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, & + !! 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, -- @@ -73159,14 +73155,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtprfb - !> 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, & + !! 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, -- @@ -73410,10 +73406,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 +73496,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtptri - !> 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 ) + !! 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..-- @@ -73573,10 +73569,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 +73827,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 +73881,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtpttr - !> 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 ) + !! 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..-- @@ -73991,23 +73987,23 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrcon - !> 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. 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. work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74191,24 +74187,24 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrevc - !> 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. 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. work, lwork, rwork, lrwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74488,14 +74484,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrevc3 - !> 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 ) + !! 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..-- @@ -74567,14 +74563,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrexc - !> 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,& + !! 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, -- @@ -74808,15 +74804,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrrfs - !> 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_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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74945,11 +74941,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrsen - !> 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,& + !! 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, -- @@ -75094,15 +75090,15 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrsna - !> 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_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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -75320,11 +75316,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrsyl - !> 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 ) + !! 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..-- @@ -75394,11 +75390,11 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrti2 - !> 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 ) + !! 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..-- @@ -75481,12 +75477,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrtri - !> 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 ) + !! 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..-- @@ -75541,10 +75537,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 +75786,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 +75840,14 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtrttp - !> 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 ) + !! 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..-- @@ -75960,24 +75956,24 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wtzrzf - !> 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. 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. ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76283,23 +76279,23 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunbdb - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76388,23 +76384,23 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunbdb1 - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76503,23 +76499,23 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunbdb2 - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76617,23 +76613,23 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunbdb3 - !> 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. 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. phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76766,19 +76762,19 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunbdb4 - !> 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. 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. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76865,17 +76861,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunbdb5 - !> 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. 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. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76993,21 +76989,21 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunbdb6 - !> 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). 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). 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,23 +77279,23 @@ module stdlib_linalg_lapack_w ! end stdlib_wuncsd end subroutine stdlib_wuncsd - !> 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). 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). 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 +77716,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wuncsd2by1 - !> 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 ) + !! 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..-- @@ -77784,13 +77780,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wung2l - !> 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 ) + !! 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..-- @@ -77849,24 +77845,24 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wung2r - !> 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. 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. ! -- 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 +77994,12 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungbr - !> 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 ) + !! 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..-- @@ -78088,13 +78084,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunghr - !> 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 ) + !! 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..-- @@ -78159,13 +78155,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungl2 - !> 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 ) + !! 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..-- @@ -78275,13 +78271,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunglq - !> 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 ) + !! 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..-- @@ -78396,13 +78392,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungql - !> 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 ) + !! 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..-- @@ -78512,13 +78508,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungqr - !> 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 ) + !! 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..-- @@ -78580,13 +78576,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungr2 - !> 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 ) + !! 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..-- @@ -78702,13 +78698,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungrq - !> 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 ) + !! 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..-- @@ -78803,13 +78799,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungtr - !> 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 ) + !! 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..-- @@ -78901,23 +78897,23 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungtsqr - !> 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. 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. ! -- 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,17 +79040,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wungtsqr_row - !> 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). 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). ! -- 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,18 +79359,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunm22 - !> 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'. 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'. ! -- 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,18 +79458,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunm2l - !> 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'. 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'. ! -- 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,30 +79561,30 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunm2r - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79726,16 +79722,16 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmbr - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79825,18 +79821,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmhr - !> 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'. 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'. ! -- 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,17 +79927,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunml2 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80074,17 +80070,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmlq - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80211,17 +80207,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmql - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80348,18 +80344,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmqr - !> 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'. 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'. ! -- 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,18 +80445,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmr2 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80554,17 +80550,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmr3 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80697,17 +80693,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmrq - !> 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'. 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'. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80852,17 +80848,17 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmrz - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80968,13 +80964,13 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wunmtr - !> 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 ) + !! 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..-- @@ -81055,18 +81051,18 @@ module stdlib_linalg_lapack_w return end subroutine stdlib_wupgtr - !> 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). 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). ! -- 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..9c9d6a411 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. - !> 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 ) + !! 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..-- @@ -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,17 +590,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zdrscl - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -725,23 +725,23 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgbequ - !> 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). 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). ! -- 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,16 +1058,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgebak - !> 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. 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. ! -- 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,17 +1228,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgebal - !> 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. 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. ! -- 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,23 +1356,23 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeequ - !> 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). 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). ! -- 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 - !> 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 ) + !! 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..-- @@ -1584,16 +1584,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgetc2 - !> 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. 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. ! -- 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 - !> 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 ) + !! 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, -- @@ -1770,17 +1770,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zggbak - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -2262,12 +2262,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -2831,17 +2831,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetf2 - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -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,17 +4323,17 @@ 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 - !> 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. 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. ! -- 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 - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -4872,14 +4872,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpgst - !> 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 ) + !! 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..-- @@ -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,21 +5441,21 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhptri - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -5681,21 +5681,21 @@ module stdlib_linalg_lapack_z stdlib_zla_gbrpvgrw = rpvgrw end function stdlib_zla_gbrpvgrw - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -5914,20 +5914,20 @@ module stdlib_linalg_lapack_z stdlib_zla_gerpvgrw = rpvgrw end function stdlib_zla_gerpvgrw - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -6247,20 +6247,20 @@ module stdlib_linalg_lapack_z stdlib_zla_porpvgrw = rpvgrw end function stdlib_zla_porpvgrw - !> 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. 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. ! -- 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: - !> 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 ) + !! 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..-- @@ -6890,12 +6890,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlacrm - !> 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 ) + !! 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..-- @@ -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 - !> 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, & + !! 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, -- @@ -7159,17 +7159,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaed8 - !> 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 ] 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 ] ! -- 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,16 +7249,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaesy - !> 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 ]. 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 ]. ! -- 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. - !> 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 ) + !! 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..-- @@ -7325,13 +7325,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlag2c - !> 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 ) + !! 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, -- @@ -7461,21 +7461,21 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlagtm - !> 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'). 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'). ! -- 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,20 +8000,20 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlahef - !> 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'). 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'). ! -- 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,21 +8640,21 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlahef_rk - !> 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'). 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'). ! -- 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,28 +9312,28 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlahef_rook - !> 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. 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. ! -- 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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -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 - !> 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 ) + !! 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..-- @@ -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,23 +10233,23 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaqsy - !> 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. 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. 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 - !> 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 ) + !! 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..-- @@ -10510,12 +10510,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlar2v - !> 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 ) + !! 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..-- @@ -10564,16 +10564,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarcm - !> 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. 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. ! -- 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 - !> 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 ) + !! 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, -- @@ -11111,21 +11111,21 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarfb_gett - !> 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 . 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 . ! -- 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,20 +11185,20 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarfg - !> 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. 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. ! -- 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,18 +11321,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarfgp - !> 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 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 ! -- 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 - !> 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 ) + !! 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..-- @@ -11953,14 +11953,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarfx - !> 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 ) + !! 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..-- @@ -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,32 +12052,30 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarnv - !> ! - !> - !> 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. 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. ! -- 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 +12170,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlartg - !> 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 ) + !! 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..-- @@ -12209,17 +12207,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlartv - !> 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. 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. ! -- 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 +12266,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,20 +12368,20 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarzb - !> 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. 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. ! -- 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 +12432,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarzt - !> 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 ) + !! 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..-- @@ -12604,10 +12602,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,59 +12658,59 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaset - !> 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. 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. ! -- 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,28 +12918,26 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlasr - !> ! - !> - !> 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. 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. ! -- 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 +13042,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,21 +13109,21 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaswp - !> 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'). 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'). ! -- 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,20 +13549,20 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlasyf - !> 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'). 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'). ! -- 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,20 +13995,20 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlasyf_rk - !> 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'). 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'). ! -- 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 +14461,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlasyf_rook - !> 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 ) + !! 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..-- @@ -14522,18 +14518,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlat2c - !> 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. 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. info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15078,19 +15074,19 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlatbs - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -15629,17 +15625,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlatps - !> 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. 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. ! -- 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,18 +15741,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlatrd - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -16274,12 +16270,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlatrs - !> 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 ) + !! 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..-- @@ -16320,56 +16316,56 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlatrz - !> 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. 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. ! -- 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,16 +16452,16 @@ 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 - !> 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. 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. ! -- 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,16 +16530,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlauu2 - !> 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. 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. ! -- 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 +16614,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlauum - !> 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 ) + !! 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, -- @@ -16722,16 +16718,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpbcon - !> 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. 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. ! -- 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,17 +16805,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpbequ - !> 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. 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. ! -- 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,16 +16939,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpbstf - !> 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. 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. ! -- 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 +17034,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 +17102,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpbtrs - !> 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 ) + !! 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..-- @@ -17206,16 +17202,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpocon - !> 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. 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. ! -- 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,21 +17276,21 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpoequ - !> 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). 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). ! -- 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 +17358,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpoequb - !> 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 ) + !! 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..-- @@ -17456,21 +17452,21 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpotf2 - !> 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. 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. ! -- 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 +17553,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 +17615,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpotrs - !> 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 ) + !! 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..-- @@ -17718,16 +17714,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zppcon - !> 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. 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. ! -- 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 +17807,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zppequ - !> 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 ) + !! 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..-- @@ -17897,11 +17893,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,17 +17957,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpptrs - !> 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. 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. ! -- 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,17 +18151,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpstf2 - !> 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. 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. ! -- 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 +18377,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpstrf - !> 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 ) + !! 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..-- @@ -18455,11 +18451,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 +18550,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpttrf - !> 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 ) + !! 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..-- @@ -18654,10 +18650,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 +18695,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zrot - !> 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 ) + !! 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..-- @@ -18857,12 +18853,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zspmv - !> 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 ) + !! 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..-- @@ -18977,15 +18973,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zspr - !> 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 ) + !! 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..-- @@ -19306,11 +19302,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 +19513,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,17 +19733,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsptrs - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -19947,13 +19943,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zstein - !> 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 ) + !! 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..-- @@ -20267,11 +20263,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,25 +20468,25 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsyconv - !> 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). 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). ! -- 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,23 +20725,23 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsyconvf - !> 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). 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). ! -- 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 +20980,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsyconvf_rook - !> 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 ) + !! 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..-- @@ -21166,12 +21162,12 @@ module stdlib_linalg_lapack_z scond = max( smin, smlnum ) / min( smax, bignum ) end subroutine stdlib_zsyequb - !> 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 ) + !! 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..-- @@ -21320,12 +21316,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsymv - !> 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 ) + !! 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..-- @@ -21424,10 +21420,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 +21488,15 @@ module stdlib_linalg_lapack_z endif end subroutine stdlib_zsyswapr - !> 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 ) + !! 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..-- @@ -21783,17 +21779,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytf2 - !> 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. 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. ! -- 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 +22236,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytf2_rk - !> 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 ) + !! 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..-- @@ -22656,16 +22652,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytf2_rook - !> 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. 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. ! -- 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,17 +22778,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytrf - !> 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. 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. ! -- 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,16 +22944,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytrf_rk - !> 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. 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. ! -- 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 +23072,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 +23260,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 +23488,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 +23698,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,17 +23876,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytrs2 - !> 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. 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. ! -- 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 +24033,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 +24152,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 +24374,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsytrs_rook - !> 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,& + !! 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, -- @@ -24621,12 +24617,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztbrfs - !> 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 ) + !! 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, -- @@ -24694,16 +24690,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztbtrs - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -25196,10 +25192,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 +25451,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,26 +25701,26 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztfttr - !> 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). 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). mm, m, work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26118,17 +26114,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztgevc - !> 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 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 ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26260,18 +26256,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztgex2 - !> 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 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 info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -26344,11 +26340,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 +26456,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 +26547,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 +26967,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztprfb - !> 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, & + !! 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, -- @@ -27222,10 +27218,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 +27308,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztptri - !> 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 ) + !! 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..-- @@ -27385,10 +27381,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 +27639,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,23 +27693,23 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztpttr - !> 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. 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. work, rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -27897,24 +27893,24 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrevc - !> 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. 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. work, lwork, rwork, lrwork, info) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -28194,14 +28190,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrevc3 - !> 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 ) + !! 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..-- @@ -28273,14 +28269,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrexc - !> 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,& + !! 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, -- @@ -28514,11 +28510,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 +28659,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 +28733,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 +28820,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrtri - !> 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 ) + !! 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..-- @@ -28884,10 +28880,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 +29129,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 +29183,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrttp - !> 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 ) + !! 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..-- @@ -29303,24 +29299,24 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztzrzf - !> 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. 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. ldx22, theta, phi, taup1,taup2, tauq1, tauq2, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29626,17 +29622,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunbdb - !> 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. 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. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -29754,13 +29750,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunbdb6 - !> 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 ) + !! 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..-- @@ -29818,13 +29814,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zung2l - !> 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 ) + !! 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..-- @@ -29883,13 +29879,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zung2r - !> 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 ) + !! 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..-- @@ -29954,13 +29950,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungl2 - !> 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 ) + !! 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..-- @@ -30070,13 +30066,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunglq - !> 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 ) + !! 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..-- @@ -30191,13 +30187,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungql - !> 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 ) + !! 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..-- @@ -30307,13 +30303,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungqr - !> 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 ) + !! 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..-- @@ -30375,13 +30371,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungr2 - !> 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 ) + !! 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..-- @@ -30497,23 +30493,23 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungrq - !> 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. 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. ! -- 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,18 +30818,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunm22 - !> 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'. 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'. ! -- 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,18 +30917,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunm2l - !> 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'. 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'. ! -- 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,18 +31020,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunm2r - !> 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'. 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'. ! -- 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,17 +31126,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunml2 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31273,17 +31269,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmlq - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31410,17 +31406,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmql - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31547,18 +31543,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmqr - !> 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'. 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'. ! -- 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,18 +31644,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmr2 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31753,17 +31749,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmr3 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -31896,17 +31892,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmrq - !> 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'. 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'. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -32051,29 +32047,29 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmrz - !> 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. 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. ldu1, u2, ldu2, v1t, ldv1t,v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e,b22d, b22e, rwork, & lrwork, info ) ! -- lapack computational routine -- @@ -32664,32 +32660,32 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zbbcsd - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -33127,14 +33123,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zbdsqr - !> 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, & + !! 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, -- @@ -33261,11 +33257,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 +33507,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_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. 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. ! -- 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 +33620,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 +33718,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgebd2 - !> 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 ) + !! 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..-- @@ -33828,10 +33824,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 +33876,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgehd2 - !> 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 ) + !! 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..-- @@ -33936,14 +33932,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelq2 - !> 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 ) + !! 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..-- @@ -34033,12 +34029,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelqf - !> 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 ) + !! 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..-- @@ -34123,17 +34119,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelqt3 - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34221,17 +34217,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgemlqt - !> 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'. 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'. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -34319,10 +34315,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 +34364,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 +34470,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeqlf - !> 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 ) + !! 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..-- @@ -34529,16 +34525,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeqr2 - !> 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. 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. ! -- 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 +34581,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeqr2p - !> 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 ) + !! 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..-- @@ -34687,16 +34683,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeqrf - !> 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. 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. ! -- 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 +34782,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 +34850,12 @@ module stdlib_linalg_lapack_z end do end subroutine stdlib_zgeqrt2 - !> 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 ) + !! 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..-- @@ -34942,10 +34938,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 +34989,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 +35095,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgerqf - !> 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 ) + !! 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..-- @@ -35158,27 +35154,27 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgesc2 - !> 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. 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. ! -- 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 +35270,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgetrf2 - !> 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 ) + !! 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..-- @@ -35376,12 +35372,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgetri - !> 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 ) + !! 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..-- @@ -35445,31 +35441,31 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgetrs - !> 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. 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. info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35577,26 +35573,26 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgghrd - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35655,26 +35651,26 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zggqrf - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -35733,12 +35729,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zggrqf - !> 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 ) + !! 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..-- @@ -35799,10 +35795,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 +35940,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhb2st_kernels - !> 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 ) + !! 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..-- @@ -36126,15 +36122,15 @@ module stdlib_linalg_lapack_z scond = max( smin, smlnum ) / min( smax, bignum ) end subroutine stdlib_zheequb - !> 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 ) + !! 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..-- @@ -36259,15 +36255,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhegs2 - !> 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 ) + !! 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..-- @@ -36398,11 +36394,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 +36498,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 +36626,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 +36899,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,16 +37075,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrd_he2hb - !> 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. 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. ! -- 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,17 +37201,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrf - !> 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. 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. ! -- 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,16 +37367,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrf_rk - !> 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. 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. ! -- 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 +37495,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 +37726,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 +37907,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 +38028,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 +38267,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 +38371,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 +38612,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 +38760,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 +38901,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 +39051,14 @@ module stdlib_linalg_lapack_z return end function stdlib_zla_hercond_c - !> 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 ) + !! 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..-- @@ -39244,10 +39240,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 +39390,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 +39541,14 @@ module stdlib_linalg_lapack_z return end function stdlib_zla_syrcond_c - !> 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 ) + !! 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..-- @@ -39734,15 +39730,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 - !> 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 ) + !! 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..-- @@ -39884,32 +39880,32 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlabrd - !> 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. 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. 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 +40007,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,32 +40151,32 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaein - !> 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. 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. ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -40342,12 +40338,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlags2 - !> 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 & + !! 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, -- @@ -40628,14 +40624,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) - !> 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 ) + !! 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..-- @@ -40718,28 +40714,28 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlahr2 - !> 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). 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). 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,17 +40959,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlals0 - !> 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. 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. 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,22 +41262,22 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlalsa - !> 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. 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. iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -41677,11 +41673,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 +41748,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 +41820,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 +41896,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 +42015,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 +42125,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 +43345,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 +43473,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 +43545,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 +43608,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 +43713,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 +43846,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 +43942,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 +44135,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 +44341,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 +44527,14 @@ module stdlib_linalg_lapack_z return end function stdlib_zlantr - !> 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 ) + !! 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..-- @@ -44575,11 +44571,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,16 +44651,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaqp2 - !> 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. 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. ldf ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -44798,10 +44794,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 +45192,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 +45246,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,18 +45486,18 @@ module stdlib_linalg_lapack_z end if end subroutine stdlib_zlaqz3 - !> 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. 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. ! -- 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 +45640,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,16 +46290,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlarrv - !> 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. 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. ! -- 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,41 +46404,41 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlatdf - !> 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. 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. ! -- 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 +46498,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaunhr_col_getrfnp - !> 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, & + !! 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, -- @@ -46700,14 +46696,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpbrfs - !> 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 ) + !! 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..-- @@ -46900,11 +46896,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 +46950,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpftrs - !> 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, & + !! 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, -- @@ -47147,15 +47143,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zporfs - !> 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 ) + !! 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..-- @@ -47242,11 +47238,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 +47279,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpotri - !> 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, & + !! 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, -- @@ -47479,18 +47475,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpprfs - !> 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. 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. ! -- 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 +47524,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 - !> 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,& + !! 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, -- @@ -47668,11 +47664,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,23 +47728,23 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpptri - !> 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.) 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.) ! -- 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 +47823,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpteqr - !> 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 ) + !! 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..-- @@ -47894,13 +47890,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpttrs - !> 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 ) + !! 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..-- @@ -47975,12 +47971,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zspcon - !> 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,& + !! 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, -- @@ -48172,19 +48168,19 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsprfs - !> 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. 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. ! -- 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 +48219,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zspsv - !> 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, & + !! 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, -- @@ -48301,67 +48297,67 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zspsvx - !> 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. 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. isuppz, tryrac, work, lwork,iwork, liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -48735,13 +48731,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zstemr - !> 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 ) + !! 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..-- @@ -48816,13 +48812,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsycon - !> 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 ) + !! 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..-- @@ -48898,11 +48894,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,19 +49087,19 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsyrfs - !> 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. 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. ! -- 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,22 +49165,22 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsysv - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49246,24 +49242,24 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsysv_rk - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -49325,14 +49321,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsysv_rook - !> 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, & + !! 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, -- @@ -49422,14 +49418,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsysvx - !> 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 ) + !! 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, -- @@ -49531,11 +49527,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,70 +49710,70 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztftri - !> 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. 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. 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,33 +49959,33 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztgsja - !> 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. 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. ldf, scale, rdsum, rdscal,info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50153,35 +50149,35 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztgsy2 - !> 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. 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. ldf, scale, dif, work, lwork,iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -50503,14 +50499,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztgsyl - !> 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 ) + !! 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..-- @@ -50607,12 +50603,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztpcon - !> 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 ) + !! 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..-- @@ -50669,11 +50665,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 +50783,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 +50903,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztpmqrt - !> 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 ) + !! 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..-- @@ -50969,14 +50965,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztpqrt - !> 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 ) + !! 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..-- @@ -51075,15 +51071,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrcon - !> 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 ) + !! 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, -- @@ -51301,19 +51297,19 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrsyl - !> 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. 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. lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -51400,21 +51396,21 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunbdb5 - !> 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). 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). 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 +51686,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 - !> 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 ) + !! 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..-- @@ -51780,13 +51776,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunghr - !> 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 ) + !! 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..-- @@ -51881,17 +51877,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungtr - !> 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). 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). ! -- 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,16 +52014,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunhr_col - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52117,17 +52113,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmhr - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52233,13 +52229,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmtr - !> 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 ) + !! 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..-- @@ -52320,18 +52316,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zupgtr - !> 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). 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). ! -- 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,36 +52473,36 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zupmtr - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -52664,12 +52660,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 - !> 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, & + !! 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, -- @@ -52941,11 +52937,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,16 +53143,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgbrfs - !> 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. 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. ! -- 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 +53195,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgbsv - !> 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, & + !! 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, -- @@ -53426,11 +53422,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 +53529,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 +53659,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,26 +53710,26 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelqt - !> 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. 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. ! -- 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 +53928,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 +54080,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 +54137,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,16 +54334,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgerfs - !> 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. 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. ! -- 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,26 +54412,26 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgetrf - !> 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. 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. ! -- 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,33 +54548,33 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zggglm - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -55082,20 +55078,20 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgghd3 - !> 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. 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. ! -- 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 +55210,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgglse - !> 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 ) + !! 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, -- @@ -55298,11 +55294,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 +55501,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgtrfs - !> 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, & + !! 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, -- @@ -55593,15 +55589,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgtsvx - !> 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,& + !! 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, -- @@ -56525,11 +56521,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 +56885,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhbtrd - !> 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 ) + !! 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..-- @@ -56970,13 +56966,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhecon - !> 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 ) + !! 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..-- @@ -57051,10 +57047,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,58 +57158,58 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zheev - !> 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. 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. isuppz, work, lwork,rwork, lrwork, iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -57501,12 +57497,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zheevr - !> 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, & + !! 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, -- @@ -57748,13 +57744,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zheevx - !> 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 ) + !! 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, -- @@ -57849,14 +57845,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhegv - !> 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,& + !! 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, -- @@ -57977,11 +57973,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,19 +58166,19 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zherfs - !> 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. 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. ! -- 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,22 +58244,22 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhesv - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58325,24 +58321,24 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhesv_rk - !> 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). 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). ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -58404,14 +58400,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhesv_rook - !> 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, & + !! 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, -- @@ -58501,41 +58497,41 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhesvx - !> 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. 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. z, ldz, work, lwork,rwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -59001,13 +58997,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhgeqz - !> 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 ) + !! 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..-- @@ -59082,10 +59078,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 +59175,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpev - !> 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, & + !! 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, -- @@ -59396,13 +59392,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpevx - !> 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 ) + !! 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..-- @@ -59481,15 +59477,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpgv - !> 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, & + !! 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, -- @@ -59593,12 +59589,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpgvx - !> 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,& + !! 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, -- @@ -59790,19 +59786,19 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhprfs - !> 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. 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. ! -- 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 +59837,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpsv - !> 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, & + !! 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, -- @@ -59919,14 +59915,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpsvx - !> 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, & + !! 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, -- @@ -60093,12 +60089,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhsein - !> 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 ) + !! 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, -- @@ -60271,15 +60267,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaed0 - !> 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, & + !! 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, -- @@ -60429,15 +60425,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlamswlq - !> 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, & + !! 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, -- @@ -60591,19 +60587,19 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlamtsqr - !> 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. 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. 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,18 +60801,18 @@ 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 - !> 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. 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. ! -- 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,19 +60885,19 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlaswlq - !> 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. 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. ! -- 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,19 +60970,19 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlatsqr - !> 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. 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. ! -- 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 +61024,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 - !> 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, & + !! 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, -- @@ -61185,15 +61181,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpbsvx - !> 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 ) + !! 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..-- @@ -61361,11 +61357,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,18 +61516,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zpftri - !> 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. 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. ! -- 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 +61567,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 - !> 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, & + !! 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, -- @@ -61715,12 +61711,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zposvx - !> 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, & + !! 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, -- @@ -61933,13 +61929,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zptrfs - !> 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 ) + !! 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..-- @@ -61975,14 +61971,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zptsv - !> 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,& + !! 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, -- @@ -62052,19 +62048,19 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zptsvx - !> 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. 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. liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62266,24 +62262,24 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zstedc - !> 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. 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. isuppz, work, lwork, iwork,liwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62308,26 +62304,26 @@ module stdlib_linalg_lapack_z tryrac, work, lwork,iwork, liwork, info ) end subroutine stdlib_zstegr - !> 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. 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. 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 +62583,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztgsen - !> 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, & + !! 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, -- @@ -62744,15 +62740,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztgsna - !> 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, & + !! 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, -- @@ -62881,23 +62877,23 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_ztrsen - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -62986,23 +62982,23 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunbdb1 - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63101,23 +63097,23 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunbdb2 - !> 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. 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. work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63215,23 +63211,23 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunbdb3 - !> 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. 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. phantom, work, lwork,info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -63364,23 +63360,23 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunbdb4 - !> 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). 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). 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,24 +63797,24 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zuncsd2by1 - !> 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. 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. ! -- 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 +63946,13 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungbr - !> 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 ) + !! 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..-- @@ -64048,30 +64044,30 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zungtsqr - !> 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). 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). info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64209,35 +64205,35 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zunmbr - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64395,14 +64391,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zcgesv - !> 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 ) + !! 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. -- @@ -64520,33 +64516,33 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelq - !> 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. 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. iwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -64858,20 +64854,20 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelsd - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65316,40 +65312,40 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelss - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -65541,15 +65537,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgelsy - !> 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, & + !! 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, -- @@ -65638,15 +65634,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgemlq - !> 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, & + !! 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, -- @@ -65735,15 +65731,15 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgemqr - !> 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 ) + !! 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. -- @@ -65850,25 +65846,25 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeqr - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -67345,17 +67341,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgesdd - !> 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. 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. ! -- 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,19 +67389,19 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgesv - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -69839,17 +69835,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgesvd - !> 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. 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. numrank, iwork, liwork,cwork, lcwork, rwork, lrwork, info ) ! Scalar Arguments character, intent(in) :: joba, jobp, jobr, jobu, jobv @@ -70717,14 +70713,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgesvdq - !> 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, & + !! 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, -- @@ -70922,26 +70918,26 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgesvx - !> 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. 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. ! -- 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,20 +71155,20 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgetsls - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71292,28 +71288,28 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgetsqrhrt - !> 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. 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. vsl, ldvsl, vsr, ldvsr, work,lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -71544,30 +71540,30 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgges - !> 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. 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. beta, vsl, ldvsl, vsr,ldvsr, rconde, rcondv, work, lwork, rwork,iwork, liwork, bwork, info ) ! -- lapack driver routine -- @@ -71854,23 +71850,23 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zggesx - !> 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). 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). work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72124,28 +72120,28 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zggev - !> 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). 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). ldvl, vr, ldvr, ilo, ihi,lscale, rscale, abnrm, bbnrm, rconde, rcondv,work, lwork, rwork, & iwork, bwork, info ) ! -- lapack driver routine -- @@ -72472,10 +72468,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,17 +72572,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhbev - !> 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. 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -72726,12 +72722,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhbevd - !> 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, & + !! 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, -- @@ -72957,12 +72953,12 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhbevx - !> 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, & + !! 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, -- @@ -73037,19 +73033,19 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhbgv - !> 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. 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. lwork, rwork, lrwork, iwork,liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73164,14 +73160,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhbgvd - !> 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, & + !! 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, -- @@ -73353,17 +73349,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhbgvx - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73506,19 +73502,19 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zheevd - !> 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. 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73638,17 +73634,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhegvd - !> 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. 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. liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73780,20 +73776,20 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpevd - !> 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. 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. iwork, liwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -73913,16 +73909,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhpgvd - !> 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. 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. rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74084,22 +74080,22 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgees - !> 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. 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. rcondv, work, lwork, rwork,bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74286,18 +74282,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeesx - !> 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. 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. info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74535,33 +74531,33 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeev - !> 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. 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. ihi, scale, abnrm, rconde,rcondv, work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -74837,18 +74833,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgeevx - !> 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. 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. v, ldv,cwork, lwork, rwork, lrwork, iwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -76242,17 +76238,17 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgejsv - !> 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. 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. rwork, lrwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77094,28 +77090,28 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgesvj - !> 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. 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. vsl, ldvsl, vsr, ldvsr,work, lwork, rwork, bwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77345,23 +77341,23 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgges3 - !> 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). 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). work, lwork, rwork, info ) ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -77617,12 +77613,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 - !> 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, & + !! 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, -- @@ -78158,32 +78154,32 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgsvj0 - !> 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. 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. nsweep, work, lwork, info ) ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78531,18 +78527,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zgsvj1 - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78603,14 +78599,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhesv_aa - !> 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) + !! 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..-- @@ -78832,16 +78828,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zhetrf_aa - !> 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. 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. ! -- lapack computational routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -78977,18 +78973,18 @@ module stdlib_linalg_lapack_z end if end subroutine stdlib_zhseqr - !> 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. 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. ! -- 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,16 +79217,16 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlahef_aa - !> 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. 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. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -79568,17 +79564,17 @@ module stdlib_linalg_lapack_z work( 1 ) = cmplx( lwkopt, 0,KIND=dp) end subroutine stdlib_zlaqr0 - !> 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. 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. 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,22 +79786,22 @@ module stdlib_linalg_lapack_z work( 1 ) = cmplx( lwkopt, 0,KIND=dp) end subroutine stdlib_zlaqr3 - !> 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. 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. lwork, info ) ! -- lapack auxiliary routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80138,48 +80134,48 @@ 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), - !> 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" 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" beta, q, ldq, z,ldz, work, lwork, rwork, rec,info ) ! arguments character, intent( in ) :: wants, wantq, wantz @@ -80491,9 +80487,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,18 +80676,18 @@ module stdlib_linalg_lapack_z end if end subroutine stdlib_zlaqz2 - !> 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. 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. ! -- 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,18 +80912,18 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zlasyf_aa - !> 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. 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. ! -- lapack driver routine -- ! -- lapack is a software package provided by univ. of tennessee, -- @@ -80988,14 +80984,14 @@ module stdlib_linalg_lapack_z return end subroutine stdlib_zsysv_aa - !> 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) + !! 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..--