diff --git a/mtx/blas_src/dasum.f b/mtx/blas_src/dasum.f
deleted file mode 100644
index c1bd78ac8..000000000
--- a/mtx/blas_src/dasum.f
+++ /dev/null
@@ -1,111 +0,0 @@
-*> \brief \b DASUM
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX)
-*
-* .. Scalar Arguments ..
-* INTEGER INCX,N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION DX(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DASUM takes the sum of the absolute values.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_blas_level1
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> jack dongarra, linpack, 3/11/78.
-*> modified 3/93 to return if incx .le. 0.
-*> modified 12/3/93, array(1) declarations changed to array(*)
-*> \endverbatim
-*>
-* =====================================================================
- DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX)
-*
-* -- Reference BLAS level1 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*)
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION DTEMP
- INTEGER I,M,MP1,NINCX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DABS,MOD
-* ..
- DASUM = 0.0d0
- DTEMP = 0.0d0
- IF (N.LE.0 .OR. INCX.LE.0) RETURN
- IF (INCX.EQ.1) THEN
-* code for increment equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,6)
- IF (M.NE.0) THEN
- DO I = 1,M
- DTEMP = DTEMP + DABS(DX(I))
- END DO
- IF (N.LT.6) THEN
- DASUM = DTEMP
- RETURN
- END IF
- END IF
- MP1 = M + 1
- DO I = MP1,N,6
- DTEMP = DTEMP + DABS(DX(I)) + DABS(DX(I+1)) +
- $ DABS(DX(I+2)) + DABS(DX(I+3)) +
- $ DABS(DX(I+4)) + DABS(DX(I+5))
- END DO
- ELSE
-*
-* code for increment not equal to 1
-*
- NINCX = N*INCX
- DO I = 1,NINCX,INCX
- DTEMP = DTEMP + DABS(DX(I))
- END DO
- END IF
- DASUM = DTEMP
- RETURN
- END
diff --git a/mtx/blas_src/daxpy.f b/mtx/blas_src/daxpy.f
deleted file mode 100644
index 64a02d68b..000000000
--- a/mtx/blas_src/daxpy.f
+++ /dev/null
@@ -1,115 +0,0 @@
-*> \brief \b DAXPY
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY)
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION DA
-* INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION DX(*),DY(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DAXPY constant times a vector plus a vector.
-*> uses unrolled loops for increments equal to one.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_blas_level1
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> jack dongarra, linpack, 3/11/78.
-*> modified 12/3/93, array(1) declarations changed to array(*)
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY)
-*
-* -- Reference BLAS level1 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION DA
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*),DY(*)
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I,IX,IY,M,MP1
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- IF (N.LE.0) RETURN
- IF (DA.EQ.0.0d0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,4)
- IF (M.NE.0) THEN
- DO I = 1,M
- DY(I) = DY(I) + DA*DX(I)
- END DO
- END IF
- IF (N.LT.4) RETURN
- MP1 = M + 1
- DO I = MP1,N,4
- DY(I) = DY(I) + DA*DX(I)
- DY(I+1) = DY(I+1) + DA*DX(I+1)
- DY(I+2) = DY(I+2) + DA*DX(I+2)
- DY(I+3) = DY(I+3) + DA*DX(I+3)
- END DO
- ELSE
-*
-* code for unequal increments or equal increments
-* not equal to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- DY(IY) = DY(IY) + DA*DX(IX)
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/blas_src/dcopy.f b/mtx/blas_src/dcopy.f
deleted file mode 100644
index d9d5ac7aa..000000000
--- a/mtx/blas_src/dcopy.f
+++ /dev/null
@@ -1,115 +0,0 @@
-*> \brief \b DCOPY
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DCOPY(N,DX,INCX,DY,INCY)
-*
-* .. Scalar Arguments ..
-* INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION DX(*),DY(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DCOPY copies a vector, x, to a vector, y.
-*> uses unrolled loops for increments equal to one.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_blas_level1
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> jack dongarra, linpack, 3/11/78.
-*> modified 12/3/93, array(1) declarations changed to array(*)
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DCOPY(N,DX,INCX,DY,INCY)
-*
-* -- Reference BLAS level1 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*),DY(*)
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I,IX,IY,M,MP1
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,7)
- IF (M.NE.0) THEN
- DO I = 1,M
- DY(I) = DX(I)
- END DO
- IF (N.LT.7) RETURN
- END IF
- MP1 = M + 1
- DO I = MP1,N,7
- DY(I) = DX(I)
- DY(I+1) = DX(I+1)
- DY(I+2) = DX(I+2)
- DY(I+3) = DX(I+3)
- DY(I+4) = DX(I+4)
- DY(I+5) = DX(I+5)
- DY(I+6) = DX(I+6)
- END DO
- ELSE
-*
-* code for unequal increments or equal increments
-* not equal to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- DY(IY) = DX(IX)
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/blas_src/ddot.f b/mtx/blas_src/ddot.f
deleted file mode 100644
index cc0c1b7a4..000000000
--- a/mtx/blas_src/ddot.f
+++ /dev/null
@@ -1,117 +0,0 @@
-*> \brief \b DDOT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY)
-*
-* .. Scalar Arguments ..
-* INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION DX(*),DY(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DDOT forms the dot product of two vectors.
-*> uses unrolled loops for increments equal to one.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_blas_level1
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> jack dongarra, linpack, 3/11/78.
-*> modified 12/3/93, array(1) declarations changed to array(*)
-*> \endverbatim
-*>
-* =====================================================================
- DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY)
-*
-* -- Reference BLAS level1 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*),DY(*)
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION DTEMP
- INTEGER I,IX,IY,M,MP1
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- DDOT = 0.0d0
- DTEMP = 0.0d0
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,5)
- IF (M.NE.0) THEN
- DO I = 1,M
- DTEMP = DTEMP + DX(I)*DY(I)
- END DO
- IF (N.LT.5) THEN
- DDOT=DTEMP
- RETURN
- END IF
- END IF
- MP1 = M + 1
- DO I = MP1,N,5
- DTEMP = DTEMP + DX(I)*DY(I) + DX(I+1)*DY(I+1) +
- $ DX(I+2)*DY(I+2) + DX(I+3)*DY(I+3) + DX(I+4)*DY(I+4)
- END DO
- ELSE
-*
-* code for unequal increments or equal increments
-* not equal to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- DTEMP = DTEMP + DX(IX)*DY(IY)
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- DDOT = DTEMP
- RETURN
- END
diff --git a/mtx/blas_src/dgbmv.f b/mtx/blas_src/dgbmv.f
deleted file mode 100644
index 4a608bd6a..000000000
--- a/mtx/blas_src/dgbmv.f
+++ /dev/null
@@ -1,374 +0,0 @@
-*> \brief \b DGBMV
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION ALPHA,BETA
-* INTEGER INCX,INCY,KL,KU,LDA,M,N
-* CHARACTER TRANS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A(LDA,*),X(*),Y(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> On entry, TRANS specifies the operation to be performed as
-*> follows:
-*>
-*> TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
-*>
-*> TRANS = 'T' or 't' y := alpha*A**T*x + beta*y.
-*>
-*> TRANS = 'C' or 'c' y := alpha*A**T*x + beta*y.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the number of rows of the matrix A.
-*> M must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of the matrix A.
-*> N must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> On entry, KL specifies the number of sub-diagonals of the
-*> matrix A. KL must satisfy 0 .le. KL.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> On entry, KU specifies the number of super-diagonals of the
-*> matrix A. KU must satisfy 0 .le. KU.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION.
-*> On entry, ALPHA specifies the scalar alpha.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-*> Before entry, the leading ( kl + ku + 1 ) by n part of the
-*> array A must contain the matrix of coefficients, supplied
-*> column by column, with the leading diagonal of the matrix in
-*> row ( ku + 1 ) of the array, the first super-diagonal
-*> starting at position 2 in row ku, the first sub-diagonal
-*> starting at position 1 in row ( ku + 2 ), and so on.
-*> Elements in the array A that do not correspond to elements
-*> in the band matrix (such as the top left ku by ku triangle)
-*> are not referenced.
-*> The following program segment will transfer a band matrix
-*> from conventional full matrix storage to band storage:
-*>
-*> DO 20, J = 1, N
-*> K = KU + 1 - J
-*> DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
-*> A( K + I, J ) = matrix( I, J )
-*> 10 CONTINUE
-*> 20 CONTINUE
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. LDA must be at least
-*> ( kl + ku + 1 ).
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION array of DIMENSION at least
-*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
-*> and at least
-*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
-*> Before entry, the incremented array X must contain the
-*> vector x.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION.
-*> On entry, BETA specifies the scalar beta. When BETA is
-*> supplied as zero then Y need not be set on input.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array of DIMENSION at least
-*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
-*> and at least
-*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
-*> Before entry, the incremented array Y must contain the
-*> vector y. On exit, Y is overwritten by the updated vector y.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> On entry, INCY specifies the increment for the elements of
-*> Y. INCY must not be zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_blas_level2
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Level 2 Blas routine.
-*> The vector and matrix arguments are not referenced when N = 0, or M = 0
-*>
-*> -- Written on 22-October-1986.
-*> Jack Dongarra, Argonne National Lab.
-*> Jeremy Du Croz, Nag Central Office.
-*> Sven Hammarling, Nag Central Office.
-*> Richard Hanson, Sandia National Labs.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
-*
-* -- Reference BLAS level2 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA,BETA
- INTEGER INCX,INCY,KL,KU,LDA,M,N
- CHARACTER TRANS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*),Y(*)
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX,MIN
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 1
- ELSE IF (M.LT.0) THEN
- INFO = 2
- ELSE IF (N.LT.0) THEN
- INFO = 3
- ELSE IF (KL.LT.0) THEN
- INFO = 4
- ELSE IF (KU.LT.0) THEN
- INFO = 5
- ELSE IF (LDA.LT. (KL+KU+1)) THEN
- INFO = 8
- ELSE IF (INCX.EQ.0) THEN
- INFO = 10
- ELSE IF (INCY.EQ.0) THEN
- INFO = 13
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DGBMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
- + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
-* Set LENX and LENY, the lengths of the vectors x and y, and set
-* up the start points in X and Y.
-*
- IF (LSAME(TRANS,'N')) THEN
- LENX = N
- LENY = M
- ELSE
- LENX = M
- LENY = N
- END IF
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (LENX-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (LENY-1)*INCY
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through the band part of A.
-*
-* First form y := beta*y.
-*
- IF (BETA.NE.ONE) THEN
- IF (INCY.EQ.1) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 10 I = 1,LENY
- Y(I) = ZERO
- 10 CONTINUE
- ELSE
- DO 20 I = 1,LENY
- Y(I) = BETA*Y(I)
- 20 CONTINUE
- END IF
- ELSE
- IY = KY
- IF (BETA.EQ.ZERO) THEN
- DO 30 I = 1,LENY
- Y(IY) = ZERO
- IY = IY + INCY
- 30 CONTINUE
- ELSE
- DO 40 I = 1,LENY
- Y(IY) = BETA*Y(IY)
- IY = IY + INCY
- 40 CONTINUE
- END IF
- END IF
- END IF
- IF (ALPHA.EQ.ZERO) RETURN
- KUP1 = KU + 1
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form y := alpha*A*x + y.
-*
- JX = KX
- IF (INCY.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- K = KUP1 - J
- DO 50 I = MAX(1,J-KU),MIN(M,J+KL)
- Y(I) = Y(I) + TEMP*A(K+I,J)
- 50 CONTINUE
- END IF
- JX = JX + INCX
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- IY = KY
- K = KUP1 - J
- DO 70 I = MAX(1,J-KU),MIN(M,J+KL)
- Y(IY) = Y(IY) + TEMP*A(K+I,J)
- IY = IY + INCY
- 70 CONTINUE
- END IF
- JX = JX + INCX
- IF (J.GT.KU) KY = KY + INCY
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form y := alpha*A**T*x + y.
-*
- JY = KY
- IF (INCX.EQ.1) THEN
- DO 100 J = 1,N
- TEMP = ZERO
- K = KUP1 - J
- DO 90 I = MAX(1,J-KU),MIN(M,J+KL)
- TEMP = TEMP + A(K+I,J)*X(I)
- 90 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP
- JY = JY + INCY
- 100 CONTINUE
- ELSE
- DO 120 J = 1,N
- TEMP = ZERO
- IX = KX
- K = KUP1 - J
- DO 110 I = MAX(1,J-KU),MIN(M,J+KL)
- TEMP = TEMP + A(K+I,J)*X(IX)
- IX = IX + INCX
- 110 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP
- JY = JY + INCY
- IF (J.GT.KU) KX = KX + INCX
- 120 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DGBMV .
-*
- END
diff --git a/mtx/blas_src/dgemm.f b/mtx/blas_src/dgemm.f
deleted file mode 100644
index 45d001b7a..000000000
--- a/mtx/blas_src/dgemm.f
+++ /dev/null
@@ -1,388 +0,0 @@
-*> \brief \b DGEMM
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION ALPHA,BETA
-* INTEGER K,LDA,LDB,LDC,M,N
-* CHARACTER TRANSA,TRANSB
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSA
-*> \verbatim
-*> TRANSA is CHARACTER*1
-*> On entry, TRANSA specifies the form of op( A ) to be used in
-*> the matrix multiplication as follows:
-*>
-*> TRANSA = 'N' or 'n', op( A ) = A.
-*>
-*> TRANSA = 'T' or 't', op( A ) = A**T.
-*>
-*> TRANSA = 'C' or 'c', op( A ) = A**T.
-*> \endverbatim
-*>
-*> \param[in] TRANSB
-*> \verbatim
-*> TRANSB is CHARACTER*1
-*> On entry, TRANSB specifies the form of op( B ) to be used in
-*> the matrix multiplication as follows:
-*>
-*> TRANSB = 'N' or 'n', op( B ) = B.
-*>
-*> TRANSB = 'T' or 't', op( B ) = B**T.
-*>
-*> TRANSB = 'C' or 'c', op( B ) = B**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the number of rows of the matrix
-*> op( A ) and of the matrix C. M must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of the matrix
-*> op( B ) and the number of columns of the matrix C. N must be
-*> at least zero.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> On entry, K specifies the number of columns of the matrix
-*> op( A ) and the number of rows of the matrix op( B ). K must
-*> be at least zero.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION.
-*> On entry, ALPHA specifies the scalar alpha.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
-*> k when TRANSA = 'N' or 'n', and is m otherwise.
-*> Before entry with TRANSA = 'N' or 'n', the leading m by k
-*> part of the array A must contain the matrix A, otherwise
-*> the leading k by m part of the array A must contain the
-*> matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. When TRANSA = 'N' or 'n' then
-*> LDA must be at least max( 1, m ), otherwise LDA must be at
-*> least max( 1, k ).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
-*> n when TRANSB = 'N' or 'n', and is k otherwise.
-*> Before entry with TRANSB = 'N' or 'n', the leading k by n
-*> part of the array B must contain the matrix B, otherwise
-*> the leading n by k part of the array B must contain the
-*> matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> On entry, LDB specifies the first dimension of B as declared
-*> in the calling (sub) program. When TRANSB = 'N' or 'n' then
-*> LDB must be at least max( 1, k ), otherwise LDB must be at
-*> least max( 1, n ).
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION.
-*> On entry, BETA specifies the scalar beta. When BETA is
-*> supplied as zero then C need not be set on input.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array of DIMENSION ( LDC, n ).
-*> Before entry, the leading m by n part of the array C must
-*> contain the matrix C, except when beta is zero, in which
-*> case C need not be set on entry.
-*> On exit, the array C is overwritten by the m by n matrix
-*> ( alpha*op( A )*op( B ) + beta*C ).
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> On entry, LDC specifies the first dimension of C as declared
-*> in the calling (sub) program. LDC must be at least
-*> max( 1, m ).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_blas_level3
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Level 3 Blas routine.
-*>
-*> -- Written on 8-February-1989.
-*> Jack Dongarra, Argonne National Laboratory.
-*> Iain Duff, AERE Harwell.
-*> Jeremy Du Croz, Numerical Algorithms Group Ltd.
-*> Sven Hammarling, Numerical Algorithms Group Ltd.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
-*
-* -- Reference BLAS level3 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA,BETA
- INTEGER K,LDA,LDB,LDC,M,N
- CHARACTER TRANSA,TRANSB
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*)
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB
- LOGICAL NOTA,NOTB
-* ..
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-*
-* Set NOTA and NOTB as true if A and B respectively are not
-* transposed and set NROWA, NCOLA and NROWB as the number of rows
-* and columns of A and the number of rows of B respectively.
-*
- NOTA = LSAME(TRANSA,'N')
- NOTB = LSAME(TRANSB,'N')
- IF (NOTA) THEN
- NROWA = M
- NCOLA = K
- ELSE
- NROWA = K
- NCOLA = M
- END IF
- IF (NOTB) THEN
- NROWB = K
- ELSE
- NROWB = N
- END IF
-*
-* Test the input parameters.
-*
- INFO = 0
- IF ((.NOT.NOTA) .AND. (.NOT.LSAME(TRANSA,'C')) .AND.
- + (.NOT.LSAME(TRANSA,'T'))) THEN
- INFO = 1
- ELSE IF ((.NOT.NOTB) .AND. (.NOT.LSAME(TRANSB,'C')) .AND.
- + (.NOT.LSAME(TRANSB,'T'))) THEN
- INFO = 2
- ELSE IF (M.LT.0) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (K.LT.0) THEN
- INFO = 5
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 8
- ELSE IF (LDB.LT.MAX(1,NROWB)) THEN
- INFO = 10
- ELSE IF (LDC.LT.MAX(1,M)) THEN
- INFO = 13
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DGEMM ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
- + (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
-*
-* And if alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,M
- C(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- DO 30 I = 1,M
- C(I,J) = BETA*C(I,J)
- 30 CONTINUE
- 40 CONTINUE
- END IF
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (NOTB) THEN
- IF (NOTA) THEN
-*
-* Form C := alpha*A*B + beta*C.
-*
- DO 90 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 50 I = 1,M
- C(I,J) = ZERO
- 50 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 60 I = 1,M
- C(I,J) = BETA*C(I,J)
- 60 CONTINUE
- END IF
- DO 80 L = 1,K
- IF (B(L,J).NE.ZERO) THEN
- TEMP = ALPHA*B(L,J)
- DO 70 I = 1,M
- C(I,J) = C(I,J) + TEMP*A(I,L)
- 70 CONTINUE
- END IF
- 80 CONTINUE
- 90 CONTINUE
- ELSE
-*
-* Form C := alpha*A**T*B + beta*C
-*
- DO 120 J = 1,N
- DO 110 I = 1,M
- TEMP = ZERO
- DO 100 L = 1,K
- TEMP = TEMP + A(L,I)*B(L,J)
- 100 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 110 CONTINUE
- 120 CONTINUE
- END IF
- ELSE
- IF (NOTA) THEN
-*
-* Form C := alpha*A*B**T + beta*C
-*
- DO 170 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 130 I = 1,M
- C(I,J) = ZERO
- 130 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 140 I = 1,M
- C(I,J) = BETA*C(I,J)
- 140 CONTINUE
- END IF
- DO 160 L = 1,K
- IF (B(J,L).NE.ZERO) THEN
- TEMP = ALPHA*B(J,L)
- DO 150 I = 1,M
- C(I,J) = C(I,J) + TEMP*A(I,L)
- 150 CONTINUE
- END IF
- 160 CONTINUE
- 170 CONTINUE
- ELSE
-*
-* Form C := alpha*A**T*B**T + beta*C
-*
- DO 200 J = 1,N
- DO 190 I = 1,M
- TEMP = ZERO
- DO 180 L = 1,K
- TEMP = TEMP + A(L,I)*B(J,L)
- 180 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 190 CONTINUE
- 200 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DGEMM .
-*
- END
diff --git a/mtx/blas_src/dgemv.f b/mtx/blas_src/dgemv.f
deleted file mode 100644
index 675257fac..000000000
--- a/mtx/blas_src/dgemv.f
+++ /dev/null
@@ -1,334 +0,0 @@
-*> \brief \b DGEMV
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION ALPHA,BETA
-* INTEGER INCX,INCY,LDA,M,N
-* CHARACTER TRANS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A(LDA,*),X(*),Y(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> On entry, TRANS specifies the operation to be performed as
-*> follows:
-*>
-*> TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
-*>
-*> TRANS = 'T' or 't' y := alpha*A**T*x + beta*y.
-*>
-*> TRANS = 'C' or 'c' y := alpha*A**T*x + beta*y.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the number of rows of the matrix A.
-*> M must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of the matrix A.
-*> N must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION.
-*> On entry, ALPHA specifies the scalar alpha.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-*> Before entry, the leading m by n part of the array A must
-*> contain the matrix of coefficients.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. LDA must be at least
-*> max( 1, m ).
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION array of DIMENSION at least
-*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
-*> and at least
-*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
-*> Before entry, the incremented array X must contain the
-*> vector x.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION.
-*> On entry, BETA specifies the scalar beta. When BETA is
-*> supplied as zero then Y need not be set on input.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array of DIMENSION at least
-*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
-*> and at least
-*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
-*> Before entry with BETA non-zero, the incremented array Y
-*> must contain the vector y. On exit, Y is overwritten by the
-*> updated vector y.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> On entry, INCY specifies the increment for the elements of
-*> Y. INCY must not be zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_blas_level2
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Level 2 Blas routine.
-*> The vector and matrix arguments are not referenced when N = 0, or M = 0
-*>
-*> -- Written on 22-October-1986.
-*> Jack Dongarra, Argonne National Lab.
-*> Jeremy Du Croz, Nag Central Office.
-*> Sven Hammarling, Nag Central Office.
-*> Richard Hanson, Sandia National Labs.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
-*
-* -- Reference BLAS level2 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA,BETA
- INTEGER INCX,INCY,LDA,M,N
- CHARACTER TRANS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*),Y(*)
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 1
- ELSE IF (M.LT.0) THEN
- INFO = 2
- ELSE IF (N.LT.0) THEN
- INFO = 3
- ELSE IF (LDA.LT.MAX(1,M)) THEN
- INFO = 6
- ELSE IF (INCX.EQ.0) THEN
- INFO = 8
- ELSE IF (INCY.EQ.0) THEN
- INFO = 11
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DGEMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
- + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
-* Set LENX and LENY, the lengths of the vectors x and y, and set
-* up the start points in X and Y.
-*
- IF (LSAME(TRANS,'N')) THEN
- LENX = N
- LENY = M
- ELSE
- LENX = M
- LENY = N
- END IF
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (LENX-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (LENY-1)*INCY
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
-* First form y := beta*y.
-*
- IF (BETA.NE.ONE) THEN
- IF (INCY.EQ.1) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 10 I = 1,LENY
- Y(I) = ZERO
- 10 CONTINUE
- ELSE
- DO 20 I = 1,LENY
- Y(I) = BETA*Y(I)
- 20 CONTINUE
- END IF
- ELSE
- IY = KY
- IF (BETA.EQ.ZERO) THEN
- DO 30 I = 1,LENY
- Y(IY) = ZERO
- IY = IY + INCY
- 30 CONTINUE
- ELSE
- DO 40 I = 1,LENY
- Y(IY) = BETA*Y(IY)
- IY = IY + INCY
- 40 CONTINUE
- END IF
- END IF
- END IF
- IF (ALPHA.EQ.ZERO) RETURN
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form y := alpha*A*x + y.
-*
- JX = KX
- IF (INCY.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- DO 50 I = 1,M
- Y(I) = Y(I) + TEMP*A(I,J)
- 50 CONTINUE
- END IF
- JX = JX + INCX
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- IY = KY
- DO 70 I = 1,M
- Y(IY) = Y(IY) + TEMP*A(I,J)
- IY = IY + INCY
- 70 CONTINUE
- END IF
- JX = JX + INCX
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form y := alpha*A**T*x + y.
-*
- JY = KY
- IF (INCX.EQ.1) THEN
- DO 100 J = 1,N
- TEMP = ZERO
- DO 90 I = 1,M
- TEMP = TEMP + A(I,J)*X(I)
- 90 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP
- JY = JY + INCY
- 100 CONTINUE
- ELSE
- DO 120 J = 1,N
- TEMP = ZERO
- IX = KX
- DO 110 I = 1,M
- TEMP = TEMP + A(I,J)*X(IX)
- IX = IX + INCX
- 110 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP
- JY = JY + INCY
- 120 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DGEMV .
-*
- END
diff --git a/mtx/blas_src/dger.f b/mtx/blas_src/dger.f
deleted file mode 100644
index a04248370..000000000
--- a/mtx/blas_src/dger.f
+++ /dev/null
@@ -1,227 +0,0 @@
-*> \brief \b DGER
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION ALPHA
-* INTEGER INCX,INCY,LDA,M,N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A(LDA,*),X(*),Y(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the number of rows of the matrix A.
-*> M must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of the matrix A.
-*> N must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION.
-*> On entry, ALPHA specifies the scalar alpha.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
-*> ( 1 + ( m - 1 )*abs( INCX ) ).
-*> Before entry, the incremented array X must contain the m
-*> element vector x.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*> \endverbatim
-*>
-*> \param[in] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array of dimension at least
-*> ( 1 + ( n - 1 )*abs( INCY ) ).
-*> Before entry, the incremented array Y must contain the n
-*> element vector y.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> On entry, INCY specifies the increment for the elements of
-*> Y. INCY must not be zero.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-*> Before entry, the leading m by n part of the array A must
-*> contain the matrix of coefficients. On exit, A is
-*> overwritten by the updated matrix.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. LDA must be at least
-*> max( 1, m ).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_blas_level2
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Level 2 Blas routine.
-*>
-*> -- Written on 22-October-1986.
-*> Jack Dongarra, Argonne National Lab.
-*> Jeremy Du Croz, Nag Central Office.
-*> Sven Hammarling, Nag Central Office.
-*> Richard Hanson, Sandia National Labs.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
-*
-* -- Reference BLAS level2 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA
- INTEGER INCX,INCY,LDA,M,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*),Y(*)
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER (ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,J,JY,KX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (M.LT.0) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 5
- ELSE IF (INCY.EQ.0) THEN
- INFO = 7
- ELSE IF (LDA.LT.MAX(1,M)) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DGER ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
- IF (INCY.GT.0) THEN
- JY = 1
- ELSE
- JY = 1 - (N-1)*INCY
- END IF
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (Y(JY).NE.ZERO) THEN
- TEMP = ALPHA*Y(JY)
- DO 10 I = 1,M
- A(I,J) = A(I,J) + X(I)*TEMP
- 10 CONTINUE
- END IF
- JY = JY + INCY
- 20 CONTINUE
- ELSE
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (M-1)*INCX
- END IF
- DO 40 J = 1,N
- IF (Y(JY).NE.ZERO) THEN
- TEMP = ALPHA*Y(JY)
- IX = KX
- DO 30 I = 1,M
- A(I,J) = A(I,J) + X(IX)*TEMP
- IX = IX + INCX
- 30 CONTINUE
- END IF
- JY = JY + INCY
- 40 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DGER .
-*
- END
diff --git a/mtx/blas_src/dlamch.f b/mtx/blas_src/dlamch.f
deleted file mode 100644
index 64ac3becd..000000000
--- a/mtx/blas_src/dlamch.f
+++ /dev/null
@@ -1,857 +0,0 @@
- DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
-*
-* -- LAPACK auxiliary routine (version 3.0) --
-* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
-*
-* .. Scalar Arguments ..
- CHARACTER CMACH
-* ..
-*
-* Purpose
-* =======
-*
-* DLAMCH determines double precision machine parameters.
-*
-* Arguments
-* =========
-*
-* CMACH (input) CHARACTER*1
-* Specifies the value to be returned by DLAMCH:
-* = 'E' or 'e', DLAMCH := eps
-* = 'S' or 's , DLAMCH := sfmin
-* = 'B' or 'b', DLAMCH := base
-* = 'P' or 'p', DLAMCH := eps*base
-* = 'N' or 'n', DLAMCH := t
-* = 'R' or 'r', DLAMCH := rnd
-* = 'M' or 'm', DLAMCH := emin
-* = 'U' or 'u', DLAMCH := rmin
-* = 'L' or 'l', DLAMCH := emax
-* = 'O' or 'o', DLAMCH := rmax
-*
-* where
-*
-* eps = relative machine precision
-* sfmin = safe minimum, such that 1/sfmin does not overflow
-* base = base of the machine
-* prec = eps*base
-* t = number of (base) digits in the mantissa
-* rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
-* emin = minimum exponent before (gradual) underflow
-* rmin = underflow threshold - base**(emin-1)
-* emax = largest exponent before overflow
-* rmax = overflow threshold - (base**emax)*(1-eps)
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL FIRST, LRND
- INTEGER BETA, IMAX, IMIN, IT
- DOUBLE PRECISION BASE, EMAX, EMIN, EPS, PREC, RMACH, RMAX, RMIN,
- $ RND, SFMIN, SMALL, T
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAMC2
-* ..
-* .. Save statement ..
- SAVE FIRST, EPS, SFMIN, BASE, T, RND, EMIN, RMIN,
- $ EMAX, RMAX, PREC
-* ..
-* .. Data statements ..
- DATA FIRST / .TRUE. /
-* ..
-* .. Executable Statements ..
-*
- IF( FIRST ) THEN
- FIRST = .FALSE.
- CALL DLAMC2( BETA, IT, LRND, EPS, IMIN, RMIN, IMAX, RMAX )
- BASE = BETA
- T = IT
- IF( LRND ) THEN
- RND = ONE
- EPS = ( BASE**( 1-IT ) ) / 2
- ELSE
- RND = ZERO
- EPS = BASE**( 1-IT )
- END IF
- PREC = EPS*BASE
- EMIN = IMIN
- EMAX = IMAX
- SFMIN = RMIN
- SMALL = ONE / RMAX
- IF( SMALL.GE.SFMIN ) THEN
-*
-* Use SMALL plus a bit, to avoid the possibility of rounding
-* causing overflow when computing 1/sfmin.
-*
- SFMIN = SMALL*( ONE+EPS )
- END IF
- END IF
-*
- IF( LSAME( CMACH, 'E' ) ) THEN
- RMACH = EPS
- ELSE IF( LSAME( CMACH, 'S' ) ) THEN
- RMACH = SFMIN
- ELSE IF( LSAME( CMACH, 'B' ) ) THEN
- RMACH = BASE
- ELSE IF( LSAME( CMACH, 'P' ) ) THEN
- RMACH = PREC
- ELSE IF( LSAME( CMACH, 'N' ) ) THEN
- RMACH = T
- ELSE IF( LSAME( CMACH, 'R' ) ) THEN
- RMACH = RND
- ELSE IF( LSAME( CMACH, 'M' ) ) THEN
- RMACH = EMIN
- ELSE IF( LSAME( CMACH, 'U' ) ) THEN
- RMACH = RMIN
- ELSE IF( LSAME( CMACH, 'L' ) ) THEN
- RMACH = EMAX
- ELSE IF( LSAME( CMACH, 'O' ) ) THEN
- RMACH = RMAX
- END IF
-*
- DLAMCH = RMACH
- RETURN
-*
-* End of DLAMCH
-*
- END
-*
-************************************************************************
-*
- SUBROUTINE DLAMC1( BETA, T, RND, IEEE1 )
-*
-* -- LAPACK auxiliary routine (version 3.0) --
-* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
-*
-* .. Scalar Arguments ..
- LOGICAL IEEE1, RND
- INTEGER BETA, T
-* ..
-*
-* Purpose
-* =======
-*
-* DLAMC1 determines the machine parameters given by BETA, T, RND, and
-* IEEE1.
-*
-* Arguments
-* =========
-*
-* BETA (output) INTEGER
-* The base of the machine.
-*
-* T (output) INTEGER
-* The number of ( BETA ) digits in the mantissa.
-*
-* RND (output) LOGICAL
-* Specifies whether proper rounding ( RND = .TRUE. ) or
-* chopping ( RND = .FALSE. ) occurs in addition. This may not
-* be a reliable guide to the way in which the machine performs
-* its arithmetic.
-*
-* IEEE1 (output) LOGICAL
-* Specifies whether rounding appears to be done in the IEEE
-* 'round to nearest' style.
-*
-* Further Details
-* ===============
-*
-* The routine is based on the routine ENVRON by Malcolm and
-* incorporates suggestions by Gentleman and Marovich. See
-*
-* Malcolm M. A. (1972) Algorithms to reveal properties of
-* floating-point arithmetic. Comms. of the ACM, 15, 949-951.
-*
-* Gentleman W. M. and Marovich S. B. (1974) More on algorithms
-* that reveal properties of floating point arithmetic units.
-* Comms. of the ACM, 17, 276-277.
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL FIRST, LIEEE1, LRND
- INTEGER LBETA, LT
- DOUBLE PRECISION A, B, C, F, ONE, QTR, SAVEC, T1, T2
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMC3
- EXTERNAL DLAMC3
-* ..
-* .. Save statement ..
- SAVE FIRST, LIEEE1, LBETA, LRND, LT
-* ..
-* .. Data statements ..
- DATA FIRST / .TRUE. /
-* ..
-* .. Executable Statements ..
-*
- IF( FIRST ) THEN
- FIRST = .FALSE.
- ONE = 1
-*
-* LBETA, LIEEE1, LT and LRND are the local values of BETA,
-* IEEE1, T and RND.
-*
-* Throughout this routine we use the function DLAMC3 to ensure
-* that relevant values are stored and not held in registers, or
-* are not affected by optimizers.
-*
-* Compute a = 2.0**m with the smallest positive integer m such
-* that
-*
-* fl( a + 1.0 ) = a.
-*
- A = 1
- C = 1
-*
-*+ WHILE( C.EQ.ONE )LOOP
- 10 CONTINUE
- IF( C.EQ.ONE ) THEN
- A = 2*A
- C = DLAMC3( A, ONE )
- C = DLAMC3( C, -A )
- GO TO 10
- END IF
-*+ END WHILE
-*
-* Now compute b = 2.0**m with the smallest positive integer m
-* such that
-*
-* fl( a + b ) .gt. a.
-*
- B = 1
- C = DLAMC3( A, B )
-*
-*+ WHILE( C.EQ.A )LOOP
- 20 CONTINUE
- IF( C.EQ.A ) THEN
- B = 2*B
- C = DLAMC3( A, B )
- GO TO 20
- END IF
-*+ END WHILE
-*
-* Now compute the base. a and c are neighbouring floating point
-* numbers in the interval ( beta**t, beta**( t + 1 ) ) and so
-* their difference is beta. Adding 0.25 to c is to ensure that it
-* is truncated to beta and not ( beta - 1 ).
-*
- QTR = ONE / 4
- SAVEC = C
- C = DLAMC3( C, -A )
- LBETA = C + QTR
-*
-* Now determine whether rounding or chopping occurs, by adding a
-* bit less than beta/2 and a bit more than beta/2 to a.
-*
- B = LBETA
- F = DLAMC3( B / 2, -B / 100 )
- C = DLAMC3( F, A )
- IF( C.EQ.A ) THEN
- LRND = .TRUE.
- ELSE
- LRND = .FALSE.
- END IF
- F = DLAMC3( B / 2, B / 100 )
- C = DLAMC3( F, A )
- IF( ( LRND ) .AND. ( C.EQ.A ) )
- $ LRND = .FALSE.
-*
-* Try and decide whether rounding is done in the IEEE 'round to
-* nearest' style. B/2 is half a unit in the last place of the two
-* numbers A and SAVEC. Furthermore, A is even, i.e. has last bit
-* zero, and SAVEC is odd. Thus adding B/2 to A should not change
-* A, but adding B/2 to SAVEC should change SAVEC.
-*
- T1 = DLAMC3( B / 2, A )
- T2 = DLAMC3( B / 2, SAVEC )
- LIEEE1 = ( T1.EQ.A ) .AND. ( T2.GT.SAVEC ) .AND. LRND
-*
-* Now find the mantissa, t. It should be the integer part of
-* log to the base beta of a, however it is safer to determine t
-* by powering. So we find t as the smallest positive integer for
-* which
-*
-* fl( beta**t + 1.0 ) = 1.0.
-*
- LT = 0
- A = 1
- C = 1
-*
-*+ WHILE( C.EQ.ONE )LOOP
- 30 CONTINUE
- IF( C.EQ.ONE ) THEN
- LT = LT + 1
- A = A*LBETA
- C = DLAMC3( A, ONE )
- C = DLAMC3( C, -A )
- GO TO 30
- END IF
-*+ END WHILE
-*
- END IF
-*
- BETA = LBETA
- T = LT
- RND = LRND
- IEEE1 = LIEEE1
- RETURN
-*
-* End of DLAMC1
-*
- END
-*
-************************************************************************
-*
- SUBROUTINE DLAMC2( BETA, T, RND, EPS, EMIN, RMIN, EMAX, RMAX )
-*
-* -- LAPACK auxiliary routine (version 3.0) --
-* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
-*
-* .. Scalar Arguments ..
- LOGICAL RND
- INTEGER BETA, EMAX, EMIN, T
- DOUBLE PRECISION EPS, RMAX, RMIN
-* ..
-*
-* Purpose
-* =======
-*
-* DLAMC2 determines the machine parameters specified in its argument
-* list.
-*
-* Arguments
-* =========
-*
-* BETA (output) INTEGER
-* The base of the machine.
-*
-* T (output) INTEGER
-* The number of ( BETA ) digits in the mantissa.
-*
-* RND (output) LOGICAL
-* Specifies whether proper rounding ( RND = .TRUE. ) or
-* chopping ( RND = .FALSE. ) occurs in addition. This may not
-* be a reliable guide to the way in which the machine performs
-* its arithmetic.
-*
-* EPS (output) DOUBLE PRECISION
-* The smallest positive number such that
-*
-* fl( 1.0 - EPS ) .LT. 1.0,
-*
-* where fl denotes the computed value.
-*
-* EMIN (output) INTEGER
-* The minimum exponent before (gradual) underflow occurs.
-*
-* RMIN (output) DOUBLE PRECISION
-* The smallest normalized number for the machine, given by
-* BASE**( EMIN - 1 ), where BASE is the floating point value
-* of BETA.
-*
-* EMAX (output) INTEGER
-* The maximum exponent before overflow occurs.
-*
-* RMAX (output) DOUBLE PRECISION
-* The largest positive number for the machine, given by
-* BASE**EMAX * ( 1 - EPS ), where BASE is the floating point
-* value of BETA.
-*
-* Further Details
-* ===============
-*
-* The computation of EPS is based on a routine PARANOIA by
-* W. Kahan of the University of California at Berkeley.
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL FIRST, IEEE, IWARN, LIEEE1, LRND
- INTEGER GNMIN, GPMIN, I, LBETA, LEMAX, LEMIN, LT,
- $ NGNMIN, NGPMIN
- DOUBLE PRECISION A, B, C, HALF, LEPS, LRMAX, LRMIN, ONE, RBASE,
- $ SIXTH, SMALL, THIRD, TWO, ZERO
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMC3
- EXTERNAL DLAMC3
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAMC1, DLAMC4, DLAMC5
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Save statement ..
- SAVE FIRST, IWARN, LBETA, LEMAX, LEMIN, LEPS, LRMAX,
- $ LRMIN, LT
-* ..
-* .. Data statements ..
- DATA FIRST / .TRUE. / , IWARN / .FALSE. /
-* ..
-* .. Executable Statements ..
-*
- IF( FIRST ) THEN
- FIRST = .FALSE.
- ZERO = 0
- ONE = 1
- TWO = 2
-*
-* LBETA, LT, LRND, LEPS, LEMIN and LRMIN are the local values of
-* BETA, T, RND, EPS, EMIN and RMIN.
-*
-* Throughout this routine we use the function DLAMC3 to ensure
-* that relevant values are stored and not held in registers, or
-* are not affected by optimizers.
-*
-* DLAMC1 returns the parameters LBETA, LT, LRND and LIEEE1.
-*
- CALL DLAMC1( LBETA, LT, LRND, LIEEE1 )
-*
-* Start to find EPS.
-*
- B = LBETA
- A = B**( -LT )
- LEPS = A
-*
-* Try some tricks to see whether or not this is the correct EPS.
-*
- B = TWO / 3
- HALF = ONE / 2
- SIXTH = DLAMC3( B, -HALF )
- THIRD = DLAMC3( SIXTH, SIXTH )
- B = DLAMC3( THIRD, -HALF )
- B = DLAMC3( B, SIXTH )
- B = ABS( B )
- IF( B.LT.LEPS )
- $ B = LEPS
-*
- LEPS = 1
-*
-*+ WHILE( ( LEPS.GT.B ).AND.( B.GT.ZERO ) )LOOP
- 10 CONTINUE
- IF( ( LEPS.GT.B ) .AND. ( B.GT.ZERO ) ) THEN
- LEPS = B
- C = DLAMC3( HALF*LEPS, ( TWO**5 )*( LEPS**2 ) )
- C = DLAMC3( HALF, -C )
- B = DLAMC3( HALF, C )
- C = DLAMC3( HALF, -B )
- B = DLAMC3( HALF, C )
- GO TO 10
- END IF
-*+ END WHILE
-*
- IF( A.LT.LEPS )
- $ LEPS = A
-*
-* Computation of EPS complete.
-*
-* Now find EMIN. Let A = + or - 1, and + or - (1 + BASE**(-3)).
-* Keep dividing A by BETA until (gradual) underflow occurs. This
-* is detected when we cannot recover the previous A.
-*
- RBASE = ONE / LBETA
- SMALL = ONE
- DO 20 I = 1, 3
- SMALL = DLAMC3( SMALL*RBASE, ZERO )
- 20 CONTINUE
- A = DLAMC3( ONE, SMALL )
- CALL DLAMC4( NGPMIN, ONE, LBETA )
- CALL DLAMC4( NGNMIN, -ONE, LBETA )
- CALL DLAMC4( GPMIN, A, LBETA )
- CALL DLAMC4( GNMIN, -A, LBETA )
- IEEE = .FALSE.
-*
- IF( ( NGPMIN.EQ.NGNMIN ) .AND. ( GPMIN.EQ.GNMIN ) ) THEN
- IF( NGPMIN.EQ.GPMIN ) THEN
- LEMIN = NGPMIN
-* ( Non twos-complement machines, no gradual underflow;
-* e.g., VAX )
- ELSE IF( ( GPMIN-NGPMIN ).EQ.3 ) THEN
- LEMIN = NGPMIN - 1 + LT
- IEEE = .TRUE.
-* ( Non twos-complement machines, with gradual underflow;
-* e.g., IEEE standard followers )
- ELSE
- LEMIN = MIN( NGPMIN, GPMIN )
-* ( A guess; no known machine )
- IWARN = .TRUE.
- END IF
-*
- ELSE IF( ( NGPMIN.EQ.GPMIN ) .AND. ( NGNMIN.EQ.GNMIN ) ) THEN
- IF( ABS( NGPMIN-NGNMIN ).EQ.1 ) THEN
- LEMIN = MAX( NGPMIN, NGNMIN )
-* ( Twos-complement machines, no gradual underflow;
-* e.g., CYBER 205 )
- ELSE
- LEMIN = MIN( NGPMIN, NGNMIN )
-* ( A guess; no known machine )
- IWARN = .TRUE.
- END IF
-*
- ELSE IF( ( ABS( NGPMIN-NGNMIN ).EQ.1 ) .AND.
- $ ( GPMIN.EQ.GNMIN ) ) THEN
- IF( ( GPMIN-MIN( NGPMIN, NGNMIN ) ).EQ.3 ) THEN
- LEMIN = MAX( NGPMIN, NGNMIN ) - 1 + LT
-* ( Twos-complement machines with gradual underflow;
-* no known machine )
- ELSE
- LEMIN = MIN( NGPMIN, NGNMIN )
-* ( A guess; no known machine )
- IWARN = .TRUE.
- END IF
-*
- ELSE
- LEMIN = MIN( NGPMIN, NGNMIN, GPMIN, GNMIN )
-* ( A guess; no known machine )
- IWARN = .TRUE.
- END IF
-***
-* Comment out this if block if EMIN is ok
- IF( IWARN ) THEN
- FIRST = .TRUE.
- WRITE( 6, FMT = 9999 )LEMIN
- END IF
-***
-*
-* Assume IEEE arithmetic if we found denormalised numbers above,
-* or if arithmetic seems to round in the IEEE style, determined
-* in routine DLAMC1. A true IEEE machine should have both things
-* true; however, faulty machines may have one or the other.
-*
- IEEE = IEEE .OR. LIEEE1
-*
-* Compute RMIN by successive division by BETA. We could compute
-* RMIN as BASE**( EMIN - 1 ), but some machines underflow during
-* this computation.
-*
- LRMIN = 1
- DO 30 I = 1, 1 - LEMIN
- LRMIN = DLAMC3( LRMIN*RBASE, ZERO )
- 30 CONTINUE
-*
-* Finally, call DLAMC5 to compute EMAX and RMAX.
-*
- CALL DLAMC5( LBETA, LT, LEMIN, IEEE, LEMAX, LRMAX )
- END IF
-*
- BETA = LBETA
- T = LT
- RND = LRND
- EPS = LEPS
- EMIN = LEMIN
- RMIN = LRMIN
- EMAX = LEMAX
- RMAX = LRMAX
-*
- RETURN
-*
- 9999 FORMAT( / / ' WARNING. The value EMIN may be incorrect:-',
- $ ' EMIN = ', I8, /
- $ ' If, after inspection, the value EMIN looks',
- $ ' acceptable please comment out ',
- $ / ' the IF block as marked within the code of routine',
- $ ' DLAMC2,', / ' otherwise supply EMIN explicitly.', / )
-*
-* End of DLAMC2
-*
- END
-*
-************************************************************************
-*
- DOUBLE PRECISION FUNCTION DLAMC3( A, B )
-*
-* -- LAPACK auxiliary routine (version 3.0) --
-* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION A, B
-* ..
-*
-* Purpose
-* =======
-*
-* DLAMC3 is intended to force A and B to be stored prior to doing
-* the addition of A and B , for use in situations where optimizers
-* might hold one of these in a register.
-*
-* Arguments
-* =========
-*
-* A, B (input) DOUBLE PRECISION
-* The values A and B.
-*
-* =====================================================================
-*
-* .. Executable Statements ..
-*
- DLAMC3 = A + B
-*
- RETURN
-*
-* End of DLAMC3
-*
- END
-*
-************************************************************************
-*
- SUBROUTINE DLAMC4( EMIN, START, BASE )
-*
-* -- LAPACK auxiliary routine (version 3.0) --
-* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
-*
-* .. Scalar Arguments ..
- INTEGER BASE, EMIN
- DOUBLE PRECISION START
-* ..
-*
-* Purpose
-* =======
-*
-* DLAMC4 is a service routine for DLAMC2.
-*
-* Arguments
-* =========
-*
-* EMIN (output) EMIN
-* The minimum exponent before (gradual) underflow, computed by
-* setting A = START and dividing by BASE until the previous A
-* can not be recovered.
-*
-* START (input) DOUBLE PRECISION
-* The starting point for determining EMIN.
-*
-* BASE (input) INTEGER
-* The base of the machine.
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION A, B1, B2, C1, C2, D1, D2, ONE, RBASE, ZERO
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMC3
- EXTERNAL DLAMC3
-* ..
-* .. Executable Statements ..
-*
- A = START
- ONE = 1
- RBASE = ONE / BASE
- ZERO = 0
- EMIN = 1
- B1 = DLAMC3( A*RBASE, ZERO )
- C1 = A
- C2 = A
- D1 = A
- D2 = A
-*+ WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND.
-* $ ( D1.EQ.A ).AND.( D2.EQ.A ) )LOOP
- 10 CONTINUE
- IF( ( C1.EQ.A ) .AND. ( C2.EQ.A ) .AND. ( D1.EQ.A ) .AND.
- $ ( D2.EQ.A ) ) THEN
- EMIN = EMIN - 1
- A = B1
- B1 = DLAMC3( A / BASE, ZERO )
- C1 = DLAMC3( B1*BASE, ZERO )
- D1 = ZERO
- DO 20 I = 1, BASE
- D1 = D1 + B1
- 20 CONTINUE
- B2 = DLAMC3( A*RBASE, ZERO )
- C2 = DLAMC3( B2 / RBASE, ZERO )
- D2 = ZERO
- DO 30 I = 1, BASE
- D2 = D2 + B2
- 30 CONTINUE
- GO TO 10
- END IF
-*+ END WHILE
-*
- RETURN
-*
-* End of DLAMC4
-*
- END
-*
-************************************************************************
-*
- SUBROUTINE DLAMC5( BETA, P, EMIN, IEEE, EMAX, RMAX )
-*
-* -- LAPACK auxiliary routine (version 3.0) --
-* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
-*
-* .. Scalar Arguments ..
- LOGICAL IEEE
- INTEGER BETA, EMAX, EMIN, P
- DOUBLE PRECISION RMAX
-* ..
-*
-* Purpose
-* =======
-*
-* DLAMC5 attempts to compute RMAX, the largest machine floating-point
-* number, without overflow. It assumes that EMAX + abs(EMIN) sum
-* approximately to a power of 2. It will fail on machines where this
-* assumption does not hold, for example, the Cyber 205 (EMIN = -28625,
-* EMAX = 28718). It will also fail if the value supplied for EMIN is
-* too large (i.e. too close to zero), probably with overflow.
-*
-* Arguments
-* =========
-*
-* BETA (input) INTEGER
-* The base of floating-point arithmetic.
-*
-* P (input) INTEGER
-* The number of base BETA digits in the mantissa of a
-* floating-point value.
-*
-* EMIN (input) INTEGER
-* The minimum exponent before (gradual) underflow.
-*
-* IEEE (input) LOGICAL
-* A logical flag specifying whether or not the arithmetic
-* system is thought to comply with the IEEE standard.
-*
-* EMAX (output) INTEGER
-* The largest exponent before overflow
-*
-* RMAX (output) DOUBLE PRECISION
-* The largest machine floating-point number.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER EXBITS, EXPSUM, I, LEXP, NBITS, TRY, UEXP
- DOUBLE PRECISION OLDY, RECBAS, Y, Z
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMC3
- EXTERNAL DLAMC3
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
-* .. Executable Statements ..
-*
-* First compute LEXP and UEXP, two powers of 2 that bound
-* abs(EMIN). We then assume that EMAX + abs(EMIN) will sum
-* approximately to the bound that is closest to abs(EMIN).
-* (EMAX is the exponent of the required number RMAX).
-*
- LEXP = 1
- EXBITS = 1
- 10 CONTINUE
- TRY = LEXP*2
- IF( TRY.LE.( -EMIN ) ) THEN
- LEXP = TRY
- EXBITS = EXBITS + 1
- GO TO 10
- END IF
- IF( LEXP.EQ.-EMIN ) THEN
- UEXP = LEXP
- ELSE
- UEXP = TRY
- EXBITS = EXBITS + 1
- END IF
-*
-* Now -LEXP is less than or equal to EMIN, and -UEXP is greater
-* than or equal to EMIN. EXBITS is the number of bits needed to
-* store the exponent.
-*
- IF( ( UEXP+EMIN ).GT.( -LEXP-EMIN ) ) THEN
- EXPSUM = 2*LEXP
- ELSE
- EXPSUM = 2*UEXP
- END IF
-*
-* EXPSUM is the exponent range, approximately equal to
-* EMAX - EMIN + 1 .
-*
- EMAX = EXPSUM + EMIN - 1
- NBITS = 1 + EXBITS + P
-*
-* NBITS is the total number of bits needed to store a
-* floating-point number.
-*
- IF( ( MOD( NBITS, 2 ).EQ.1 ) .AND. ( BETA.EQ.2 ) ) THEN
-*
-* Either there are an odd number of bits used to store a
-* floating-point number, which is unlikely, or some bits are
-* not used in the representation of numbers, which is possible,
-* (e.g. Cray machines) or the mantissa has an implicit bit,
-* (e.g. IEEE machines, Dec Vax machines), which is perhaps the
-* most likely. We have to assume the last alternative.
-* If this is true, then we need to reduce EMAX by one because
-* there must be some way of representing zero in an implicit-bit
-* system. On machines like Cray, we are reducing EMAX by one
-* unnecessarily.
-*
- EMAX = EMAX - 1
- END IF
-*
- IF( IEEE ) THEN
-*
-* Assume we are on an IEEE machine which reserves one exponent
-* for infinity and NaN.
-*
- EMAX = EMAX - 1
- END IF
-*
-* Now create RMAX, the largest machine number, which should
-* be equal to (1.0 - BETA**(-P)) * BETA**EMAX .
-*
-* First compute 1.0 - BETA**(-P), being careful that the
-* result is less than 1.0 .
-*
- RECBAS = ONE / BETA
- Z = BETA - ONE
- Y = ZERO
- DO 20 I = 1, P
- Z = Z*RECBAS
- IF( Y.LT.ONE )
- $ OLDY = Y
- Y = DLAMC3( Y, Z )
- 20 CONTINUE
- IF( Y.GE.ONE )
- $ Y = OLDY
-*
-* Now multiply by BETA**EMAX to get RMAX.
-*
- DO 30 I = 1, EMAX
- Y = DLAMC3( Y*BETA, ZERO )
- 30 CONTINUE
-*
- RMAX = Y
- RETURN
-*
-* End of DLAMC5
-*
- END
diff --git a/mtx/blas_src/dscal.f b/mtx/blas_src/dscal.f
deleted file mode 100644
index 3337de8e6..000000000
--- a/mtx/blas_src/dscal.f
+++ /dev/null
@@ -1,110 +0,0 @@
-*> \brief \b DSCAL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSCAL(N,DA,DX,INCX)
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION DA
-* INTEGER INCX,N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION DX(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DSCAL scales a vector by a constant.
-*> uses unrolled loops for increment equal to one.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_blas_level1
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> jack dongarra, linpack, 3/11/78.
-*> modified 3/93 to return if incx .le. 0.
-*> modified 12/3/93, array(1) declarations changed to array(*)
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DSCAL(N,DA,DX,INCX)
-*
-* -- Reference BLAS level1 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION DA
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*)
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I,M,MP1,NINCX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- IF (N.LE.0 .OR. INCX.LE.0) RETURN
- IF (INCX.EQ.1) THEN
-*
-* code for increment equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,5)
- IF (M.NE.0) THEN
- DO I = 1,M
- DX(I) = DA*DX(I)
- END DO
- IF (N.LT.5) RETURN
- END IF
- MP1 = M + 1
- DO I = MP1,N,5
- DX(I) = DA*DX(I)
- DX(I+1) = DA*DX(I+1)
- DX(I+2) = DA*DX(I+2)
- DX(I+3) = DA*DX(I+3)
- DX(I+4) = DA*DX(I+4)
- END DO
- ELSE
-*
-* code for increment not equal to 1
-*
- NINCX = N*INCX
- DO I = 1,NINCX,INCX
- DX(I) = DA*DX(I)
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/blas_src/dswap.f b/mtx/blas_src/dswap.f
deleted file mode 100644
index e567bd93e..000000000
--- a/mtx/blas_src/dswap.f
+++ /dev/null
@@ -1,122 +0,0 @@
-*> \brief \b DSWAP
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DSWAP(N,DX,INCX,DY,INCY)
-*
-* .. Scalar Arguments ..
-* INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION DX(*),DY(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> interchanges two vectors.
-*> uses unrolled loops for increments equal one.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_blas_level1
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> jack dongarra, linpack, 3/11/78.
-*> modified 12/3/93, array(1) declarations changed to array(*)
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DSWAP(N,DX,INCX,DY,INCY)
-*
-* -- Reference BLAS level1 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*),DY(*)
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION DTEMP
- INTEGER I,IX,IY,M,MP1
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,3)
- IF (M.NE.0) THEN
- DO I = 1,M
- DTEMP = DX(I)
- DX(I) = DY(I)
- DY(I) = DTEMP
- END DO
- IF (N.LT.3) RETURN
- END IF
- MP1 = M + 1
- DO I = MP1,N,3
- DTEMP = DX(I)
- DX(I) = DY(I)
- DY(I) = DTEMP
- DTEMP = DX(I+1)
- DX(I+1) = DY(I+1)
- DY(I+1) = DTEMP
- DTEMP = DX(I+2)
- DX(I+2) = DY(I+2)
- DY(I+2) = DTEMP
- END DO
- ELSE
-*
-* code for unequal increments or equal increments not equal
-* to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- DTEMP = DX(IX)
- DX(IX) = DY(IY)
- DY(IY) = DTEMP
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/blas_src/dtbsv.f b/mtx/blas_src/dtbsv.f
deleted file mode 100644
index 5e25a927b..000000000
--- a/mtx/blas_src/dtbsv.f
+++ /dev/null
@@ -1,401 +0,0 @@
-*> \brief \b DTBSV
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
-*
-* .. Scalar Arguments ..
-* INTEGER INCX,K,LDA,N
-* CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A(LDA,*),X(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> On entry, UPLO specifies whether the matrix is an upper or
-*> lower triangular matrix as follows:
-*>
-*> UPLO = 'U' or 'u' A is an upper triangular matrix.
-*>
-*> UPLO = 'L' or 'l' A is a lower triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> On entry, TRANS specifies the equations to be solved as
-*> follows:
-*>
-*> TRANS = 'N' or 'n' A*x = b.
-*>
-*> TRANS = 'T' or 't' A**T*x = b.
-*>
-*> TRANS = 'C' or 'c' A**T*x = b.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> On entry, DIAG specifies whether or not A is unit
-*> triangular as follows:
-*>
-*> DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*>
-*> DIAG = 'N' or 'n' A is not assumed to be unit
-*> triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the order of the matrix A.
-*> N must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> On entry with UPLO = 'U' or 'u', K specifies the number of
-*> super-diagonals of the matrix A.
-*> On entry with UPLO = 'L' or 'l', K specifies the number of
-*> sub-diagonals of the matrix A.
-*> K must satisfy 0 .le. K.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-*> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
-*> by n part of the array A must contain the upper triangular
-*> band part of the matrix of coefficients, supplied column by
-*> column, with the leading diagonal of the matrix in row
-*> ( k + 1 ) of the array, the first super-diagonal starting at
-*> position 2 in row k, and so on. The top left k by k triangle
-*> of the array A is not referenced.
-*> The following program segment will transfer an upper
-*> triangular band matrix from conventional full matrix storage
-*> to band storage:
-*>
-*> DO 20, J = 1, N
-*> M = K + 1 - J
-*> DO 10, I = MAX( 1, J - K ), J
-*> A( M + I, J ) = matrix( I, J )
-*> 10 CONTINUE
-*> 20 CONTINUE
-*>
-*> Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
-*> by n part of the array A must contain the lower triangular
-*> band part of the matrix of coefficients, supplied column by
-*> column, with the leading diagonal of the matrix in row 1 of
-*> the array, the first sub-diagonal starting at position 1 in
-*> row 2, and so on. The bottom right k by k triangle of the
-*> array A is not referenced.
-*> The following program segment will transfer a lower
-*> triangular band matrix from conventional full matrix storage
-*> to band storage:
-*>
-*> DO 20, J = 1, N
-*> M = 1 - J
-*> DO 10, I = J, MIN( N, J + K )
-*> A( M + I, J ) = matrix( I, J )
-*> 10 CONTINUE
-*> 20 CONTINUE
-*>
-*> Note that when DIAG = 'U' or 'u' the elements of the array A
-*> corresponding to the diagonal elements of the matrix are not
-*> referenced, but are assumed to be unity.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. LDA must be at least
-*> ( k + 1 ).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
-*> ( 1 + ( n - 1 )*abs( INCX ) ).
-*> Before entry, the incremented array X must contain the n
-*> element right-hand side vector b. On exit, X is overwritten
-*> with the solution vector x.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_blas_level2
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Level 2 Blas routine.
-*>
-*> -- Written on 22-October-1986.
-*> Jack Dongarra, Argonne National Lab.
-*> Jeremy Du Croz, Nag Central Office.
-*> Sven Hammarling, Nag Central Office.
-*> Richard Hanson, Sandia National Labs.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
-*
-* -- Reference BLAS level2 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX,K,LDA,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*)
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER (ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,J,JX,KPLUS1,KX,L
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX,MIN
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (K.LT.0) THEN
- INFO = 5
- ELSE IF (LDA.LT. (K+1)) THEN
- INFO = 7
- ELSE IF (INCX.EQ.0) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DTBSV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed by sequentially with one pass through A.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x := inv( A )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KPLUS1 = K + 1
- IF (INCX.EQ.1) THEN
- DO 20 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- L = KPLUS1 - J
- IF (NOUNIT) X(J) = X(J)/A(KPLUS1,J)
- TEMP = X(J)
- DO 10 I = J - 1,MAX(1,J-K),-1
- X(I) = X(I) - TEMP*A(L+I,J)
- 10 CONTINUE
- END IF
- 20 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 40 J = N,1,-1
- KX = KX - INCX
- IF (X(JX).NE.ZERO) THEN
- IX = KX
- L = KPLUS1 - J
- IF (NOUNIT) X(JX) = X(JX)/A(KPLUS1,J)
- TEMP = X(JX)
- DO 30 I = J - 1,MAX(1,J-K),-1
- X(IX) = X(IX) - TEMP*A(L+I,J)
- IX = IX - INCX
- 30 CONTINUE
- END IF
- JX = JX - INCX
- 40 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(J).NE.ZERO) THEN
- L = 1 - J
- IF (NOUNIT) X(J) = X(J)/A(1,J)
- TEMP = X(J)
- DO 50 I = J + 1,MIN(N,J+K)
- X(I) = X(I) - TEMP*A(L+I,J)
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE
- JX = KX
- DO 80 J = 1,N
- KX = KX + INCX
- IF (X(JX).NE.ZERO) THEN
- IX = KX
- L = 1 - J
- IF (NOUNIT) X(JX) = X(JX)/A(1,J)
- TEMP = X(JX)
- DO 70 I = J + 1,MIN(N,J+K)
- X(IX) = X(IX) - TEMP*A(L+I,J)
- IX = IX + INCX
- 70 CONTINUE
- END IF
- JX = JX + INCX
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := inv( A**T)*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KPLUS1 = K + 1
- IF (INCX.EQ.1) THEN
- DO 100 J = 1,N
- TEMP = X(J)
- L = KPLUS1 - J
- DO 90 I = MAX(1,J-K),J - 1
- TEMP = TEMP - A(L+I,J)*X(I)
- 90 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(KPLUS1,J)
- X(J) = TEMP
- 100 CONTINUE
- ELSE
- JX = KX
- DO 120 J = 1,N
- TEMP = X(JX)
- IX = KX
- L = KPLUS1 - J
- DO 110 I = MAX(1,J-K),J - 1
- TEMP = TEMP - A(L+I,J)*X(IX)
- IX = IX + INCX
- 110 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(KPLUS1,J)
- X(JX) = TEMP
- JX = JX + INCX
- IF (J.GT.K) KX = KX + INCX
- 120 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 140 J = N,1,-1
- TEMP = X(J)
- L = 1 - J
- DO 130 I = MIN(N,J+K),J + 1,-1
- TEMP = TEMP - A(L+I,J)*X(I)
- 130 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(1,J)
- X(J) = TEMP
- 140 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 160 J = N,1,-1
- TEMP = X(JX)
- IX = KX
- L = 1 - J
- DO 150 I = MIN(N,J+K),J + 1,-1
- TEMP = TEMP - A(L+I,J)*X(IX)
- IX = IX - INCX
- 150 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(1,J)
- X(JX) = TEMP
- JX = JX - INCX
- IF ((N-J).GE.K) KX = KX - INCX
- 160 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DTBSV .
-*
- END
diff --git a/mtx/blas_src/dtrsm.f b/mtx/blas_src/dtrsm.f
deleted file mode 100644
index 065df9a15..000000000
--- a/mtx/blas_src/dtrsm.f
+++ /dev/null
@@ -1,443 +0,0 @@
-*> \brief \b DTRSM
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION ALPHA
-* INTEGER LDA,LDB,M,N
-* CHARACTER DIAG,SIDE,TRANSA,UPLO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A(LDA,*),B(LDB,*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> On entry, SIDE specifies whether op( A ) appears on the left
-*> or right of X as follows:
-*>
-*> SIDE = 'L' or 'l' op( A )*X = alpha*B.
-*>
-*> SIDE = 'R' or 'r' X*op( A ) = alpha*B.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> On entry, UPLO specifies whether the matrix A is an upper or
-*> lower triangular matrix as follows:
-*>
-*> UPLO = 'U' or 'u' A is an upper triangular matrix.
-*>
-*> UPLO = 'L' or 'l' A is a lower triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] TRANSA
-*> \verbatim
-*> TRANSA is CHARACTER*1
-*> On entry, TRANSA specifies the form of op( A ) to be used in
-*> the matrix multiplication as follows:
-*>
-*> TRANSA = 'N' or 'n' op( A ) = A.
-*>
-*> TRANSA = 'T' or 't' op( A ) = A**T.
-*>
-*> TRANSA = 'C' or 'c' op( A ) = A**T.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> On entry, DIAG specifies whether or not A is unit triangular
-*> as follows:
-*>
-*> DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*>
-*> DIAG = 'N' or 'n' A is not assumed to be unit
-*> triangular.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the number of rows of B. M must be at
-*> least zero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of B. N must be
-*> at least zero.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION.
-*> On entry, ALPHA specifies the scalar alpha. When alpha is
-*> zero then A is not referenced and B need not be set before
-*> entry.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, k ),
-*> where k is m when SIDE = 'L' or 'l'
-*> and k is n when SIDE = 'R' or 'r'.
-*> Before entry with UPLO = 'U' or 'u', the leading k by k
-*> upper triangular part of the array A must contain the upper
-*> triangular matrix and the strictly lower triangular part of
-*> A is not referenced.
-*> Before entry with UPLO = 'L' or 'l', the leading k by k
-*> lower triangular part of the array A must contain the lower
-*> triangular matrix and the strictly upper triangular part of
-*> A is not referenced.
-*> Note that when DIAG = 'U' or 'u', the diagonal elements of
-*> A are not referenced either, but are assumed to be unity.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. When SIDE = 'L' or 'l' then
-*> LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
-*> then LDA must be at least max( 1, n ).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array of DIMENSION ( LDB, n ).
-*> Before entry, the leading m by n part of the array B must
-*> contain the right-hand side matrix B, and on exit is
-*> overwritten by the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> On entry, LDB specifies the first dimension of B as declared
-*> in the calling (sub) program. LDB must be at least
-*> max( 1, m ).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_blas_level3
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Level 3 Blas routine.
-*>
-*>
-*> -- Written on 8-February-1989.
-*> Jack Dongarra, Argonne National Laboratory.
-*> Iain Duff, AERE Harwell.
-*> Jeremy Du Croz, Numerical Algorithms Group Ltd.
-*> Sven Hammarling, Numerical Algorithms Group Ltd.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
-*
-* -- Reference BLAS level3 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA
- INTEGER LDA,LDB,M,N
- CHARACTER DIAG,SIDE,TRANSA,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),B(LDB,*)
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,J,K,NROWA
- LOGICAL LSIDE,NOUNIT,UPPER
-* ..
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-*
-* Test the input parameters.
-*
- LSIDE = LSAME(SIDE,'L')
- IF (LSIDE) THEN
- NROWA = M
- ELSE
- NROWA = N
- END IF
- NOUNIT = LSAME(DIAG,'N')
- UPPER = LSAME(UPLO,'U')
-*
- INFO = 0
- IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
- INFO = 1
- ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
- INFO = 2
- ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
- + (.NOT.LSAME(TRANSA,'T')) .AND.
- + (.NOT.LSAME(TRANSA,'C'))) THEN
- INFO = 3
- ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
- INFO = 4
- ELSE IF (M.LT.0) THEN
- INFO = 5
- ELSE IF (N.LT.0) THEN
- INFO = 6
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 9
- ELSE IF (LDB.LT.MAX(1,M)) THEN
- INFO = 11
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DTRSM ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (M.EQ.0 .OR. N.EQ.0) RETURN
-*
-* And when alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,M
- B(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (LSIDE) THEN
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*inv( A )*B.
-*
- IF (UPPER) THEN
- DO 60 J = 1,N
- IF (ALPHA.NE.ONE) THEN
- DO 30 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 30 CONTINUE
- END IF
- DO 50 K = M,1,-1
- IF (B(K,J).NE.ZERO) THEN
- IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
- DO 40 I = 1,K - 1
- B(I,J) = B(I,J) - B(K,J)*A(I,K)
- 40 CONTINUE
- END IF
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- DO 100 J = 1,N
- IF (ALPHA.NE.ONE) THEN
- DO 70 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 70 CONTINUE
- END IF
- DO 90 K = 1,M
- IF (B(K,J).NE.ZERO) THEN
- IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
- DO 80 I = K + 1,M
- B(I,J) = B(I,J) - B(K,J)*A(I,K)
- 80 CONTINUE
- END IF
- 90 CONTINUE
- 100 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*inv( A**T )*B.
-*
- IF (UPPER) THEN
- DO 130 J = 1,N
- DO 120 I = 1,M
- TEMP = ALPHA*B(I,J)
- DO 110 K = 1,I - 1
- TEMP = TEMP - A(K,I)*B(K,J)
- 110 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(I,I)
- B(I,J) = TEMP
- 120 CONTINUE
- 130 CONTINUE
- ELSE
- DO 160 J = 1,N
- DO 150 I = M,1,-1
- TEMP = ALPHA*B(I,J)
- DO 140 K = I + 1,M
- TEMP = TEMP - A(K,I)*B(K,J)
- 140 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(I,I)
- B(I,J) = TEMP
- 150 CONTINUE
- 160 CONTINUE
- END IF
- END IF
- ELSE
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*B*inv( A ).
-*
- IF (UPPER) THEN
- DO 210 J = 1,N
- IF (ALPHA.NE.ONE) THEN
- DO 170 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 170 CONTINUE
- END IF
- DO 190 K = 1,J - 1
- IF (A(K,J).NE.ZERO) THEN
- DO 180 I = 1,M
- B(I,J) = B(I,J) - A(K,J)*B(I,K)
- 180 CONTINUE
- END IF
- 190 CONTINUE
- IF (NOUNIT) THEN
- TEMP = ONE/A(J,J)
- DO 200 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 200 CONTINUE
- END IF
- 210 CONTINUE
- ELSE
- DO 260 J = N,1,-1
- IF (ALPHA.NE.ONE) THEN
- DO 220 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 220 CONTINUE
- END IF
- DO 240 K = J + 1,N
- IF (A(K,J).NE.ZERO) THEN
- DO 230 I = 1,M
- B(I,J) = B(I,J) - A(K,J)*B(I,K)
- 230 CONTINUE
- END IF
- 240 CONTINUE
- IF (NOUNIT) THEN
- TEMP = ONE/A(J,J)
- DO 250 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 250 CONTINUE
- END IF
- 260 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*B*inv( A**T ).
-*
- IF (UPPER) THEN
- DO 310 K = N,1,-1
- IF (NOUNIT) THEN
- TEMP = ONE/A(K,K)
- DO 270 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 270 CONTINUE
- END IF
- DO 290 J = 1,K - 1
- IF (A(J,K).NE.ZERO) THEN
- TEMP = A(J,K)
- DO 280 I = 1,M
- B(I,J) = B(I,J) - TEMP*B(I,K)
- 280 CONTINUE
- END IF
- 290 CONTINUE
- IF (ALPHA.NE.ONE) THEN
- DO 300 I = 1,M
- B(I,K) = ALPHA*B(I,K)
- 300 CONTINUE
- END IF
- 310 CONTINUE
- ELSE
- DO 360 K = 1,N
- IF (NOUNIT) THEN
- TEMP = ONE/A(K,K)
- DO 320 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 320 CONTINUE
- END IF
- DO 340 J = K + 1,N
- IF (A(J,K).NE.ZERO) THEN
- TEMP = A(J,K)
- DO 330 I = 1,M
- B(I,J) = B(I,J) - TEMP*B(I,K)
- 330 CONTINUE
- END IF
- 340 CONTINUE
- IF (ALPHA.NE.ONE) THEN
- DO 350 I = 1,M
- B(I,K) = ALPHA*B(I,K)
- 350 CONTINUE
- END IF
- 360 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DTRSM .
-*
- END
diff --git a/mtx/blas_src/dtrsv.f b/mtx/blas_src/dtrsv.f
deleted file mode 100644
index e54303a93..000000000
--- a/mtx/blas_src/dtrsv.f
+++ /dev/null
@@ -1,338 +0,0 @@
-*> \brief \b DTRSV
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
-*
-* .. Scalar Arguments ..
-* INTEGER INCX,LDA,N
-* CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A(LDA,*),X(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> On entry, UPLO specifies whether the matrix is an upper or
-*> lower triangular matrix as follows:
-*>
-*> UPLO = 'U' or 'u' A is an upper triangular matrix.
-*>
-*> UPLO = 'L' or 'l' A is a lower triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> On entry, TRANS specifies the equations to be solved as
-*> follows:
-*>
-*> TRANS = 'N' or 'n' A*x = b.
-*>
-*> TRANS = 'T' or 't' A**T*x = b.
-*>
-*> TRANS = 'C' or 'c' A**T*x = b.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> On entry, DIAG specifies whether or not A is unit
-*> triangular as follows:
-*>
-*> DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*>
-*> DIAG = 'N' or 'n' A is not assumed to be unit
-*> triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the order of the matrix A.
-*> N must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-*> Before entry with UPLO = 'U' or 'u', the leading n by n
-*> upper triangular part of the array A must contain the upper
-*> triangular matrix and the strictly lower triangular part of
-*> A is not referenced.
-*> Before entry with UPLO = 'L' or 'l', the leading n by n
-*> lower triangular part of the array A must contain the lower
-*> triangular matrix and the strictly upper triangular part of
-*> A is not referenced.
-*> Note that when DIAG = 'U' or 'u', the diagonal elements of
-*> A are not referenced either, but are assumed to be unity.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. LDA must be at least
-*> max( 1, n ).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
-*> ( 1 + ( n - 1 )*abs( INCX ) ).
-*> Before entry, the incremented array X must contain the n
-*> element right-hand side vector b. On exit, X is overwritten
-*> with the solution vector x.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*>
-*> Level 2 Blas routine.
-*>
-*> -- Written on 22-October-1986.
-*> Jack Dongarra, Argonne National Lab.
-*> Jeremy Du Croz, Nag Central Office.
-*> Sven Hammarling, Nag Central Office.
-*> Richard Hanson, Sandia National Labs.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup double_blas_level1
-*
-* =====================================================================
- SUBROUTINE DTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
-*
-* -- Reference BLAS level1 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX,LDA,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*)
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER (ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,J,JX,KX
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (LDA.LT.MAX(1,N)) THEN
- INFO = 6
- ELSE IF (INCX.EQ.0) THEN
- INFO = 8
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DTRSV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x := inv( A )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- IF (INCX.EQ.1) THEN
- DO 20 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- IF (NOUNIT) X(J) = X(J)/A(J,J)
- TEMP = X(J)
- DO 10 I = J - 1,1,-1
- X(I) = X(I) - TEMP*A(I,J)
- 10 CONTINUE
- END IF
- 20 CONTINUE
- ELSE
- JX = KX + (N-1)*INCX
- DO 40 J = N,1,-1
- IF (X(JX).NE.ZERO) THEN
- IF (NOUNIT) X(JX) = X(JX)/A(J,J)
- TEMP = X(JX)
- IX = JX
- DO 30 I = J - 1,1,-1
- IX = IX - INCX
- X(IX) = X(IX) - TEMP*A(I,J)
- 30 CONTINUE
- END IF
- JX = JX - INCX
- 40 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(J).NE.ZERO) THEN
- IF (NOUNIT) X(J) = X(J)/A(J,J)
- TEMP = X(J)
- DO 50 I = J + 1,N
- X(I) = X(I) - TEMP*A(I,J)
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE
- JX = KX
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- IF (NOUNIT) X(JX) = X(JX)/A(J,J)
- TEMP = X(JX)
- IX = JX
- DO 70 I = J + 1,N
- IX = IX + INCX
- X(IX) = X(IX) - TEMP*A(I,J)
- 70 CONTINUE
- END IF
- JX = JX + INCX
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := inv( A**T )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- IF (INCX.EQ.1) THEN
- DO 100 J = 1,N
- TEMP = X(J)
- DO 90 I = 1,J - 1
- TEMP = TEMP - A(I,J)*X(I)
- 90 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- X(J) = TEMP
- 100 CONTINUE
- ELSE
- JX = KX
- DO 120 J = 1,N
- TEMP = X(JX)
- IX = KX
- DO 110 I = 1,J - 1
- TEMP = TEMP - A(I,J)*X(IX)
- IX = IX + INCX
- 110 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- X(JX) = TEMP
- JX = JX + INCX
- 120 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 140 J = N,1,-1
- TEMP = X(J)
- DO 130 I = N,J + 1,-1
- TEMP = TEMP - A(I,J)*X(I)
- 130 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- X(J) = TEMP
- 140 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 160 J = N,1,-1
- TEMP = X(JX)
- IX = KX
- DO 150 I = N,J + 1,-1
- TEMP = TEMP - A(I,J)*X(IX)
- IX = IX - INCX
- 150 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- X(JX) = TEMP
- JX = JX - INCX
- 160 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DTRSV .
-*
- END
diff --git a/mtx/blas_src/idamax.f b/mtx/blas_src/idamax.f
deleted file mode 100644
index 4233fcc27..000000000
--- a/mtx/blas_src/idamax.f
+++ /dev/null
@@ -1,106 +0,0 @@
-*> \brief \b IDAMAX
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION IDAMAX(N,DX,INCX)
-*
-* .. Scalar Arguments ..
-* INTEGER INCX,N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION DX(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> IDAMAX finds the index of element having max. absolute value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup aux_blas
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> jack dongarra, linpack, 3/11/78.
-*> modified 3/93 to return if incx .le. 0.
-*> modified 12/3/93, array(1) declarations changed to array(*)
-*> \endverbatim
-*>
-* =====================================================================
- INTEGER FUNCTION IDAMAX(N,DX,INCX)
-*
-* -- Reference BLAS level1 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*)
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION DMAX
- INTEGER I,IX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DABS
-* ..
- IDAMAX = 0
- IF (N.LT.1 .OR. INCX.LE.0) RETURN
- IDAMAX = 1
- IF (N.EQ.1) RETURN
- IF (INCX.EQ.1) THEN
-*
-* code for increment equal to 1
-*
- DMAX = DABS(DX(1))
- DO I = 2,N
- IF (DABS(DX(I)).GT.DMAX) THEN
- IDAMAX = I
- DMAX = DABS(DX(I))
- END IF
- END DO
- ELSE
-*
-* code for increment not equal to 1
-*
- IX = 1
- DMAX = DABS(DX(1))
- IX = IX + INCX
- DO I = 2,N
- IF (DABS(DX(IX)).GT.DMAX) THEN
- IDAMAX = I
- DMAX = DABS(DX(IX))
- END IF
- IX = IX + INCX
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/blas_src/ieeeck.f b/mtx/blas_src/ieeeck.f
deleted file mode 100644
index 3c09fe95e..000000000
--- a/mtx/blas_src/ieeeck.f
+++ /dev/null
@@ -1,148 +0,0 @@
- INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE )
-*
-* -- LAPACK auxiliary routine (version 3.0) --
-* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1998
-*
-* .. Scalar Arguments ..
- INTEGER ISPEC
- REAL ONE, ZERO
-* ..
-*
-* Purpose
-* =======
-*
-* IEEECK is called from the ILAENV to verify that Infinity and
-* possibly NaN arithmetic is safe (i.e. will not trap).
-*
-* Arguments
-* =========
-*
-* ISPEC (input) INTEGER
-* Specifies whether to test just for inifinity arithmetic
-* or whether to test for infinity and NaN arithmetic.
-* = 0: Verify infinity arithmetic only.
-* = 1: Verify infinity and NaN arithmetic.
-*
-* ZERO (input) REAL
-* Must contain the value 0.0
-* This is passed to prevent the compiler from optimizing
-* away this code.
-*
-* ONE (input) REAL
-* Must contain the value 1.0
-* This is passed to prevent the compiler from optimizing
-* away this code.
-*
-* RETURN VALUE: INTEGER
-* = 0: Arithmetic failed to produce the correct answers
-* = 1: Arithmetic produced the correct answers
-*
-* .. Local Scalars ..
- REAL NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF,
- $ NEGZRO, NEWZRO, POSINF
-* ..
-* .. Executable Statements ..
- IEEECK = 1
-*
- POSINF = ONE / ZERO
- IF( POSINF.LE.ONE ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- NEGINF = -ONE / ZERO
- IF( NEGINF.GE.ZERO ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- NEGZRO = ONE / ( NEGINF+ONE )
- IF( NEGZRO.NE.ZERO ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- NEGINF = ONE / NEGZRO
- IF( NEGINF.GE.ZERO ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- NEWZRO = NEGZRO + ZERO
- IF( NEWZRO.NE.ZERO ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- POSINF = ONE / NEWZRO
- IF( POSINF.LE.ONE ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- NEGINF = NEGINF*POSINF
- IF( NEGINF.GE.ZERO ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- POSINF = POSINF*POSINF
- IF( POSINF.LE.ONE ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
-*
-*
-*
-* Return if we were only asked to check infinity arithmetic
-*
- IF( ISPEC.EQ.0 )
- $ RETURN
-*
- NAN1 = POSINF + NEGINF
-*
- NAN2 = POSINF / NEGINF
-*
- NAN3 = POSINF / POSINF
-*
- NAN4 = POSINF*ZERO
-*
- NAN5 = NEGINF*NEGZRO
-*
- NAN6 = NAN5*0.0
-*
- IF( NAN1.EQ.NAN1 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- IF( NAN2.EQ.NAN2 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- IF( NAN3.EQ.NAN3 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- IF( NAN4.EQ.NAN4 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- IF( NAN5.EQ.NAN5 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- IF( NAN6.EQ.NAN6 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- RETURN
- END
diff --git a/mtx/blas_src/ilaenv.f b/mtx/blas_src/ilaenv.f
deleted file mode 100644
index 7263d6010..000000000
--- a/mtx/blas_src/ilaenv.f
+++ /dev/null
@@ -1,547 +0,0 @@
- INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3,
- $ N4 )
-*
-* -- LAPACK auxiliary routine (version 3.0) --
-* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
-*
-* .. Scalar Arguments ..
- CHARACTER*( * ) NAME, OPTS
- INTEGER ISPEC, N1, N2, N3, N4
-* ..
-*
-* Purpose
-* =======
-*
-* ILAENV is called from the LAPACK routines to choose problem-dependent
-* parameters for the local environment. See ISPEC for a description of
-* the parameters.
-*
-* 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.
-*
-* Arguments
-* =========
-*
-* ISPEC (input) INTEGER
-* Specifies the parameter to be returned as the value of
-* ILAENV.
-* = 1: the optimal blocksize; if this value is 1, an unblocked
-* algorithm will give the best performance.
-* = 2: the minimum block size for which the block routine
-* should be used; if the usable block size is less than
-* this value, an unblocked routine should be used.
-* = 3: the crossover point (in a block routine, for N less
-* than this value, an unblocked routine should be used)
-* = 4: the number of shifts, used in the nonsymmetric
-* eigenvalue routines
-* = 5: the minimum column dimension for blocking to be used;
-* rectangular blocks must have dimension at least k by m,
-* where k is given by ILAENV(2,...) and m by ILAENV(5,...)
-* = 6: the crossover point for the SVD (when reducing an m by n
-* matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
-* this value, a QR factorization is used first to reduce
-* the matrix to a triangular form.)
-* = 7: the number of processors
-* = 8: the crossover point for the multishift QR and QZ methods
-* for nonsymmetric eigenvalue problems.
-* = 9: maximum size of the subproblems at the bottom of the
-* computation tree in the divide-and-conquer algorithm
-* (used by xGELSD and xGESDD)
-* =10: ieee NaN arithmetic can be trusted not to trap
-* =11: infinity arithmetic can be trusted not to trap
-*
-* NAME (input) CHARACTER*(*)
-* The name of the calling subroutine, in either upper case or
-* lower case.
-*
-* OPTS (input) CHARACTER*(*)
-* The character options to the subroutine NAME, concatenated
-* into a single character string. For example, UPLO = 'U',
-* TRANS = 'T', and DIAG = 'N' for a triangular routine would
-* be specified as OPTS = 'UTN'.
-*
-* N1 (input) INTEGER
-* N2 (input) INTEGER
-* N3 (input) INTEGER
-* N4 (input) INTEGER
-* Problem dimensions for the subroutine NAME; these may not all
-* be required.
-*
-* (ILAENV) (output) INTEGER
-* >= 0: the value of the parameter specified by ISPEC
-* < 0: if ILAENV = -k, the k-th argument had an illegal value.
-*
-* Further Details
-* ===============
-*
-* The following conventions have been used when calling ILAENV from the
-* LAPACK routines:
-* 1) OPTS is a concatenation of all of the character options to
-* subroutine NAME, in the same order that they appear in the
-* argument list for NAME, even if they are not used in determining
-* the value of the parameter specified by ISPEC.
-* 2) The problem dimensions N1, N2, N3, N4 are specified in the order
-* that they appear in the argument list for NAME. N1 is used
-* first, N2 second, and so on, and unused problem dimensions are
-* passed a value of -1.
-* 3) The parameter value returned by ILAENV is checked for validity in
-* the calling subroutine. For example, ILAENV is used to retrieve
-* the optimal blocksize for STRTRI as follows:
-*
-* NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
-* IF( NB.LE.1 ) NB = MAX( 1, N )
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL CNAME, SNAME
- CHARACTER*1 C1
- CHARACTER*2 C2, C4
- CHARACTER*3 C3
- CHARACTER*6 SUBNAM
- INTEGER I, IC, IZ, NB, NBMIN, NX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC CHAR, ICHAR, INT, MIN, REAL
-* ..
-* .. External Functions ..
- INTEGER IEEECK
- EXTERNAL IEEECK
-* ..
-* .. Executable Statements ..
-*
- GO TO ( 100, 100, 100, 400, 500, 600, 700, 800, 900, 1000,
- $ 1100 ) ISPEC
-*
-* Invalid value for ISPEC
-*
- ILAENV = -1
- RETURN
-*
- 100 CONTINUE
-*
-* Convert NAME to upper case if the first character is lower case.
-*
- ILAENV = 1
- SUBNAM = NAME
- IC = ICHAR( SUBNAM( 1:1 ) )
- IZ = ICHAR( 'Z' )
- IF( IZ.EQ.90 .OR. IZ.EQ.122 ) THEN
-*
-* ASCII character set
-*
- IF( IC.GE.97 .AND. IC.LE.122 ) THEN
- SUBNAM( 1:1 ) = CHAR( IC-32 )
- DO 10 I = 2, 6
- IC = ICHAR( SUBNAM( I:I ) )
- IF( IC.GE.97 .AND. IC.LE.122 )
- $ SUBNAM( I:I ) = CHAR( IC-32 )
- 10 CONTINUE
- END IF
-*
- ELSE IF( IZ.EQ.233 .OR. IZ.EQ.169 ) THEN
-*
-* EBCDIC character set
-*
- IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
- $ ( IC.GE.145 .AND. IC.LE.153 ) .OR.
- $ ( IC.GE.162 .AND. IC.LE.169 ) ) THEN
- SUBNAM( 1:1 ) = CHAR( IC+64 )
- DO 20 I = 2, 6
- IC = ICHAR( SUBNAM( I:I ) )
- IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
- $ ( IC.GE.145 .AND. IC.LE.153 ) .OR.
- $ ( IC.GE.162 .AND. IC.LE.169 ) )
- $ SUBNAM( I:I ) = CHAR( IC+64 )
- 20 CONTINUE
- END IF
-*
- ELSE IF( IZ.EQ.218 .OR. IZ.EQ.250 ) THEN
-*
-* Prime machines: ASCII+128
-*
- IF( IC.GE.225 .AND. IC.LE.250 ) THEN
- SUBNAM( 1:1 ) = CHAR( IC-32 )
- DO 30 I = 2, 6
- IC = ICHAR( SUBNAM( I:I ) )
- IF( IC.GE.225 .AND. IC.LE.250 )
- $ SUBNAM( I:I ) = CHAR( IC-32 )
- 30 CONTINUE
- END IF
- END IF
-*
- C1 = SUBNAM( 1:1 )
- SNAME = C1.EQ.'S' .OR. C1.EQ.'D'
- CNAME = C1.EQ.'C' .OR. C1.EQ.'Z'
- IF( .NOT.( CNAME .OR. SNAME ) )
- $ RETURN
- C2 = SUBNAM( 2:3 )
- C3 = SUBNAM( 4:6 )
- C4 = C3( 2:3 )
-*
- GO TO ( 110, 200, 300 ) ISPEC
-*
- 110 CONTINUE
-*
-* ISPEC = 1: block size
-*
-* In these examples, separate code is provided for setting NB for
-* real and complex. We assume that NB will take the same value in
-* single or double precision.
-*
- NB = 1
-*
- IF( C2.EQ.'GE' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- ELSE IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
- $ C3.EQ.'QLF' ) THEN
- IF( SNAME ) THEN
- NB = 32
- ELSE
- NB = 32
- END IF
- ELSE IF( C3.EQ.'HRD' ) THEN
- IF( SNAME ) THEN
- NB = 32
- ELSE
- NB = 32
- END IF
- ELSE IF( C3.EQ.'BRD' ) THEN
- IF( SNAME ) THEN
- NB = 32
- ELSE
- NB = 32
- END IF
- ELSE IF( C3.EQ.'TRI' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- END IF
- ELSE IF( C2.EQ.'PO' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- END IF
- ELSE IF( C2.EQ.'SY' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
- NB = 32
- ELSE IF( SNAME .AND. C3.EQ.'GST' ) THEN
- NB = 64
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- NB = 64
- ELSE IF( C3.EQ.'TRD' ) THEN
- NB = 32
- ELSE IF( C3.EQ.'GST' ) THEN
- NB = 64
- END IF
- ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
- IF( C3( 1:1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
- $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
- $ C4.EQ.'BR' ) THEN
- NB = 32
- END IF
- ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
- $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
- $ C4.EQ.'BR' ) THEN
- NB = 32
- END IF
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
- IF( C3( 1:1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
- $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
- $ C4.EQ.'BR' ) THEN
- NB = 32
- END IF
- ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
- $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
- $ C4.EQ.'BR' ) THEN
- NB = 32
- END IF
- END IF
- ELSE IF( C2.EQ.'GB' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- IF( N4.LE.64 ) THEN
- NB = 1
- ELSE
- NB = 32
- END IF
- ELSE
- IF( N4.LE.64 ) THEN
- NB = 1
- ELSE
- NB = 32
- END IF
- END IF
- END IF
- ELSE IF( C2.EQ.'PB' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- IF( N2.LE.64 ) THEN
- NB = 1
- ELSE
- NB = 32
- END IF
- ELSE
- IF( N2.LE.64 ) THEN
- NB = 1
- ELSE
- NB = 32
- END IF
- END IF
- END IF
- ELSE IF( C2.EQ.'TR' ) THEN
- IF( C3.EQ.'TRI' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- END IF
- ELSE IF( C2.EQ.'LA' ) THEN
- IF( C3.EQ.'UUM' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- END IF
- ELSE IF( SNAME .AND. C2.EQ.'ST' ) THEN
- IF( C3.EQ.'EBZ' ) THEN
- NB = 1
- END IF
- END IF
- ILAENV = NB
- RETURN
-*
- 200 CONTINUE
-*
-* ISPEC = 2: minimum block size
-*
- NBMIN = 2
- IF( C2.EQ.'GE' ) THEN
- IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
- $ C3.EQ.'QLF' ) THEN
- IF( SNAME ) THEN
- NBMIN = 2
- ELSE
- NBMIN = 2
- END IF
- ELSE IF( C3.EQ.'HRD' ) THEN
- IF( SNAME ) THEN
- NBMIN = 2
- ELSE
- NBMIN = 2
- END IF
- ELSE IF( C3.EQ.'BRD' ) THEN
- IF( SNAME ) THEN
- NBMIN = 2
- ELSE
- NBMIN = 2
- END IF
- ELSE IF( C3.EQ.'TRI' ) THEN
- IF( SNAME ) THEN
- NBMIN = 2
- ELSE
- NBMIN = 2
- END IF
- END IF
- ELSE IF( C2.EQ.'SY' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- NBMIN = 8
- ELSE
- NBMIN = 8
- END IF
- ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
- NBMIN = 2
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
- IF( C3.EQ.'TRD' ) THEN
- NBMIN = 2
- END IF
- ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
- IF( C3( 1:1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
- $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
- $ C4.EQ.'BR' ) THEN
- NBMIN = 2
- END IF
- ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
- $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
- $ C4.EQ.'BR' ) THEN
- NBMIN = 2
- END IF
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
- IF( C3( 1:1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
- $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
- $ C4.EQ.'BR' ) THEN
- NBMIN = 2
- END IF
- ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
- $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
- $ C4.EQ.'BR' ) THEN
- NBMIN = 2
- END IF
- END IF
- END IF
- ILAENV = NBMIN
- RETURN
-*
- 300 CONTINUE
-*
-* ISPEC = 3: crossover point
-*
- NX = 0
- IF( C2.EQ.'GE' ) THEN
- IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
- $ C3.EQ.'QLF' ) THEN
- IF( SNAME ) THEN
- NX = 128
- ELSE
- NX = 128
- END IF
- ELSE IF( C3.EQ.'HRD' ) THEN
- IF( SNAME ) THEN
- NX = 128
- ELSE
- NX = 128
- END IF
- ELSE IF( C3.EQ.'BRD' ) THEN
- IF( SNAME ) THEN
- NX = 128
- ELSE
- NX = 128
- END IF
- END IF
- ELSE IF( C2.EQ.'SY' ) THEN
- IF( SNAME .AND. C3.EQ.'TRD' ) THEN
- NX = 32
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
- IF( C3.EQ.'TRD' ) THEN
- NX = 32
- END IF
- ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
- IF( C3( 1:1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
- $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
- $ C4.EQ.'BR' ) THEN
- NX = 128
- END IF
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
- IF( C3( 1:1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
- $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
- $ C4.EQ.'BR' ) THEN
- NX = 128
- END IF
- END IF
- END IF
- ILAENV = NX
- RETURN
-*
- 400 CONTINUE
-*
-* ISPEC = 4: number of shifts (used by xHSEQR)
-*
- ILAENV = 6
- RETURN
-*
- 500 CONTINUE
-*
-* ISPEC = 5: minimum column dimension (not used)
-*
- ILAENV = 2
- RETURN
-*
- 600 CONTINUE
-*
-* ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD)
-*
- ILAENV = INT( REAL( MIN( N1, N2 ) )*1.6E0 )
- RETURN
-*
- 700 CONTINUE
-*
-* ISPEC = 7: number of processors (not used)
-*
- ILAENV = 1
- RETURN
-*
- 800 CONTINUE
-*
-* ISPEC = 8: crossover point for multishift (used by xHSEQR)
-*
- ILAENV = 50
- RETURN
-*
- 900 CONTINUE
-*
-* ISPEC = 9: maximum size of the subproblems at the bottom of the
-* computation tree in the divide-and-conquer algorithm
-* (used by xGELSD and xGESDD)
-*
- ILAENV = 25
- RETURN
-*
- 1000 CONTINUE
-*
-* ISPEC = 10: ieee NaN arithmetic can be trusted not to trap
-*
-C ILAENV = 0
- ILAENV = 1
- IF( ILAENV.EQ.1 ) THEN
- ILAENV = IEEECK( 0, 0.0, 1.0 )
- END IF
- RETURN
-*
- 1100 CONTINUE
-*
-* ISPEC = 11: infinity arithmetic can be trusted not to trap
-*
-C ILAENV = 0
- ILAENV = 1
- IF( ILAENV.EQ.1 ) THEN
- ILAENV = IEEECK( 1, 0.0, 1.0 )
- END IF
- RETURN
-*
-* End of ILAENV
-*
- END
diff --git a/mtx/blas_src/isamax.f b/mtx/blas_src/isamax.f
deleted file mode 100644
index af977c594..000000000
--- a/mtx/blas_src/isamax.f
+++ /dev/null
@@ -1,106 +0,0 @@
-*> \brief \b ISAMAX
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ISAMAX(N,SX,INCX)
-*
-* .. Scalar Arguments ..
-* INTEGER INCX,N
-* ..
-* .. Array Arguments ..
-* REAL SX(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ISAMAX finds the index of element having max. absolute value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup aux_blas
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> jack dongarra, linpack, 3/11/78.
-*> modified 3/93 to return if incx .le. 0.
-*> modified 12/3/93, array(1) declarations changed to array(*)
-*> \endverbatim
-*>
-* =====================================================================
- INTEGER FUNCTION ISAMAX(N,SX,INCX)
-*
-* -- Reference BLAS level1 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- REAL SX(*)
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL SMAX
- INTEGER I,IX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
- ISAMAX = 0
- IF (N.LT.1 .OR. INCX.LE.0) RETURN
- ISAMAX = 1
- IF (N.EQ.1) RETURN
- IF (INCX.EQ.1) THEN
-*
-* code for increment equal to 1
-*
- SMAX = ABS(SX(1))
- DO I = 2,N
- IF (ABS(SX(I)).GT.SMAX) THEN
- ISAMAX = I
- SMAX = ABS(SX(I))
- END IF
- END DO
- ELSE
-*
-* code for increment not equal to 1
-*
- IX = 1
- SMAX = ABS(SX(1))
- IX = IX + INCX
- DO I = 2,N
- IF (ABS(SX(IX)).GT.SMAX) THEN
- ISAMAX = I
- SMAX = ABS(SX(IX))
- END IF
- IX = IX + INCX
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/blas_src/lsame.f b/mtx/blas_src/lsame.f
deleted file mode 100644
index f19f9cda9..000000000
--- a/mtx/blas_src/lsame.f
+++ /dev/null
@@ -1,125 +0,0 @@
-*> \brief \b LSAME
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* LOGICAL FUNCTION LSAME(CA,CB)
-*
-* .. Scalar Arguments ..
-* CHARACTER CA,CB
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> LSAME returns .TRUE. if CA is the same letter as CB regardless of
-*> case.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] CA
-*> \verbatim
-*> CA is CHARACTER*1
-*> \endverbatim
-*>
-*> \param[in] CB
-*> \verbatim
-*> CB is CHARACTER*1
-*> CA and CB specify the single characters to be compared.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup aux_blas
-*
-* =====================================================================
- LOGICAL FUNCTION LSAME(CA,CB)
-*
-* -- Reference BLAS level1 routine (version 3.1) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER CA,CB
-* ..
-*
-* =====================================================================
-*
-* .. Intrinsic Functions ..
- INTRINSIC ICHAR
-* ..
-* .. Local Scalars ..
- INTEGER INTA,INTB,ZCODE
-* ..
-*
-* Test if the characters are equal
-*
- LSAME = CA .EQ. CB
- IF (LSAME) RETURN
-*
-* Now test for equivalence if both characters are alphabetic.
-*
- ZCODE = ICHAR('Z')
-*
-* Use 'Z' rather than 'A' so that ASCII can be detected on Prime
-* machines, on which ICHAR returns a value with bit 8 set.
-* ICHAR('A') on Prime machines returns 193 which is the same as
-* ICHAR('A') on an EBCDIC machine.
-*
- INTA = ICHAR(CA)
- INTB = ICHAR(CB)
-*
- IF (ZCODE.EQ.90 .OR. ZCODE.EQ.122) THEN
-*
-* ASCII is assumed - ZCODE is the ASCII code of either lower or
-* upper case 'Z'.
-*
- IF (INTA.GE.97 .AND. INTA.LE.122) INTA = INTA - 32
- IF (INTB.GE.97 .AND. INTB.LE.122) INTB = INTB - 32
-*
- ELSE IF (ZCODE.EQ.233 .OR. ZCODE.EQ.169) THEN
-*
-* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
-* upper case 'Z'.
-*
- IF (INTA.GE.129 .AND. INTA.LE.137 .OR.
- + INTA.GE.145 .AND. INTA.LE.153 .OR.
- + INTA.GE.162 .AND. INTA.LE.169) INTA = INTA + 64
- IF (INTB.GE.129 .AND. INTB.LE.137 .OR.
- + INTB.GE.145 .AND. INTB.LE.153 .OR.
- + INTB.GE.162 .AND. INTB.LE.169) INTB = INTB + 64
-*
- ELSE IF (ZCODE.EQ.218 .OR. ZCODE.EQ.250) THEN
-*
-* ASCII is assumed, on Prime machines - ZCODE is the ASCII code
-* plus 128 of either lower or upper case 'Z'.
-*
- IF (INTA.GE.225 .AND. INTA.LE.250) INTA = INTA - 32
- IF (INTB.GE.225 .AND. INTB.LE.250) INTB = INTB - 32
- END IF
- LSAME = INTA .EQ. INTB
-*
-* RETURN
-*
-* End of LSAME
-*
- END
diff --git a/mtx/blas_src/sgemm.f b/mtx/blas_src/sgemm.f
deleted file mode 100644
index 9a3d9e1ad..000000000
--- a/mtx/blas_src/sgemm.f
+++ /dev/null
@@ -1,388 +0,0 @@
-*> \brief \b SGEMM
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
-*
-* .. Scalar Arguments ..
-* REAL ALPHA,BETA
-* INTEGER K,LDA,LDB,LDC,M,N
-* CHARACTER TRANSA,TRANSB
-* ..
-* .. Array Arguments ..
-* REAL A(LDA,*),B(LDB,*),C(LDC,*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANSA
-*> \verbatim
-*> TRANSA is CHARACTER*1
-*> On entry, TRANSA specifies the form of op( A ) to be used in
-*> the matrix multiplication as follows:
-*>
-*> TRANSA = 'N' or 'n', op( A ) = A.
-*>
-*> TRANSA = 'T' or 't', op( A ) = A**T.
-*>
-*> TRANSA = 'C' or 'c', op( A ) = A**T.
-*> \endverbatim
-*>
-*> \param[in] TRANSB
-*> \verbatim
-*> TRANSB is CHARACTER*1
-*> On entry, TRANSB specifies the form of op( B ) to be used in
-*> the matrix multiplication as follows:
-*>
-*> TRANSB = 'N' or 'n', op( B ) = B.
-*>
-*> TRANSB = 'T' or 't', op( B ) = B**T.
-*>
-*> TRANSB = 'C' or 'c', op( B ) = B**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the number of rows of the matrix
-*> op( A ) and of the matrix C. M must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of the matrix
-*> op( B ) and the number of columns of the matrix C. N must be
-*> at least zero.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> On entry, K specifies the number of columns of the matrix
-*> op( A ) and the number of rows of the matrix op( B ). K must
-*> be at least zero.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> On entry, ALPHA specifies the scalar alpha.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, ka ), where ka is
-*> k when TRANSA = 'N' or 'n', and is m otherwise.
-*> Before entry with TRANSA = 'N' or 'n', the leading m by k
-*> part of the array A must contain the matrix A, otherwise
-*> the leading k by m part of the array A must contain the
-*> matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. When TRANSA = 'N' or 'n' then
-*> LDA must be at least max( 1, m ), otherwise LDA must be at
-*> least max( 1, k ).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is REAL array of DIMENSION ( LDB, kb ), where kb is
-*> n when TRANSB = 'N' or 'n', and is k otherwise.
-*> Before entry with TRANSB = 'N' or 'n', the leading k by n
-*> part of the array B must contain the matrix B, otherwise
-*> the leading n by k part of the array B must contain the
-*> matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> On entry, LDB specifies the first dimension of B as declared
-*> in the calling (sub) program. When TRANSB = 'N' or 'n' then
-*> LDB must be at least max( 1, k ), otherwise LDB must be at
-*> least max( 1, n ).
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is REAL
-*> On entry, BETA specifies the scalar beta. When BETA is
-*> supplied as zero then C need not be set on input.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is REAL array of DIMENSION ( LDC, n ).
-*> Before entry, the leading m by n part of the array C must
-*> contain the matrix C, except when beta is zero, in which
-*> case C need not be set on entry.
-*> On exit, the array C is overwritten by the m by n matrix
-*> ( alpha*op( A )*op( B ) + beta*C ).
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> On entry, LDC specifies the first dimension of C as declared
-*> in the calling (sub) program. LDC must be at least
-*> max( 1, m ).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup single_blas_level3
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Level 3 Blas routine.
-*>
-*> -- Written on 8-February-1989.
-*> Jack Dongarra, Argonne National Laboratory.
-*> Iain Duff, AERE Harwell.
-*> Jeremy Du Croz, Numerical Algorithms Group Ltd.
-*> Sven Hammarling, Numerical Algorithms Group Ltd.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
-*
-* -- Reference BLAS level3 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- REAL ALPHA,BETA
- INTEGER K,LDA,LDB,LDC,M,N
- CHARACTER TRANSA,TRANSB
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),B(LDB,*),C(LDC,*)
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB
- LOGICAL NOTA,NOTB
-* ..
-* .. Parameters ..
- REAL ONE,ZERO
- PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-* ..
-*
-* Set NOTA and NOTB as true if A and B respectively are not
-* transposed and set NROWA, NCOLA and NROWB as the number of rows
-* and columns of A and the number of rows of B respectively.
-*
- NOTA = LSAME(TRANSA,'N')
- NOTB = LSAME(TRANSB,'N')
- IF (NOTA) THEN
- NROWA = M
- NCOLA = K
- ELSE
- NROWA = K
- NCOLA = M
- END IF
- IF (NOTB) THEN
- NROWB = K
- ELSE
- NROWB = N
- END IF
-*
-* Test the input parameters.
-*
- INFO = 0
- IF ((.NOT.NOTA) .AND. (.NOT.LSAME(TRANSA,'C')) .AND.
- + (.NOT.LSAME(TRANSA,'T'))) THEN
- INFO = 1
- ELSE IF ((.NOT.NOTB) .AND. (.NOT.LSAME(TRANSB,'C')) .AND.
- + (.NOT.LSAME(TRANSB,'T'))) THEN
- INFO = 2
- ELSE IF (M.LT.0) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (K.LT.0) THEN
- INFO = 5
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 8
- ELSE IF (LDB.LT.MAX(1,NROWB)) THEN
- INFO = 10
- ELSE IF (LDC.LT.MAX(1,M)) THEN
- INFO = 13
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SGEMM ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
- + (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
-*
-* And if alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,M
- C(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- DO 30 I = 1,M
- C(I,J) = BETA*C(I,J)
- 30 CONTINUE
- 40 CONTINUE
- END IF
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (NOTB) THEN
- IF (NOTA) THEN
-*
-* Form C := alpha*A*B + beta*C.
-*
- DO 90 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 50 I = 1,M
- C(I,J) = ZERO
- 50 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 60 I = 1,M
- C(I,J) = BETA*C(I,J)
- 60 CONTINUE
- END IF
- DO 80 L = 1,K
- IF (B(L,J).NE.ZERO) THEN
- TEMP = ALPHA*B(L,J)
- DO 70 I = 1,M
- C(I,J) = C(I,J) + TEMP*A(I,L)
- 70 CONTINUE
- END IF
- 80 CONTINUE
- 90 CONTINUE
- ELSE
-*
-* Form C := alpha*A**T*B + beta*C
-*
- DO 120 J = 1,N
- DO 110 I = 1,M
- TEMP = ZERO
- DO 100 L = 1,K
- TEMP = TEMP + A(L,I)*B(L,J)
- 100 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 110 CONTINUE
- 120 CONTINUE
- END IF
- ELSE
- IF (NOTA) THEN
-*
-* Form C := alpha*A*B**T + beta*C
-*
- DO 170 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 130 I = 1,M
- C(I,J) = ZERO
- 130 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 140 I = 1,M
- C(I,J) = BETA*C(I,J)
- 140 CONTINUE
- END IF
- DO 160 L = 1,K
- IF (B(J,L).NE.ZERO) THEN
- TEMP = ALPHA*B(J,L)
- DO 150 I = 1,M
- C(I,J) = C(I,J) + TEMP*A(I,L)
- 150 CONTINUE
- END IF
- 160 CONTINUE
- 170 CONTINUE
- ELSE
-*
-* Form C := alpha*A**T*B**T + beta*C
-*
- DO 200 J = 1,N
- DO 190 I = 1,M
- TEMP = ZERO
- DO 180 L = 1,K
- TEMP = TEMP + A(L,I)*B(J,L)
- 180 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 190 CONTINUE
- 200 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of SGEMM .
-*
- END
diff --git a/mtx/blas_src/sger.f b/mtx/blas_src/sger.f
deleted file mode 100644
index cf85ffdc0..000000000
--- a/mtx/blas_src/sger.f
+++ /dev/null
@@ -1,227 +0,0 @@
-*> \brief \b SGER
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
-*
-* .. Scalar Arguments ..
-* REAL ALPHA
-* INTEGER INCX,INCY,LDA,M,N
-* ..
-* .. Array Arguments ..
-* REAL A(LDA,*),X(*),Y(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the number of rows of the matrix A.
-*> M must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of the matrix A.
-*> N must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> On entry, ALPHA specifies the scalar alpha.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is REAL array of dimension at least
-*> ( 1 + ( m - 1 )*abs( INCX ) ).
-*> Before entry, the incremented array X must contain the m
-*> element vector x.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*> \endverbatim
-*>
-*> \param[in] Y
-*> \verbatim
-*> Y is REAL array of dimension at least
-*> ( 1 + ( n - 1 )*abs( INCY ) ).
-*> Before entry, the incremented array Y must contain the n
-*> element vector y.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> On entry, INCY specifies the increment for the elements of
-*> Y. INCY must not be zero.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n ).
-*> Before entry, the leading m by n part of the array A must
-*> contain the matrix of coefficients. On exit, A is
-*> overwritten by the updated matrix.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. LDA must be at least
-*> max( 1, m ).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup single_blas_level2
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Level 2 Blas routine.
-*>
-*> -- Written on 22-October-1986.
-*> Jack Dongarra, Argonne National Lab.
-*> Jeremy Du Croz, Nag Central Office.
-*> Sven Hammarling, Nag Central Office.
-*> Richard Hanson, Sandia National Labs.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
-*
-* -- Reference BLAS level2 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- REAL ALPHA
- INTEGER INCX,INCY,LDA,M,N
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),X(*),Y(*)
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER (ZERO=0.0E+0)
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,IX,J,JY,KX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (M.LT.0) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 5
- ELSE IF (INCY.EQ.0) THEN
- INFO = 7
- ELSE IF (LDA.LT.MAX(1,M)) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('SGER ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
- IF (INCY.GT.0) THEN
- JY = 1
- ELSE
- JY = 1 - (N-1)*INCY
- END IF
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (Y(JY).NE.ZERO) THEN
- TEMP = ALPHA*Y(JY)
- DO 10 I = 1,M
- A(I,J) = A(I,J) + X(I)*TEMP
- 10 CONTINUE
- END IF
- JY = JY + INCY
- 20 CONTINUE
- ELSE
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (M-1)*INCX
- END IF
- DO 40 J = 1,N
- IF (Y(JY).NE.ZERO) THEN
- TEMP = ALPHA*Y(JY)
- IX = KX
- DO 30 I = 1,M
- A(I,J) = A(I,J) + X(IX)*TEMP
- IX = IX + INCX
- 30 CONTINUE
- END IF
- JY = JY + INCY
- 40 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SGER .
-*
- END
diff --git a/mtx/blas_src/slamch.f b/mtx/blas_src/slamch.f
deleted file mode 100644
index 9b7da1f74..000000000
--- a/mtx/blas_src/slamch.f
+++ /dev/null
@@ -1,857 +0,0 @@
- REAL FUNCTION SLAMCH( CMACH )
-*
-* -- LAPACK auxiliary routine (version 1.1) --
-* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
-*
-* .. Scalar Arguments ..
- CHARACTER CMACH
-* ..
-*
-* Purpose
-* =======
-*
-* SLAMCH determines single precision machine parameters.
-*
-* Arguments
-* =========
-*
-* CMACH (input) CHARACTER*1
-* Specifies the value to be returned by SLAMCH:
-* = 'E' or 'e', SLAMCH := eps
-* = 'S' or 's , SLAMCH := sfmin
-* = 'B' or 'b', SLAMCH := base
-* = 'P' or 'p', SLAMCH := eps*base
-* = 'N' or 'n', SLAMCH := t
-* = 'R' or 'r', SLAMCH := rnd
-* = 'M' or 'm', SLAMCH := emin
-* = 'U' or 'u', SLAMCH := rmin
-* = 'L' or 'l', SLAMCH := emax
-* = 'O' or 'o', SLAMCH := rmax
-*
-* where
-*
-* eps = relative machine precision
-* sfmin = safe minimum, such that 1/sfmin does not overflow
-* base = base of the machine
-* prec = eps*base
-* t = number of (base) digits in the mantissa
-* rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
-* emin = minimum exponent before (gradual) underflow
-* rmin = underflow threshold - base**(emin-1)
-* emax = largest exponent before overflow
-* rmax = overflow threshold - (base**emax)*(1-eps)
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL FIRST, LRND
- INTEGER BETA, IMAX, IMIN, IT
- REAL BASE, EMAX, EMIN, EPS, PREC, RMACH, RMAX, RMIN,
- $ RND, SFMIN, SMALL, T
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLAMC2
-* ..
-* .. Save statement ..
- SAVE FIRST, EPS, SFMIN, BASE, T, RND, EMIN, RMIN,
- $ EMAX, RMAX, PREC
-* ..
-* .. Data statements ..
- DATA FIRST / .TRUE. /
-* ..
-* .. Executable Statements ..
-*
- IF( FIRST ) THEN
- FIRST = .FALSE.
- CALL SLAMC2( BETA, IT, LRND, EPS, IMIN, RMIN, IMAX, RMAX )
- BASE = BETA
- T = IT
- IF( LRND ) THEN
- RND = ONE
- EPS = ( BASE**( 1-IT ) ) / 2
- ELSE
- RND = ZERO
- EPS = BASE**( 1-IT )
- END IF
- PREC = EPS*BASE
- EMIN = IMIN
- EMAX = IMAX
- SFMIN = RMIN
- SMALL = ONE / RMAX
- IF( SMALL.GE.SFMIN ) THEN
-*
-* Use SMALL plus a bit, to avoid the possibility of rounding
-* causing overflow when computing 1/sfmin.
-*
- SFMIN = SMALL*( ONE+EPS )
- END IF
- END IF
-*
- IF( LSAME( CMACH, 'E' ) ) THEN
- RMACH = EPS
- ELSE IF( LSAME( CMACH, 'S' ) ) THEN
- RMACH = SFMIN
- ELSE IF( LSAME( CMACH, 'B' ) ) THEN
- RMACH = BASE
- ELSE IF( LSAME( CMACH, 'P' ) ) THEN
- RMACH = PREC
- ELSE IF( LSAME( CMACH, 'N' ) ) THEN
- RMACH = T
- ELSE IF( LSAME( CMACH, 'R' ) ) THEN
- RMACH = RND
- ELSE IF( LSAME( CMACH, 'M' ) ) THEN
- RMACH = EMIN
- ELSE IF( LSAME( CMACH, 'U' ) ) THEN
- RMACH = RMIN
- ELSE IF( LSAME( CMACH, 'L' ) ) THEN
- RMACH = EMAX
- ELSE IF( LSAME( CMACH, 'O' ) ) THEN
- RMACH = RMAX
- END IF
-*
- SLAMCH = RMACH
- RETURN
-*
-* End of SLAMCH
-*
- END
-*
-************************************************************************
-*
- SUBROUTINE SLAMC1( BETA, T, RND, IEEE1 )
-*
-* -- LAPACK auxiliary routine (version 1.1) --
-* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
-*
-* .. Scalar Arguments ..
- LOGICAL IEEE1, RND
- INTEGER BETA, T
-* ..
-*
-* Purpose
-* =======
-*
-* SLAMC1 determines the machine parameters given by BETA, T, RND, and
-* IEEE1.
-*
-* Arguments
-* =========
-*
-* BETA (output) INTEGER
-* The base of the machine.
-*
-* T (output) INTEGER
-* The number of ( BETA ) digits in the mantissa.
-*
-* RND (output) LOGICAL
-* Specifies whether proper rounding ( RND = .TRUE. ) or
-* chopping ( RND = .FALSE. ) occurs in addition. This may not
-* be a reliable guide to the way in which the machine performs
-* its arithmetic.
-*
-* IEEE1 (output) LOGICAL
-* Specifies whether rounding appears to be done in the IEEE
-* 'round to nearest' style.
-*
-* Further Details
-* ===============
-*
-* The routine is based on the routine ENVRON by Malcolm and
-* incorporates suggestions by Gentleman and Marovich. See
-*
-* Malcolm M. A. (1972) Algorithms to reveal properties of
-* floating-point arithmetic. Comms. of the ACM, 15, 949-951.
-*
-* Gentleman W. M. and Marovich S. B. (1974) More on algorithms
-* that reveal properties of floating point arithmetic units.
-* Comms. of the ACM, 17, 276-277.
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL FIRST, LIEEE1, LRND
- INTEGER LBETA, LT
- REAL A, B, C, F, ONE, QTR, SAVEC, T1, T2
-* ..
-* .. External Functions ..
- REAL SLAMC3
- EXTERNAL SLAMC3
-* ..
-* .. Save statement ..
- SAVE FIRST, LIEEE1, LBETA, LRND, LT
-* ..
-* .. Data statements ..
- DATA FIRST / .TRUE. /
-* ..
-* .. Executable Statements ..
-*
- IF( FIRST ) THEN
- FIRST = .FALSE.
- ONE = 1
-*
-* LBETA, LIEEE1, LT and LRND are the local values of BETA,
-* IEEE1, T and RND.
-*
-* Throughout this routine we use the function SLAMC3 to ensure
-* that relevant values are stored and not held in registers, or
-* are not affected by optimizers.
-*
-* Compute a = 2.0**m with the smallest positive integer m such
-* that
-*
-* fl( a + 1.0 ) = a.
-*
- A = 1
- C = 1
-*
-*+ WHILE( C.EQ.ONE )LOOP
- 10 CONTINUE
- IF( C.EQ.ONE ) THEN
- A = 2*A
- C = SLAMC3( A, ONE )
- C = SLAMC3( C, -A )
- GO TO 10
- END IF
-*+ END WHILE
-*
-* Now compute b = 2.0**m with the smallest positive integer m
-* such that
-*
-* fl( a + b ) .gt. a.
-*
- B = 1
- C = SLAMC3( A, B )
-*
-*+ WHILE( C.EQ.A )LOOP
- 20 CONTINUE
- IF( C.EQ.A ) THEN
- B = 2*B
- C = SLAMC3( A, B )
- GO TO 20
- END IF
-*+ END WHILE
-*
-* Now compute the base. a and c are neighbouring floating point
-* numbers in the interval ( beta**t, beta**( t + 1 ) ) and so
-* their difference is beta. Adding 0.25 to c is to ensure that it
-* is truncated to beta and not ( beta - 1 ).
-*
- QTR = ONE / 4
- SAVEC = C
- C = SLAMC3( C, -A )
- LBETA = C + QTR
-*
-* Now determine whether rounding or chopping occurs, by adding a
-* bit less than beta/2 and a bit more than beta/2 to a.
-*
- B = LBETA
- F = SLAMC3( B / 2, -B / 100 )
- C = SLAMC3( F, A )
- IF( C.EQ.A ) THEN
- LRND = .TRUE.
- ELSE
- LRND = .FALSE.
- END IF
- F = SLAMC3( B / 2, B / 100 )
- C = SLAMC3( F, A )
- IF( ( LRND ) .AND. ( C.EQ.A ) )
- $ LRND = .FALSE.
-*
-* Try and decide whether rounding is done in the IEEE 'round to
-* nearest' style. B/2 is half a unit in the last place of the two
-* numbers A and SAVEC. Furthermore, A is even, i.e. has last bit
-* zero, and SAVEC is odd. Thus adding B/2 to A should not change
-* A, but adding B/2 to SAVEC should change SAVEC.
-*
- T1 = SLAMC3( B / 2, A )
- T2 = SLAMC3( B / 2, SAVEC )
- LIEEE1 = ( T1.EQ.A ) .AND. ( T2.GT.SAVEC ) .AND. LRND
-*
-* Now find the mantissa, t. It should be the integer part of
-* log to the base beta of a, however it is safer to determine t
-* by powering. So we find t as the smallest positive integer for
-* which
-*
-* fl( beta**t + 1.0 ) = 1.0.
-*
- LT = 0
- A = 1
- C = 1
-*
-*+ WHILE( C.EQ.ONE )LOOP
- 30 CONTINUE
- IF( C.EQ.ONE ) THEN
- LT = LT + 1
- A = A*LBETA
- C = SLAMC3( A, ONE )
- C = SLAMC3( C, -A )
- GO TO 30
- END IF
-*+ END WHILE
-*
- END IF
-*
- BETA = LBETA
- T = LT
- RND = LRND
- IEEE1 = LIEEE1
- RETURN
-*
-* End of SLAMC1
-*
- END
-*
-************************************************************************
-*
- SUBROUTINE SLAMC2( BETA, T, RND, EPS, EMIN, RMIN, EMAX, RMAX )
-*
-* -- LAPACK auxiliary routine (version 1.1) --
-* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
-*
-* .. Scalar Arguments ..
- LOGICAL RND
- INTEGER BETA, EMAX, EMIN, T
- REAL EPS, RMAX, RMIN
-* ..
-*
-* Purpose
-* =======
-*
-* SLAMC2 determines the machine parameters specified in its argument
-* list.
-*
-* Arguments
-* =========
-*
-* BETA (output) INTEGER
-* The base of the machine.
-*
-* T (output) INTEGER
-* The number of ( BETA ) digits in the mantissa.
-*
-* RND (output) LOGICAL
-* Specifies whether proper rounding ( RND = .TRUE. ) or
-* chopping ( RND = .FALSE. ) occurs in addition. This may not
-* be a reliable guide to the way in which the machine performs
-* its arithmetic.
-*
-* EPS (output) REAL
-* The smallest positive number such that
-*
-* fl( 1.0 - EPS ) .LT. 1.0,
-*
-* where fl denotes the computed value.
-*
-* EMIN (output) INTEGER
-* The minimum exponent before (gradual) underflow occurs.
-*
-* RMIN (output) REAL
-* The smallest normalized number for the machine, given by
-* BASE**( EMIN - 1 ), where BASE is the floating point value
-* of BETA.
-*
-* EMAX (output) INTEGER
-* The maximum exponent before overflow occurs.
-*
-* RMAX (output) REAL
-* The largest positive number for the machine, given by
-* BASE**EMAX * ( 1 - EPS ), where BASE is the floating point
-* value of BETA.
-*
-* Further Details
-* ===============
-*
-* The computation of EPS is based on a routine PARANOIA by
-* W. Kahan of the University of California at Berkeley.
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL FIRST, IEEE, IWARN, LIEEE1, LRND
- INTEGER GNMIN, GPMIN, I, LBETA, LEMAX, LEMIN, LT,
- $ NGNMIN, NGPMIN
- REAL A, B, C, HALF, LEPS, LRMAX, LRMIN, ONE, RBASE,
- $ SIXTH, SMALL, THIRD, TWO, ZERO
-* ..
-* .. External Functions ..
- REAL SLAMC3
- EXTERNAL SLAMC3
-* ..
-* .. External Subroutines ..
- EXTERNAL SLAMC1, SLAMC4, SLAMC5
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Save statement ..
- SAVE FIRST, IWARN, LBETA, LEMAX, LEMIN, LEPS, LRMAX,
- $ LRMIN, LT
-* ..
-* .. Data statements ..
- DATA FIRST / .TRUE. / , IWARN / .FALSE. /
-* ..
-* .. Executable Statements ..
-*
- IF( FIRST ) THEN
- FIRST = .FALSE.
- ZERO = 0
- ONE = 1
- TWO = 2
-*
-* LBETA, LT, LRND, LEPS, LEMIN and LRMIN are the local values of
-* BETA, T, RND, EPS, EMIN and RMIN.
-*
-* Throughout this routine we use the function SLAMC3 to ensure
-* that relevant values are stored and not held in registers, or
-* are not affected by optimizers.
-*
-* SLAMC1 returns the parameters LBETA, LT, LRND and LIEEE1.
-*
- CALL SLAMC1( LBETA, LT, LRND, LIEEE1 )
-*
-* Start to find EPS.
-*
- B = LBETA
- A = B**( -LT )
- LEPS = A
-*
-* Try some tricks to see whether or not this is the correct EPS.
-*
- B = TWO / 3
- HALF = ONE / 2
- SIXTH = SLAMC3( B, -HALF )
- THIRD = SLAMC3( SIXTH, SIXTH )
- B = SLAMC3( THIRD, -HALF )
- B = SLAMC3( B, SIXTH )
- B = ABS( B )
- IF( B.LT.LEPS )
- $ B = LEPS
-*
- LEPS = 1
-*
-*+ WHILE( ( LEPS.GT.B ).AND.( B.GT.ZERO ) )LOOP
- 10 CONTINUE
- IF( ( LEPS.GT.B ) .AND. ( B.GT.ZERO ) ) THEN
- LEPS = B
- C = SLAMC3( HALF*LEPS, ( TWO**5 )*( LEPS**2 ) )
- C = SLAMC3( HALF, -C )
- B = SLAMC3( HALF, C )
- C = SLAMC3( HALF, -B )
- B = SLAMC3( HALF, C )
- GO TO 10
- END IF
-*+ END WHILE
-*
- IF( A.LT.LEPS )
- $ LEPS = A
-*
-* Computation of EPS complete.
-*
-* Now find EMIN. Let A = + or - 1, and + or - (1 + BASE**(-3)).
-* Keep dividing A by BETA until (gradual) underflow occurs. This
-* is detected when we cannot recover the previous A.
-*
- RBASE = ONE / LBETA
- SMALL = ONE
- DO 20 I = 1, 3
- SMALL = SLAMC3( SMALL*RBASE, ZERO )
- 20 CONTINUE
- A = SLAMC3( ONE, SMALL )
- CALL SLAMC4( NGPMIN, ONE, LBETA )
- CALL SLAMC4( NGNMIN, -ONE, LBETA )
- CALL SLAMC4( GPMIN, A, LBETA )
- CALL SLAMC4( GNMIN, -A, LBETA )
- IEEE = .FALSE.
-*
- IF( ( NGPMIN.EQ.NGNMIN ) .AND. ( GPMIN.EQ.GNMIN ) ) THEN
- IF( NGPMIN.EQ.GPMIN ) THEN
- LEMIN = NGPMIN
-* ( Non twos-complement machines, no gradual underflow;
-* e.g., VAX )
- ELSE IF( ( GPMIN-NGPMIN ).EQ.3 ) THEN
- LEMIN = NGPMIN - 1 + LT
- IEEE = .TRUE.
-* ( Non twos-complement machines, with gradual underflow;
-* e.g., IEEE standard followers )
- ELSE
- LEMIN = MIN( NGPMIN, GPMIN )
-* ( A guess; no known machine )
- IWARN = .TRUE.
- END IF
-*
- ELSE IF( ( NGPMIN.EQ.GPMIN ) .AND. ( NGNMIN.EQ.GNMIN ) ) THEN
- IF( ABS( NGPMIN-NGNMIN ).EQ.1 ) THEN
- LEMIN = MAX( NGPMIN, NGNMIN )
-* ( Twos-complement machines, no gradual underflow;
-* e.g., CYBER 205 )
- ELSE
- LEMIN = MIN( NGPMIN, NGNMIN )
-* ( A guess; no known machine )
- IWARN = .TRUE.
- END IF
-*
- ELSE IF( ( ABS( NGPMIN-NGNMIN ).EQ.1 ) .AND.
- $ ( GPMIN.EQ.GNMIN ) ) THEN
- IF( ( GPMIN-MIN( NGPMIN, NGNMIN ) ).EQ.3 ) THEN
- LEMIN = MAX( NGPMIN, NGNMIN ) - 1 + LT
-* ( Twos-complement machines with gradual underflow;
-* no known machine )
- ELSE
- LEMIN = MIN( NGPMIN, NGNMIN )
-* ( A guess; no known machine )
- IWARN = .TRUE.
- END IF
-*
- ELSE
- LEMIN = MIN( NGPMIN, NGNMIN, GPMIN, GNMIN )
-* ( A guess; no known machine )
- IWARN = .TRUE.
- END IF
-***
-* Comment out this if block if EMIN is ok
- IF( IWARN ) THEN
- FIRST = .TRUE.
- WRITE( 6, FMT = 9999 )LEMIN
- END IF
-***
-*
-* Assume IEEE arithmetic if we found denormalised numbers above,
-* or if arithmetic seems to round in the IEEE style, determined
-* in routine SLAMC1. A true IEEE machine should have both things
-* true; however, faulty machines may have one or the other.
-*
- IEEE = IEEE .OR. LIEEE1
-*
-* Compute RMIN by successive division by BETA. We could compute
-* RMIN as BASE**( EMIN - 1 ), but some machines underflow during
-* this computation.
-*
- LRMIN = 1
- DO 30 I = 1, 1 - LEMIN
- LRMIN = SLAMC3( LRMIN*RBASE, ZERO )
- 30 CONTINUE
-*
-* Finally, call SLAMC5 to compute EMAX and RMAX.
-*
- CALL SLAMC5( LBETA, LT, LEMIN, IEEE, LEMAX, LRMAX )
- END IF
-*
- BETA = LBETA
- T = LT
- RND = LRND
- EPS = LEPS
- EMIN = LEMIN
- RMIN = LRMIN
- EMAX = LEMAX
- RMAX = LRMAX
-*
- RETURN
-*
- 9999 FORMAT( / / ' WARNING. The value EMIN may be incorrect:-',
- $ ' EMIN = ', I8, /
- $ ' If, after inspection, the value EMIN looks',
- $ ' acceptable please comment out ',
- $ / ' the IF block as marked within the code of routine',
- $ ' SLAMC2,', / ' otherwise supply EMIN explicitly.', / )
-*
-* End of SLAMC2
-*
- END
-*
-************************************************************************
-*
- REAL FUNCTION SLAMC3( A, B )
-*
-* -- LAPACK auxiliary routine (version 1.1) --
-* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
-*
-* .. Scalar Arguments ..
- REAL A, B
-* ..
-*
-* Purpose
-* =======
-*
-* SLAMC3 is intended to force A and B to be stored prior to doing
-* the addition of A and B , for use in situations where optimizers
-* might hold one of these in a register.
-*
-* Arguments
-* =========
-*
-* A, B (input) REAL
-* The values A and B.
-*
-* =====================================================================
-*
-* .. Executable Statements ..
-*
- SLAMC3 = A + B
-*
- RETURN
-*
-* End of SLAMC3
-*
- END
-*
-************************************************************************
-*
- SUBROUTINE SLAMC4( EMIN, START, BASE )
-*
-* -- LAPACK auxiliary routine (version 1.1) --
-* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
-*
-* .. Scalar Arguments ..
- INTEGER BASE, EMIN
- REAL START
-* ..
-*
-* Purpose
-* =======
-*
-* SLAMC4 is a service routine for SLAMC2.
-*
-* Arguments
-* =========
-*
-* EMIN (output) EMIN
-* The minimum exponent before (gradual) underflow, computed by
-* setting A = START and dividing by BASE until the previous A
-* can not be recovered.
-*
-* START (input) REAL
-* The starting point for determining EMIN.
-*
-* BASE (input) INTEGER
-* The base of the machine.
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I
- REAL A, B1, B2, C1, C2, D1, D2, ONE, RBASE, ZERO
-* ..
-* .. External Functions ..
- REAL SLAMC3
- EXTERNAL SLAMC3
-* ..
-* .. Executable Statements ..
-*
- A = START
- ONE = 1
- RBASE = ONE / BASE
- ZERO = 0
- EMIN = 1
- B1 = SLAMC3( A*RBASE, ZERO )
- C1 = A
- C2 = A
- D1 = A
- D2 = A
-*+ WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND.
-* $ ( D1.EQ.A ).AND.( D2.EQ.A ) )LOOP
- 10 CONTINUE
- IF( ( C1.EQ.A ) .AND. ( C2.EQ.A ) .AND. ( D1.EQ.A ) .AND.
- $ ( D2.EQ.A ) ) THEN
- EMIN = EMIN - 1
- A = B1
- B1 = SLAMC3( A / BASE, ZERO )
- C1 = SLAMC3( B1*BASE, ZERO )
- D1 = ZERO
- DO 20 I = 1, BASE
- D1 = D1 + B1
- 20 CONTINUE
- B2 = SLAMC3( A*RBASE, ZERO )
- C2 = SLAMC3( B2 / RBASE, ZERO )
- D2 = ZERO
- DO 30 I = 1, BASE
- D2 = D2 + B2
- 30 CONTINUE
- GO TO 10
- END IF
-*+ END WHILE
-*
- RETURN
-*
-* End of SLAMC4
-*
- END
-*
-************************************************************************
-*
- SUBROUTINE SLAMC5( BETA, P, EMIN, IEEE, EMAX, RMAX )
-*
-* -- LAPACK auxiliary routine (version 1.1) --
-* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
-*
-* .. Scalar Arguments ..
- LOGICAL IEEE
- INTEGER BETA, EMAX, EMIN, P
- REAL RMAX
-* ..
-*
-* Purpose
-* =======
-*
-* SLAMC5 attempts to compute RMAX, the largest machine floating-point
-* number, without overflow. It assumes that EMAX + abs(EMIN) sum
-* approximately to a power of 2. It will fail on machines where this
-* assumption does not hold, for example, the Cyber 205 (EMIN = -28625,
-* EMAX = 28718). It will also fail if the value supplied for EMIN is
-* too large (i.e. too close to zero), probably with overflow.
-*
-* Arguments
-* =========
-*
-* BETA (input) INTEGER
-* The base of floating-point arithmetic.
-*
-* P (input) INTEGER
-* The number of base BETA digits in the mantissa of a
-* floating-point value.
-*
-* EMIN (input) INTEGER
-* The minimum exponent before (gradual) underflow.
-*
-* IEEE (input) LOGICAL
-* A logical flag specifying whether or not the arithmetic
-* system is thought to comply with the IEEE standard.
-*
-* EMAX (output) INTEGER
-* The largest exponent before overflow
-*
-* RMAX (output) REAL
-* The largest machine floating-point number.
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
-* ..
-* .. Local Scalars ..
- INTEGER EXBITS, EXPSUM, I, LEXP, NBITS, TRY, UEXP
- REAL OLDY, RECBAS, Y, Z
-* ..
-* .. External Functions ..
- REAL SLAMC3
- EXTERNAL SLAMC3
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
-* .. Executable Statements ..
-*
-* First compute LEXP and UEXP, two powers of 2 that bound
-* abs(EMIN). We then assume that EMAX + abs(EMIN) will sum
-* approximately to the bound that is closest to abs(EMIN).
-* (EMAX is the exponent of the required number RMAX).
-*
- LEXP = 1
- EXBITS = 1
- 10 CONTINUE
- TRY = LEXP*2
- IF( TRY.LE.( -EMIN ) ) THEN
- LEXP = TRY
- EXBITS = EXBITS + 1
- GO TO 10
- END IF
- IF( LEXP.EQ.-EMIN ) THEN
- UEXP = LEXP
- ELSE
- UEXP = TRY
- EXBITS = EXBITS + 1
- END IF
-*
-* Now -LEXP is less than or equal to EMIN, and -UEXP is greater
-* than or equal to EMIN. EXBITS is the number of bits needed to
-* store the exponent.
-*
- IF( ( UEXP+EMIN ).GT.( -LEXP-EMIN ) ) THEN
- EXPSUM = 2*LEXP
- ELSE
- EXPSUM = 2*UEXP
- END IF
-*
-* EXPSUM is the exponent range, approximately equal to
-* EMAX - EMIN + 1 .
-*
- EMAX = EXPSUM + EMIN - 1
- NBITS = 1 + EXBITS + P
-*
-* NBITS is the total number of bits needed to store a
-* floating-point number.
-*
- IF( ( MOD( NBITS, 2 ).EQ.1 ) .AND. ( BETA.EQ.2 ) ) THEN
-*
-* Either there are an odd number of bits used to store a
-* floating-point number, which is unlikely, or some bits are
-* not used in the representation of numbers, which is possible,
-* (e.g. Cray machines) or the mantissa has an implicit bit,
-* (e.g. IEEE machines, Dec Vax machines), which is perhaps the
-* most likely. We have to assume the last alternative.
-* If this is true, then we need to reduce EMAX by one because
-* there must be some way of representing zero in an implicit-bit
-* system. On machines like Cray, we are reducing EMAX by one
-* unnecessarily.
-*
- EMAX = EMAX - 1
- END IF
-*
- IF( IEEE ) THEN
-*
-* Assume we are on an IEEE machine which reserves one exponent
-* for infinity and NaN.
-*
- EMAX = EMAX - 1
- END IF
-*
-* Now create RMAX, the largest machine number, which should
-* be equal to (1.0 - BETA**(-P)) * BETA**EMAX .
-*
-* First compute 1.0 - BETA**(-P), being careful that the
-* result is less than 1.0 .
-*
- RECBAS = ONE / BETA
- Z = BETA - ONE
- Y = ZERO
- DO 20 I = 1, P
- Z = Z*RECBAS
- IF( Y.LT.ONE )
- $ OLDY = Y
- Y = SLAMC3( Y, Z )
- 20 CONTINUE
- IF( Y.GE.ONE )
- $ Y = OLDY
-*
-* Now multiply by BETA**EMAX to get RMAX.
-*
- DO 30 I = 1, EMAX
- Y = SLAMC3( Y*BETA, ZERO )
- 30 CONTINUE
-*
- RMAX = Y
- RETURN
-*
-* End of SLAMC5
-*
- END
diff --git a/mtx/blas_src/sscal.f b/mtx/blas_src/sscal.f
deleted file mode 100644
index b4b086252..000000000
--- a/mtx/blas_src/sscal.f
+++ /dev/null
@@ -1,110 +0,0 @@
-*> \brief \b SSCAL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSCAL(N,SA,SX,INCX)
-*
-* .. Scalar Arguments ..
-* REAL SA
-* INTEGER INCX,N
-* ..
-* .. Array Arguments ..
-* REAL SX(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> scales a vector by a constant.
-*> uses unrolled loops for increment equal to 1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup single_blas_level1
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> jack dongarra, linpack, 3/11/78.
-*> modified 3/93 to return if incx .le. 0.
-*> modified 12/3/93, array(1) declarations changed to array(*)
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SSCAL(N,SA,SX,INCX)
-*
-* -- Reference BLAS level1 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- REAL SA
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- REAL SX(*)
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I,M,MP1,NINCX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- IF (N.LE.0 .OR. INCX.LE.0) RETURN
- IF (INCX.EQ.1) THEN
-*
-* code for increment equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,5)
- IF (M.NE.0) THEN
- DO I = 1,M
- SX(I) = SA*SX(I)
- END DO
- IF (N.LT.5) RETURN
- END IF
- MP1 = M + 1
- DO I = MP1,N,5
- SX(I) = SA*SX(I)
- SX(I+1) = SA*SX(I+1)
- SX(I+2) = SA*SX(I+2)
- SX(I+3) = SA*SX(I+3)
- SX(I+4) = SA*SX(I+4)
- END DO
- ELSE
-*
-* code for increment not equal to 1
-*
- NINCX = N*INCX
- DO I = 1,NINCX,INCX
- SX(I) = SA*SX(I)
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/blas_src/sswap.f b/mtx/blas_src/sswap.f
deleted file mode 100644
index ad5a7f5c6..000000000
--- a/mtx/blas_src/sswap.f
+++ /dev/null
@@ -1,122 +0,0 @@
-*> \brief \b SSWAP
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SSWAP(N,SX,INCX,SY,INCY)
-*
-* .. Scalar Arguments ..
-* INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
-* REAL SX(*),SY(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> interchanges two vectors.
-*> uses unrolled loops for increments equal to 1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup single_blas_level1
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> jack dongarra, linpack, 3/11/78.
-*> modified 12/3/93, array(1) declarations changed to array(*)
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SSWAP(N,SX,INCX,SY,INCY)
-*
-* -- Reference BLAS level1 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- REAL SX(*),SY(*)
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL STEMP
- INTEGER I,IX,IY,M,MP1
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MOD
-* ..
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
-*
-* clean-up loop
-*
- M = MOD(N,3)
- IF (M.NE.0) THEN
- DO I = 1,M
- STEMP = SX(I)
- SX(I) = SY(I)
- SY(I) = STEMP
- END DO
- IF (N.LT.3) RETURN
- END IF
- MP1 = M + 1
- DO I = MP1,N,3
- STEMP = SX(I)
- SX(I) = SY(I)
- SY(I) = STEMP
- STEMP = SX(I+1)
- SX(I+1) = SY(I+1)
- SY(I+1) = STEMP
- STEMP = SX(I+2)
- SX(I+2) = SY(I+2)
- SY(I+2) = STEMP
- END DO
- ELSE
-*
-* code for unequal increments or equal increments not equal
-* to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- STEMP = SX(IX)
- SX(IX) = SY(IY)
- SY(IY) = STEMP
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/blas_src/strsm.f b/mtx/blas_src/strsm.f
deleted file mode 100644
index dad4bb057..000000000
--- a/mtx/blas_src/strsm.f
+++ /dev/null
@@ -1,443 +0,0 @@
-*> \brief \b STRSM
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE STRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
-*
-* .. Scalar Arguments ..
-* REAL ALPHA
-* INTEGER LDA,LDB,M,N
-* CHARACTER DIAG,SIDE,TRANSA,UPLO
-* ..
-* .. Array Arguments ..
-* REAL A(LDA,*),B(LDB,*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> On entry, SIDE specifies whether op( A ) appears on the left
-*> or right of X as follows:
-*>
-*> SIDE = 'L' or 'l' op( A )*X = alpha*B.
-*>
-*> SIDE = 'R' or 'r' X*op( A ) = alpha*B.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> On entry, UPLO specifies whether the matrix A is an upper or
-*> lower triangular matrix as follows:
-*>
-*> UPLO = 'U' or 'u' A is an upper triangular matrix.
-*>
-*> UPLO = 'L' or 'l' A is a lower triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] TRANSA
-*> \verbatim
-*> TRANSA is CHARACTER*1
-*> On entry, TRANSA specifies the form of op( A ) to be used in
-*> the matrix multiplication as follows:
-*>
-*> TRANSA = 'N' or 'n' op( A ) = A.
-*>
-*> TRANSA = 'T' or 't' op( A ) = A**T.
-*>
-*> TRANSA = 'C' or 'c' op( A ) = A**T.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> On entry, DIAG specifies whether or not A is unit triangular
-*> as follows:
-*>
-*> DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*>
-*> DIAG = 'N' or 'n' A is not assumed to be unit
-*> triangular.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the number of rows of B. M must be at
-*> least zero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of B. N must be
-*> at least zero.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is REAL
-*> On entry, ALPHA specifies the scalar alpha. When alpha is
-*> zero then A is not referenced and B need not be set before
-*> entry.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, k ),
-*> where k is m when SIDE = 'L' or 'l'
-*> and k is n when SIDE = 'R' or 'r'.
-*> Before entry with UPLO = 'U' or 'u', the leading k by k
-*> upper triangular part of the array A must contain the upper
-*> triangular matrix and the strictly lower triangular part of
-*> A is not referenced.
-*> Before entry with UPLO = 'L' or 'l', the leading k by k
-*> lower triangular part of the array A must contain the lower
-*> triangular matrix and the strictly upper triangular part of
-*> A is not referenced.
-*> Note that when DIAG = 'U' or 'u', the diagonal elements of
-*> A are not referenced either, but are assumed to be unity.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. When SIDE = 'L' or 'l' then
-*> LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
-*> then LDA must be at least max( 1, n ).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array of DIMENSION ( LDB, n ).
-*> Before entry, the leading m by n part of the array B must
-*> contain the right-hand side matrix B, and on exit is
-*> overwritten by the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> On entry, LDB specifies the first dimension of B as declared
-*> in the calling (sub) program. LDB must be at least
-*> max( 1, m ).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup single_blas_level3
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Level 3 Blas routine.
-*>
-*>
-*> -- Written on 8-February-1989.
-*> Jack Dongarra, Argonne National Laboratory.
-*> Iain Duff, AERE Harwell.
-*> Jeremy Du Croz, Numerical Algorithms Group Ltd.
-*> Sven Hammarling, Numerical Algorithms Group Ltd.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE STRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
-*
-* -- Reference BLAS level3 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- REAL ALPHA
- INTEGER LDA,LDB,M,N
- CHARACTER DIAG,SIDE,TRANSA,UPLO
-* ..
-* .. Array Arguments ..
- REAL A(LDA,*),B(LDB,*)
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- REAL TEMP
- INTEGER I,INFO,J,K,NROWA
- LOGICAL LSIDE,NOUNIT,UPPER
-* ..
-* .. Parameters ..
- REAL ONE,ZERO
- PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-* ..
-*
-* Test the input parameters.
-*
- LSIDE = LSAME(SIDE,'L')
- IF (LSIDE) THEN
- NROWA = M
- ELSE
- NROWA = N
- END IF
- NOUNIT = LSAME(DIAG,'N')
- UPPER = LSAME(UPLO,'U')
-*
- INFO = 0
- IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
- INFO = 1
- ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
- INFO = 2
- ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
- + (.NOT.LSAME(TRANSA,'T')) .AND.
- + (.NOT.LSAME(TRANSA,'C'))) THEN
- INFO = 3
- ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
- INFO = 4
- ELSE IF (M.LT.0) THEN
- INFO = 5
- ELSE IF (N.LT.0) THEN
- INFO = 6
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 9
- ELSE IF (LDB.LT.MAX(1,M)) THEN
- INFO = 11
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('STRSM ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (M.EQ.0 .OR. N.EQ.0) RETURN
-*
-* And when alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,M
- B(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (LSIDE) THEN
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*inv( A )*B.
-*
- IF (UPPER) THEN
- DO 60 J = 1,N
- IF (ALPHA.NE.ONE) THEN
- DO 30 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 30 CONTINUE
- END IF
- DO 50 K = M,1,-1
- IF (B(K,J).NE.ZERO) THEN
- IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
- DO 40 I = 1,K - 1
- B(I,J) = B(I,J) - B(K,J)*A(I,K)
- 40 CONTINUE
- END IF
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- DO 100 J = 1,N
- IF (ALPHA.NE.ONE) THEN
- DO 70 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 70 CONTINUE
- END IF
- DO 90 K = 1,M
- IF (B(K,J).NE.ZERO) THEN
- IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
- DO 80 I = K + 1,M
- B(I,J) = B(I,J) - B(K,J)*A(I,K)
- 80 CONTINUE
- END IF
- 90 CONTINUE
- 100 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*inv( A**T )*B.
-*
- IF (UPPER) THEN
- DO 130 J = 1,N
- DO 120 I = 1,M
- TEMP = ALPHA*B(I,J)
- DO 110 K = 1,I - 1
- TEMP = TEMP - A(K,I)*B(K,J)
- 110 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(I,I)
- B(I,J) = TEMP
- 120 CONTINUE
- 130 CONTINUE
- ELSE
- DO 160 J = 1,N
- DO 150 I = M,1,-1
- TEMP = ALPHA*B(I,J)
- DO 140 K = I + 1,M
- TEMP = TEMP - A(K,I)*B(K,J)
- 140 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(I,I)
- B(I,J) = TEMP
- 150 CONTINUE
- 160 CONTINUE
- END IF
- END IF
- ELSE
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*B*inv( A ).
-*
- IF (UPPER) THEN
- DO 210 J = 1,N
- IF (ALPHA.NE.ONE) THEN
- DO 170 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 170 CONTINUE
- END IF
- DO 190 K = 1,J - 1
- IF (A(K,J).NE.ZERO) THEN
- DO 180 I = 1,M
- B(I,J) = B(I,J) - A(K,J)*B(I,K)
- 180 CONTINUE
- END IF
- 190 CONTINUE
- IF (NOUNIT) THEN
- TEMP = ONE/A(J,J)
- DO 200 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 200 CONTINUE
- END IF
- 210 CONTINUE
- ELSE
- DO 260 J = N,1,-1
- IF (ALPHA.NE.ONE) THEN
- DO 220 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 220 CONTINUE
- END IF
- DO 240 K = J + 1,N
- IF (A(K,J).NE.ZERO) THEN
- DO 230 I = 1,M
- B(I,J) = B(I,J) - A(K,J)*B(I,K)
- 230 CONTINUE
- END IF
- 240 CONTINUE
- IF (NOUNIT) THEN
- TEMP = ONE/A(J,J)
- DO 250 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 250 CONTINUE
- END IF
- 260 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*B*inv( A**T ).
-*
- IF (UPPER) THEN
- DO 310 K = N,1,-1
- IF (NOUNIT) THEN
- TEMP = ONE/A(K,K)
- DO 270 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 270 CONTINUE
- END IF
- DO 290 J = 1,K - 1
- IF (A(J,K).NE.ZERO) THEN
- TEMP = A(J,K)
- DO 280 I = 1,M
- B(I,J) = B(I,J) - TEMP*B(I,K)
- 280 CONTINUE
- END IF
- 290 CONTINUE
- IF (ALPHA.NE.ONE) THEN
- DO 300 I = 1,M
- B(I,K) = ALPHA*B(I,K)
- 300 CONTINUE
- END IF
- 310 CONTINUE
- ELSE
- DO 360 K = 1,N
- IF (NOUNIT) THEN
- TEMP = ONE/A(K,K)
- DO 320 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 320 CONTINUE
- END IF
- DO 340 J = K + 1,N
- IF (A(J,K).NE.ZERO) THEN
- TEMP = A(J,K)
- DO 330 I = 1,M
- B(I,J) = B(I,J) - TEMP*B(I,K)
- 330 CONTINUE
- END IF
- 340 CONTINUE
- IF (ALPHA.NE.ONE) THEN
- DO 350 I = 1,M
- B(I,K) = ALPHA*B(I,K)
- 350 CONTINUE
- END IF
- 360 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of STRSM .
-*
- END
diff --git a/mtx/blas_src/xerbla.f b/mtx/blas_src/xerbla.f
deleted file mode 100644
index eb1c037d2..000000000
--- a/mtx/blas_src/xerbla.f
+++ /dev/null
@@ -1,89 +0,0 @@
-*> \brief \b XERBLA
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE XERBLA( SRNAME, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER*(*) SRNAME
-* INTEGER INFO
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SRNAME
-*> \verbatim
-*> SRNAME is CHARACTER*(*)
-*> The name of the routine which called XERBLA.
-*> \endverbatim
-*>
-*> \param[in] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> The position of the invalid parameter in the parameter list
-*> of the calling routine.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup aux_blas
-*
-* =====================================================================
- SUBROUTINE XERBLA( SRNAME, INFO )
-*
-* -- Reference BLAS level1 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER*(*) SRNAME
- INTEGER INFO
-* ..
-*
-* =====================================================================
-*
-* .. Intrinsic Functions ..
- INTRINSIC LEN_TRIM
-* ..
-* .. Executable Statements ..
-*
- WRITE( *, FMT = 9999 )SRNAME( 1:LEN_TRIM( SRNAME ) ), INFO
-*
- STOP
-*
- 9999 FORMAT( ' ** On entry to ', A, ' parameter number ', I2, ' had ',
- $ 'an illegal value' )
-*
-* End of XERBLA
-*
- END
diff --git a/mtx/blas_src/zaxpy.f b/mtx/blas_src/zaxpy.f
deleted file mode 100644
index e6f5e1f6d..000000000
--- a/mtx/blas_src/zaxpy.f
+++ /dev/null
@@ -1,102 +0,0 @@
-*> \brief \b ZAXPY
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZAXPY(N,ZA,ZX,INCX,ZY,INCY)
-*
-* .. Scalar Arguments ..
-* COMPLEX*16 ZA
-* INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
-* COMPLEX*16 ZX(*),ZY(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ZAXPY constant times a vector plus a vector.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16_blas_level1
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> jack dongarra, 3/11/78.
-*> modified 12/3/93, array(1) declarations changed to array(*)
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE ZAXPY(N,ZA,ZX,INCX,ZY,INCY)
-*
-* -- Reference BLAS level1 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- COMPLEX*16 ZA
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- COMPLEX*16 ZX(*),ZY(*)
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I,IX,IY
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DCABS1
- EXTERNAL DCABS1
-* ..
- IF (N.LE.0) RETURN
- IF (DCABS1(ZA).EQ.0.0d0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
- DO I = 1,N
- ZY(I) = ZY(I) + ZA*ZX(I)
- END DO
- ELSE
-*
-* code for unequal increments or equal increments
-* not equal to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- ZY(IY) = ZY(IY) + ZA*ZX(IX)
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
-*
- RETURN
- END
diff --git a/mtx/blas_src/zdotc.f b/mtx/blas_src/zdotc.f
deleted file mode 100644
index 660648bbe..000000000
--- a/mtx/blas_src/zdotc.f
+++ /dev/null
@@ -1,101 +0,0 @@
-*> \brief \b ZDOTC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* COMPLEX*16 FUNCTION ZDOTC(N,ZX,INCX,ZY,INCY)
-*
-* .. Scalar Arguments ..
-* INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
-* COMPLEX*16 ZX(*),ZY(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ZDOTC forms the dot product of a vector.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16_blas_level1
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> jack dongarra, 3/11/78.
-*> modified 12/3/93, array(1) declarations changed to array(*)
-*> \endverbatim
-*>
-* =====================================================================
- COMPLEX*16 FUNCTION ZDOTC(N,ZX,INCX,ZY,INCY)
-*
-* -- Reference BLAS level1 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- COMPLEX*16 ZX(*),ZY(*)
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- COMPLEX*16 ZTEMP
- INTEGER I,IX,IY
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DCONJG
-* ..
- ZTEMP = (0.0d0,0.0d0)
- ZDOTC = (0.0d0,0.0d0)
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
- DO I = 1,N
- ZTEMP = ZTEMP + DCONJG(ZX(I))*ZY(I)
- END DO
- ELSE
-*
-* code for unequal increments or equal increments
-* not equal to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- ZTEMP = ZTEMP + DCONJG(ZX(IX))*ZY(IY)
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- ZDOTC = ZTEMP
- RETURN
- END
diff --git a/mtx/blas_src/zgerc.f b/mtx/blas_src/zgerc.f
deleted file mode 100644
index accfeafc0..000000000
--- a/mtx/blas_src/zgerc.f
+++ /dev/null
@@ -1,227 +0,0 @@
-*> \brief \b ZGERC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZGERC(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
-*
-* .. Scalar Arguments ..
-* COMPLEX*16 ALPHA
-* INTEGER INCX,INCY,LDA,M,N
-* ..
-* .. Array Arguments ..
-* COMPLEX*16 A(LDA,*),X(*),Y(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> On entry, M specifies the number of rows of the matrix A.
-*> M must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the number of columns of the matrix A.
-*> N must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is COMPLEX*16
-*> On entry, ALPHA specifies the scalar alpha.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is COMPLEX*16 array of dimension at least
-*> ( 1 + ( m - 1 )*abs( INCX ) ).
-*> Before entry, the incremented array X must contain the m
-*> element vector x.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*> \endverbatim
-*>
-*> \param[in] Y
-*> \verbatim
-*> Y is COMPLEX*16 array of dimension at least
-*> ( 1 + ( n - 1 )*abs( INCY ) ).
-*> Before entry, the incremented array Y must contain the n
-*> element vector y.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> On entry, INCY specifies the increment for the elements of
-*> Y. INCY must not be zero.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
-*> Before entry, the leading m by n part of the array A must
-*> contain the matrix of coefficients. On exit, A is
-*> overwritten by the updated matrix.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. LDA must be at least
-*> max( 1, m ).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16_blas_level2
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Level 2 Blas routine.
-*>
-*> -- Written on 22-October-1986.
-*> Jack Dongarra, Argonne National Lab.
-*> Jeremy Du Croz, Nag Central Office.
-*> Sven Hammarling, Nag Central Office.
-*> Richard Hanson, Sandia National Labs.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE ZGERC(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
-*
-* -- Reference BLAS level2 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- COMPLEX*16 ALPHA
- INTEGER INCX,INCY,LDA,M,N
-* ..
-* .. Array Arguments ..
- COMPLEX*16 A(LDA,*),X(*),Y(*)
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX*16 ZERO
- PARAMETER (ZERO= (0.0D+0,0.0D+0))
-* ..
-* .. Local Scalars ..
- COMPLEX*16 TEMP
- INTEGER I,INFO,IX,J,JY,KX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DCONJG,MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (M.LT.0) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 5
- ELSE IF (INCY.EQ.0) THEN
- INFO = 7
- ELSE IF (LDA.LT.MAX(1,M)) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('ZGERC ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
- IF (INCY.GT.0) THEN
- JY = 1
- ELSE
- JY = 1 - (N-1)*INCY
- END IF
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (Y(JY).NE.ZERO) THEN
- TEMP = ALPHA*DCONJG(Y(JY))
- DO 10 I = 1,M
- A(I,J) = A(I,J) + X(I)*TEMP
- 10 CONTINUE
- END IF
- JY = JY + INCY
- 20 CONTINUE
- ELSE
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (M-1)*INCX
- END IF
- DO 40 J = 1,N
- IF (Y(JY).NE.ZERO) THEN
- TEMP = ALPHA*DCONJG(Y(JY))
- IX = KX
- DO 30 I = 1,M
- A(I,J) = A(I,J) + X(IX)*TEMP
- IX = IX + INCX
- 30 CONTINUE
- END IF
- JY = JY + INCY
- 40 CONTINUE
- END IF
-*
- RETURN
-*
-* End of ZGERC .
-*
- END
diff --git a/mtx/blas_src/zhemv.f b/mtx/blas_src/zhemv.f
deleted file mode 100644
index 34216fbff..000000000
--- a/mtx/blas_src/zhemv.f
+++ /dev/null
@@ -1,337 +0,0 @@
-*> \brief \b ZHEMV
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZHEMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
-*
-* .. Scalar Arguments ..
-* COMPLEX*16 ALPHA,BETA
-* INTEGER INCX,INCY,LDA,N
-* CHARACTER UPLO
-* ..
-* .. Array Arguments ..
-* COMPLEX*16 A(LDA,*),X(*),Y(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> On entry, UPLO specifies whether the upper or lower
-*> triangular part of the array A is to be referenced as
-*> follows:
-*>
-*> UPLO = 'U' or 'u' Only the upper triangular part of A
-*> is to be referenced.
-*>
-*> UPLO = 'L' or 'l' Only the lower triangular part of A
-*> is to be referenced.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the order of the matrix A.
-*> N must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is COMPLEX*16
-*> On entry, ALPHA specifies the scalar alpha.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
-*> Before entry with UPLO = 'U' or 'u', the leading n by n
-*> upper triangular part of the array A must contain the upper
-*> triangular part of the hermitian matrix and the strictly
-*> lower triangular part of A is not referenced.
-*> Before entry with UPLO = 'L' or 'l', the leading n by n
-*> lower triangular part of the array A must contain the lower
-*> triangular part of the hermitian matrix and the strictly
-*> upper triangular part of A is not referenced.
-*> Note that the imaginary parts of the diagonal elements need
-*> not be set and are assumed to be zero.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. LDA must be at least
-*> max( 1, n ).
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is COMPLEX*16 array of dimension at least
-*> ( 1 + ( n - 1 )*abs( INCX ) ).
-*> Before entry, the incremented array X must contain the n
-*> element vector x.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is COMPLEX*16
-*> On entry, BETA specifies the scalar beta. When BETA is
-*> supplied as zero then Y need not be set on input.
-*> \endverbatim
-*>
-*> \param[in,out] Y
-*> \verbatim
-*> Y is COMPLEX*16 array of dimension at least
-*> ( 1 + ( n - 1 )*abs( INCY ) ).
-*> Before entry, the incremented array Y must contain the n
-*> element vector y. On exit, Y is overwritten by the updated
-*> vector y.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> On entry, INCY specifies the increment for the elements of
-*> Y. INCY must not be zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16_blas_level2
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Level 2 Blas routine.
-*> The vector and matrix arguments are not referenced when N = 0, or M = 0
-*>
-*> -- Written on 22-October-1986.
-*> Jack Dongarra, Argonne National Lab.
-*> Jeremy Du Croz, Nag Central Office.
-*> Sven Hammarling, Nag Central Office.
-*> Richard Hanson, Sandia National Labs.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE ZHEMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
-*
-* -- Reference BLAS level2 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- COMPLEX*16 ALPHA,BETA
- INTEGER INCX,INCY,LDA,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- COMPLEX*16 A(LDA,*),X(*),Y(*)
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX*16 ONE
- PARAMETER (ONE= (1.0D+0,0.0D+0))
- COMPLEX*16 ZERO
- PARAMETER (ZERO= (0.0D+0,0.0D+0))
-* ..
-* .. Local Scalars ..
- COMPLEX*16 TEMP1,TEMP2
- INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE,DCONJG,MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (LDA.LT.MAX(1,N)) THEN
- INFO = 5
- ELSE IF (INCX.EQ.0) THEN
- INFO = 7
- ELSE IF (INCY.EQ.0) THEN
- INFO = 10
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('ZHEMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
-* Set up the start points in X and Y.
-*
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (N-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (N-1)*INCY
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through the triangular part
-* of A.
-*
-* First form y := beta*y.
-*
- IF (BETA.NE.ONE) THEN
- IF (INCY.EQ.1) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 10 I = 1,N
- Y(I) = ZERO
- 10 CONTINUE
- ELSE
- DO 20 I = 1,N
- Y(I) = BETA*Y(I)
- 20 CONTINUE
- END IF
- ELSE
- IY = KY
- IF (BETA.EQ.ZERO) THEN
- DO 30 I = 1,N
- Y(IY) = ZERO
- IY = IY + INCY
- 30 CONTINUE
- ELSE
- DO 40 I = 1,N
- Y(IY) = BETA*Y(IY)
- IY = IY + INCY
- 40 CONTINUE
- END IF
- END IF
- END IF
- IF (ALPHA.EQ.ZERO) RETURN
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form y when A is stored in upper triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 60 J = 1,N
- TEMP1 = ALPHA*X(J)
- TEMP2 = ZERO
- DO 50 I = 1,J - 1
- Y(I) = Y(I) + TEMP1*A(I,J)
- TEMP2 = TEMP2 + DCONJG(A(I,J))*X(I)
- 50 CONTINUE
- Y(J) = Y(J) + TEMP1*DBLE(A(J,J)) + ALPHA*TEMP2
- 60 CONTINUE
- ELSE
- JX = KX
- JY = KY
- DO 80 J = 1,N
- TEMP1 = ALPHA*X(JX)
- TEMP2 = ZERO
- IX = KX
- IY = KY
- DO 70 I = 1,J - 1
- Y(IY) = Y(IY) + TEMP1*A(I,J)
- TEMP2 = TEMP2 + DCONJG(A(I,J))*X(IX)
- IX = IX + INCX
- IY = IY + INCY
- 70 CONTINUE
- Y(JY) = Y(JY) + TEMP1*DBLE(A(J,J)) + ALPHA*TEMP2
- JX = JX + INCX
- JY = JY + INCY
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form y when A is stored in lower triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 100 J = 1,N
- TEMP1 = ALPHA*X(J)
- TEMP2 = ZERO
- Y(J) = Y(J) + TEMP1*DBLE(A(J,J))
- DO 90 I = J + 1,N
- Y(I) = Y(I) + TEMP1*A(I,J)
- TEMP2 = TEMP2 + DCONJG(A(I,J))*X(I)
- 90 CONTINUE
- Y(J) = Y(J) + ALPHA*TEMP2
- 100 CONTINUE
- ELSE
- JX = KX
- JY = KY
- DO 120 J = 1,N
- TEMP1 = ALPHA*X(JX)
- TEMP2 = ZERO
- Y(JY) = Y(JY) + TEMP1*DBLE(A(J,J))
- IX = JX
- IY = JY
- DO 110 I = J + 1,N
- IX = IX + INCX
- IY = IY + INCY
- Y(IY) = Y(IY) + TEMP1*A(I,J)
- TEMP2 = TEMP2 + DCONJG(A(I,J))*X(IX)
- 110 CONTINUE
- Y(JY) = Y(JY) + ALPHA*TEMP2
- JX = JX + INCX
- JY = JY + INCY
- 120 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of ZHEMV .
-*
- END
diff --git a/mtx/blas_src/zher2.f b/mtx/blas_src/zher2.f
deleted file mode 100644
index e2a02c3c6..000000000
--- a/mtx/blas_src/zher2.f
+++ /dev/null
@@ -1,317 +0,0 @@
-*> \brief \b ZHER2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZHER2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
-*
-* .. Scalar Arguments ..
-* COMPLEX*16 ALPHA
-* INTEGER INCX,INCY,LDA,N
-* CHARACTER UPLO
-* ..
-* .. Array Arguments ..
-* COMPLEX*16 A(LDA,*),X(*),Y(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> On entry, UPLO specifies whether the upper or lower
-*> triangular part of the array A is to be referenced as
-*> follows:
-*>
-*> UPLO = 'U' or 'u' Only the upper triangular part of A
-*> is to be referenced.
-*>
-*> UPLO = 'L' or 'l' Only the lower triangular part of A
-*> is to be referenced.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the order of the matrix A.
-*> N must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is COMPLEX*16
-*> On entry, ALPHA specifies the scalar alpha.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is COMPLEX*16 array of dimension at least
-*> ( 1 + ( n - 1 )*abs( INCX ) ).
-*> Before entry, the incremented array X must contain the n
-*> element vector x.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*> \endverbatim
-*>
-*> \param[in] Y
-*> \verbatim
-*> Y is COMPLEX*16 array of dimension at least
-*> ( 1 + ( n - 1 )*abs( INCY ) ).
-*> Before entry, the incremented array Y must contain the n
-*> element vector y.
-*> \endverbatim
-*>
-*> \param[in] INCY
-*> \verbatim
-*> INCY is INTEGER
-*> On entry, INCY specifies the increment for the elements of
-*> Y. INCY must not be zero.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
-*> Before entry with UPLO = 'U' or 'u', the leading n by n
-*> upper triangular part of the array A must contain the upper
-*> triangular part of the hermitian matrix and the strictly
-*> lower triangular part of A is not referenced. On exit, the
-*> upper triangular part of the array A is overwritten by the
-*> upper triangular part of the updated matrix.
-*> Before entry with UPLO = 'L' or 'l', the leading n by n
-*> lower triangular part of the array A must contain the lower
-*> triangular part of the hermitian matrix and the strictly
-*> upper triangular part of A is not referenced. On exit, the
-*> lower triangular part of the array A is overwritten by the
-*> lower triangular part of the updated matrix.
-*> Note that the imaginary parts of the diagonal elements need
-*> not be set, they are assumed to be zero, and on exit they
-*> are set to zero.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. LDA must be at least
-*> max( 1, n ).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16_blas_level2
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Level 2 Blas routine.
-*>
-*> -- Written on 22-October-1986.
-*> Jack Dongarra, Argonne National Lab.
-*> Jeremy Du Croz, Nag Central Office.
-*> Sven Hammarling, Nag Central Office.
-*> Richard Hanson, Sandia National Labs.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE ZHER2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
-*
-* -- Reference BLAS level2 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- COMPLEX*16 ALPHA
- INTEGER INCX,INCY,LDA,N
- CHARACTER UPLO
-* ..
-* .. Array Arguments ..
- COMPLEX*16 A(LDA,*),X(*),Y(*)
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX*16 ZERO
- PARAMETER (ZERO= (0.0D+0,0.0D+0))
-* ..
-* .. Local Scalars ..
- COMPLEX*16 TEMP1,TEMP2
- INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE,DCONJG,MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 5
- ELSE IF (INCY.EQ.0) THEN
- INFO = 7
- ELSE IF (LDA.LT.MAX(1,N)) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('ZHER2 ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
-*
-* Set up the start points in X and Y if the increments are not both
-* unity.
-*
- IF ((INCX.NE.1) .OR. (INCY.NE.1)) THEN
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (N-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (N-1)*INCY
- END IF
- JX = KX
- JY = KY
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through the triangular part
-* of A.
-*
- IF (LSAME(UPLO,'U')) THEN
-*
-* Form A when A is stored in the upper triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 20 J = 1,N
- IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
- TEMP1 = ALPHA*DCONJG(Y(J))
- TEMP2 = DCONJG(ALPHA*X(J))
- DO 10 I = 1,J - 1
- A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
- 10 CONTINUE
- A(J,J) = DBLE(A(J,J)) +
- + DBLE(X(J)*TEMP1+Y(J)*TEMP2)
- ELSE
- A(J,J) = DBLE(A(J,J))
- END IF
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
- TEMP1 = ALPHA*DCONJG(Y(JY))
- TEMP2 = DCONJG(ALPHA*X(JX))
- IX = KX
- IY = KY
- DO 30 I = 1,J - 1
- A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
- IX = IX + INCX
- IY = IY + INCY
- 30 CONTINUE
- A(J,J) = DBLE(A(J,J)) +
- + DBLE(X(JX)*TEMP1+Y(JY)*TEMP2)
- ELSE
- A(J,J) = DBLE(A(J,J))
- END IF
- JX = JX + INCX
- JY = JY + INCY
- 40 CONTINUE
- END IF
- ELSE
-*
-* Form A when A is stored in the lower triangle.
-*
- IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
- DO 60 J = 1,N
- IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
- TEMP1 = ALPHA*DCONJG(Y(J))
- TEMP2 = DCONJG(ALPHA*X(J))
- A(J,J) = DBLE(A(J,J)) +
- + DBLE(X(J)*TEMP1+Y(J)*TEMP2)
- DO 50 I = J + 1,N
- A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
- 50 CONTINUE
- ELSE
- A(J,J) = DBLE(A(J,J))
- END IF
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
- TEMP1 = ALPHA*DCONJG(Y(JY))
- TEMP2 = DCONJG(ALPHA*X(JX))
- A(J,J) = DBLE(A(J,J)) +
- + DBLE(X(JX)*TEMP1+Y(JY)*TEMP2)
- IX = JX
- IY = JY
- DO 70 I = J + 1,N
- IX = IX + INCX
- IY = IY + INCY
- A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
- 70 CONTINUE
- ELSE
- A(J,J) = DBLE(A(J,J))
- END IF
- JX = JX + INCX
- JY = JY + INCY
- 80 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of ZHER2 .
-*
- END
diff --git a/mtx/blas_src/ztrsv.f b/mtx/blas_src/ztrsv.f
deleted file mode 100644
index f9fd4f840..000000000
--- a/mtx/blas_src/ztrsv.f
+++ /dev/null
@@ -1,375 +0,0 @@
-*> \brief \b ZTRSV
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
-*
-* .. Scalar Arguments ..
-* INTEGER INCX,LDA,N
-* CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
-* COMPLEX*16 A(LDA,*),X(*)
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> On entry, UPLO specifies whether the matrix is an upper or
-*> lower triangular matrix as follows:
-*>
-*> UPLO = 'U' or 'u' A is an upper triangular matrix.
-*>
-*> UPLO = 'L' or 'l' A is a lower triangular matrix.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> On entry, TRANS specifies the equations to be solved as
-*> follows:
-*>
-*> TRANS = 'N' or 'n' A*x = b.
-*>
-*> TRANS = 'T' or 't' A**T*x = b.
-*>
-*> TRANS = 'C' or 'c' A**H*x = b.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> On entry, DIAG specifies whether or not A is unit
-*> triangular as follows:
-*>
-*> DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*>
-*> DIAG = 'N' or 'n' A is not assumed to be unit
-*> triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> On entry, N specifies the order of the matrix A.
-*> N must be at least zero.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
-*> Before entry with UPLO = 'U' or 'u', the leading n by n
-*> upper triangular part of the array A must contain the upper
-*> triangular matrix and the strictly lower triangular part of
-*> A is not referenced.
-*> Before entry with UPLO = 'L' or 'l', the leading n by n
-*> lower triangular part of the array A must contain the lower
-*> triangular matrix and the strictly upper triangular part of
-*> A is not referenced.
-*> Note that when DIAG = 'U' or 'u', the diagonal elements of
-*> A are not referenced either, but are assumed to be unity.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> On entry, LDA specifies the first dimension of A as declared
-*> in the calling (sub) program. LDA must be at least
-*> max( 1, n ).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is COMPLEX*16 array of dimension at least
-*> ( 1 + ( n - 1 )*abs( INCX ) ).
-*> Before entry, the incremented array X must contain the n
-*> element right-hand side vector b. On exit, X is overwritten
-*> with the solution vector x.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> On entry, INCX specifies the increment for the elements of
-*> X. INCX must not be zero.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16_blas_level2
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Level 2 Blas routine.
-*>
-*> -- Written on 22-October-1986.
-*> Jack Dongarra, Argonne National Lab.
-*> Jeremy Du Croz, Nag Central Office.
-*> Sven Hammarling, Nag Central Office.
-*> Richard Hanson, Sandia National Labs.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE ZTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
-*
-* -- Reference BLAS level2 routine (version 3.4.0) --
-* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX,LDA,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- COMPLEX*16 A(LDA,*),X(*)
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX*16 ZERO
- PARAMETER (ZERO= (0.0D+0,0.0D+0))
-* ..
-* .. Local Scalars ..
- COMPLEX*16 TEMP
- INTEGER I,INFO,IX,J,JX,KX
- LOGICAL NOCONJ,NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DCONJG,MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (LDA.LT.MAX(1,N)) THEN
- INFO = 6
- ELSE IF (INCX.EQ.0) THEN
- INFO = 8
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('ZTRSV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOCONJ = LSAME(TRANS,'T')
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x := inv( A )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- IF (INCX.EQ.1) THEN
- DO 20 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- IF (NOUNIT) X(J) = X(J)/A(J,J)
- TEMP = X(J)
- DO 10 I = J - 1,1,-1
- X(I) = X(I) - TEMP*A(I,J)
- 10 CONTINUE
- END IF
- 20 CONTINUE
- ELSE
- JX = KX + (N-1)*INCX
- DO 40 J = N,1,-1
- IF (X(JX).NE.ZERO) THEN
- IF (NOUNIT) X(JX) = X(JX)/A(J,J)
- TEMP = X(JX)
- IX = JX
- DO 30 I = J - 1,1,-1
- IX = IX - INCX
- X(IX) = X(IX) - TEMP*A(I,J)
- 30 CONTINUE
- END IF
- JX = JX - INCX
- 40 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(J).NE.ZERO) THEN
- IF (NOUNIT) X(J) = X(J)/A(J,J)
- TEMP = X(J)
- DO 50 I = J + 1,N
- X(I) = X(I) - TEMP*A(I,J)
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE
- JX = KX
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- IF (NOUNIT) X(JX) = X(JX)/A(J,J)
- TEMP = X(JX)
- IX = JX
- DO 70 I = J + 1,N
- IX = IX + INCX
- X(IX) = X(IX) - TEMP*A(I,J)
- 70 CONTINUE
- END IF
- JX = JX + INCX
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := inv( A**T )*x or x := inv( A**H )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- IF (INCX.EQ.1) THEN
- DO 110 J = 1,N
- TEMP = X(J)
- IF (NOCONJ) THEN
- DO 90 I = 1,J - 1
- TEMP = TEMP - A(I,J)*X(I)
- 90 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- ELSE
- DO 100 I = 1,J - 1
- TEMP = TEMP - DCONJG(A(I,J))*X(I)
- 100 CONTINUE
- IF (NOUNIT) TEMP = TEMP/DCONJG(A(J,J))
- END IF
- X(J) = TEMP
- 110 CONTINUE
- ELSE
- JX = KX
- DO 140 J = 1,N
- IX = KX
- TEMP = X(JX)
- IF (NOCONJ) THEN
- DO 120 I = 1,J - 1
- TEMP = TEMP - A(I,J)*X(IX)
- IX = IX + INCX
- 120 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- ELSE
- DO 130 I = 1,J - 1
- TEMP = TEMP - DCONJG(A(I,J))*X(IX)
- IX = IX + INCX
- 130 CONTINUE
- IF (NOUNIT) TEMP = TEMP/DCONJG(A(J,J))
- END IF
- X(JX) = TEMP
- JX = JX + INCX
- 140 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 170 J = N,1,-1
- TEMP = X(J)
- IF (NOCONJ) THEN
- DO 150 I = N,J + 1,-1
- TEMP = TEMP - A(I,J)*X(I)
- 150 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- ELSE
- DO 160 I = N,J + 1,-1
- TEMP = TEMP - DCONJG(A(I,J))*X(I)
- 160 CONTINUE
- IF (NOUNIT) TEMP = TEMP/DCONJG(A(J,J))
- END IF
- X(J) = TEMP
- 170 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 200 J = N,1,-1
- IX = KX
- TEMP = X(JX)
- IF (NOCONJ) THEN
- DO 180 I = N,J + 1,-1
- TEMP = TEMP - A(I,J)*X(IX)
- IX = IX - INCX
- 180 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(J,J)
- ELSE
- DO 190 I = N,J + 1,-1
- TEMP = TEMP - DCONJG(A(I,J))*X(IX)
- IX = IX - INCX
- 190 CONTINUE
- IF (NOUNIT) TEMP = TEMP/DCONJG(A(J,J))
- END IF
- X(JX) = TEMP
- JX = JX - INCX
- 200 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of ZTRSV .
-*
- END
diff --git a/mtx/lapack_src/dbdsqr.f b/mtx/lapack_src/dbdsqr.f
deleted file mode 100644
index 007e99779..000000000
--- a/mtx/lapack_src/dbdsqr.f
+++ /dev/null
@@ -1,850 +0,0 @@
-*> \brief \b DBDSQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DBDSQR + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U,
-* LDU, C, LDC, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION C( LDC, * ), D( * ), E( * ), U( LDU, * ),
-* $ VT( LDVT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': B is upper bidiagonal;
-*> = 'L': B is lower bidiagonal.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix B. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NCVT
-*> \verbatim
-*> NCVT is INTEGER
-*> The number of columns of the matrix VT. NCVT >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRU
-*> \verbatim
-*> NRU is INTEGER
-*> The number of rows of the matrix U. NRU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NCC
-*> \verbatim
-*> NCC is INTEGER
-*> The number of columns of the matrix C. NCC >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the n diagonal elements of the bidiagonal matrix B.
-*> On exit, if INFO=0, the singular values of B in decreasing
-*> order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, the N-1 offdiagonal elements of the bidiagonal
-*> matrix B.
-*> On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
-*> will contain the diagonal and superdiagonal elements of a
-*> bidiagonal matrix orthogonally equivalent to the one given
-*> as input.
-*> \endverbatim
-*>
-*> \param[in,out] VT
-*> \verbatim
-*> VT is DOUBLE PRECISION array, dimension (LDVT, NCVT)
-*> On entry, an N-by-NCVT matrix VT.
-*> On exit, VT is overwritten by P**T * VT.
-*> Not referenced if NCVT = 0.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT.
-*> LDVT >= max(1,N) if NCVT > 0; LDVT >= 1 if NCVT = 0.
-*> \endverbatim
-*>
-*> \param[in,out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension (LDU, N)
-*> On entry, an NRU-by-N matrix U.
-*> On exit, U is overwritten by U * Q.
-*> Not referenced if NRU = 0.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= max(1,NRU).
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC, NCC)
-*> On entry, an N-by-NCC matrix C.
-*> On exit, C is overwritten by Q**T * C.
-*> Not referenced if NCC = 0.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C.
-*> LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: If INFO = -i, the i-th argument had an illegal value
-*> > 0:
-*> if NCVT = NRU = NCC = 0,
-*> = 1, a split was marked by a positive value in E
-*> = 2, current block of Z not diagonalized after 30*N
-*> iterations (in inner while loop)
-*> = 3, termination criterion of outer while loop not met
-*> (program created more than N unreduced blocks)
-*> else NCVT = NRU = NCC = 0,
-*> the algorithm did not converge; D and E contain the
-*> elements of a bidiagonal matrix which is orthogonally
-*> similar to the input matrix B; if INFO = i, i
-*> elements of E have not converged to zero.
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> TOLMUL DOUBLE PRECISION, default = max(10,min(100,EPS**(-1/8)))
-*> TOLMUL controls the convergence criterion of the QR loop.
-*> If it is positive, TOLMUL*EPS is the desired relative
-*> precision in the computed singular values.
-*> If it is negative, abs(TOLMUL*EPS*sigma_max) is the
-*> desired absolute accuracy in the computed singular
-*> values (corresponds to relative accuracy
-*> abs(TOLMUL*EPS) in the largest singular value.
-*> abs(TOLMUL) should be between 1 and 1/EPS, and preferably
-*> between 10 (for fast convergence) and .1/EPS
-*> (for there to be some accuracy in the results).
-*> Default is to lose at either one eighth or 2 of the
-*> available decimal digits in each computed singular value
-*> (whichever is smaller).
-*>
-*> MAXITR INTEGER, default = 6
-*> MAXITR controls the maximum number of passes of the
-*> algorithm through its inner loop. The algorithms stops
-*> (and so fails to converge) if the number of passes
-*> through the inner loop exceeds MAXITR*N**2.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U,
- $ LDU, C, LDC, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION C( LDC, * ), D( * ), E( * ), U( LDU, * ),
- $ VT( LDVT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION NEGONE
- PARAMETER ( NEGONE = -1.0D0 )
- DOUBLE PRECISION HNDRTH
- PARAMETER ( HNDRTH = 0.01D0 )
- DOUBLE PRECISION TEN
- PARAMETER ( TEN = 10.0D0 )
- DOUBLE PRECISION HNDRD
- PARAMETER ( HNDRD = 100.0D0 )
- DOUBLE PRECISION MEIGTH
- PARAMETER ( MEIGTH = -0.125D0 )
- INTEGER MAXITR
- PARAMETER ( MAXITR = 6 )
-* ..
-* .. Local Scalars ..
- LOGICAL LOWER, ROTATE
- INTEGER I, IDIR, ISUB, ITER, J, LL, LLL, M, MAXIT, NM1,
- $ NM12, NM13, OLDLL, OLDM
- DOUBLE PRECISION ABSE, ABSS, COSL, COSR, CS, EPS, F, G, H, MU,
- $ OLDCS, OLDSN, R, SHIFT, SIGMN, SIGMX, SINL,
- $ SINR, SLL, SMAX, SMIN, SMINL, SMINOA,
- $ SN, THRESH, TOL, TOLMUL, UNFL
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARTG, DLAS2, DLASQ1, DLASR, DLASV2, DROT,
- $ DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX, MIN, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- LOWER = LSAME( UPLO, 'L' )
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LOWER ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NCVT.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRU.LT.0 ) THEN
- INFO = -4
- ELSE IF( NCC.LT.0 ) THEN
- INFO = -5
- ELSE IF( ( NCVT.EQ.0 .AND. LDVT.LT.1 ) .OR.
- $ ( NCVT.GT.0 .AND. LDVT.LT.MAX( 1, N ) ) ) THEN
- INFO = -9
- ELSE IF( LDU.LT.MAX( 1, NRU ) ) THEN
- INFO = -11
- ELSE IF( ( NCC.EQ.0 .AND. LDC.LT.1 ) .OR.
- $ ( NCC.GT.0 .AND. LDC.LT.MAX( 1, N ) ) ) THEN
- INFO = -13
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DBDSQR', -INFO )
- RETURN
- END IF
- IF( N.EQ.0 )
- $ RETURN
- IF( N.EQ.1 )
- $ GO TO 160
-*
-* ROTATE is true if any singular vectors desired, false otherwise
-*
- ROTATE = ( NCVT.GT.0 ) .OR. ( NRU.GT.0 ) .OR. ( NCC.GT.0 )
-*
-* If no singular vectors desired, use qd algorithm
-*
- IF( .NOT.ROTATE ) THEN
- CALL DLASQ1( N, D, E, WORK, INFO )
-*
-* If INFO equals 2, dqds didn't finish, try to finish
-*
- IF( INFO .NE. 2 ) RETURN
- INFO = 0
- END IF
-*
- NM1 = N - 1
- NM12 = NM1 + NM1
- NM13 = NM12 + NM1
- IDIR = 0
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'Epsilon' )
- UNFL = DLAMCH( 'Safe minimum' )
-*
-* If matrix lower bidiagonal, rotate to be upper bidiagonal
-* by applying Givens rotations on the left
-*
- IF( LOWER ) THEN
- DO 10 I = 1, N - 1
- CALL DLARTG( D( I ), E( I ), CS, SN, R )
- D( I ) = R
- E( I ) = SN*D( I+1 )
- D( I+1 ) = CS*D( I+1 )
- WORK( I ) = CS
- WORK( NM1+I ) = SN
- 10 CONTINUE
-*
-* Update singular vectors if desired
-*
- IF( NRU.GT.0 )
- $ CALL DLASR( 'R', 'V', 'F', NRU, N, WORK( 1 ), WORK( N ), U,
- $ LDU )
- IF( NCC.GT.0 )
- $ CALL DLASR( 'L', 'V', 'F', N, NCC, WORK( 1 ), WORK( N ), C,
- $ LDC )
- END IF
-*
-* Compute singular values to relative accuracy TOL
-* (By setting TOL to be negative, algorithm will compute
-* singular values to absolute accuracy ABS(TOL)*norm(input matrix))
-*
- TOLMUL = MAX( TEN, MIN( HNDRD, EPS**MEIGTH ) )
- TOL = TOLMUL*EPS
-*
-* Compute approximate maximum, minimum singular values
-*
- SMAX = ZERO
- DO 20 I = 1, N
- SMAX = MAX( SMAX, ABS( D( I ) ) )
- 20 CONTINUE
- DO 30 I = 1, N - 1
- SMAX = MAX( SMAX, ABS( E( I ) ) )
- 30 CONTINUE
- SMINL = ZERO
- IF( TOL.GE.ZERO ) THEN
-*
-* Relative accuracy desired
-*
- SMINOA = ABS( D( 1 ) )
- IF( SMINOA.EQ.ZERO )
- $ GO TO 50
- MU = SMINOA
- DO 40 I = 2, N
- MU = ABS( D( I ) )*( MU / ( MU+ABS( E( I-1 ) ) ) )
- SMINOA = MIN( SMINOA, MU )
- IF( SMINOA.EQ.ZERO )
- $ GO TO 50
- 40 CONTINUE
- 50 CONTINUE
- SMINOA = SMINOA / SQRT( DBLE( N ) )
- THRESH = MAX( TOL*SMINOA, MAXITR*N*N*UNFL )
- ELSE
-*
-* Absolute accuracy desired
-*
- THRESH = MAX( ABS( TOL )*SMAX, MAXITR*N*N*UNFL )
- END IF
-*
-* Prepare for main iteration loop for the singular values
-* (MAXIT is the maximum number of passes through the inner
-* loop permitted before nonconvergence signalled.)
-*
- MAXIT = MAXITR*N*N
- ITER = 0
- OLDLL = -1
- OLDM = -1
-*
-* M points to last element of unconverged part of matrix
-*
- M = N
-*
-* Begin main iteration loop
-*
- 60 CONTINUE
-*
-* Check for convergence or exceeding iteration count
-*
- IF( M.LE.1 )
- $ GO TO 160
- IF( ITER.GT.MAXIT )
- $ GO TO 200
-*
-* Find diagonal block of matrix to work on
-*
- IF( TOL.LT.ZERO .AND. ABS( D( M ) ).LE.THRESH )
- $ D( M ) = ZERO
- SMAX = ABS( D( M ) )
- SMIN = SMAX
- DO 70 LLL = 1, M - 1
- LL = M - LLL
- ABSS = ABS( D( LL ) )
- ABSE = ABS( E( LL ) )
- IF( TOL.LT.ZERO .AND. ABSS.LE.THRESH )
- $ D( LL ) = ZERO
- IF( ABSE.LE.THRESH )
- $ GO TO 80
- SMIN = MIN( SMIN, ABSS )
- SMAX = MAX( SMAX, ABSS, ABSE )
- 70 CONTINUE
- LL = 0
- GO TO 90
- 80 CONTINUE
- E( LL ) = ZERO
-*
-* Matrix splits since E(LL) = 0
-*
- IF( LL.EQ.M-1 ) THEN
-*
-* Convergence of bottom singular value, return to top of loop
-*
- M = M - 1
- GO TO 60
- END IF
- 90 CONTINUE
- LL = LL + 1
-*
-* E(LL) through E(M-1) are nonzero, E(LL-1) is zero
-*
- IF( LL.EQ.M-1 ) THEN
-*
-* 2 by 2 block, handle separately
-*
- CALL DLASV2( D( M-1 ), E( M-1 ), D( M ), SIGMN, SIGMX, SINR,
- $ COSR, SINL, COSL )
- D( M-1 ) = SIGMX
- E( M-1 ) = ZERO
- D( M ) = SIGMN
-*
-* Compute singular vectors, if desired
-*
- IF( NCVT.GT.0 )
- $ CALL DROT( NCVT, VT( M-1, 1 ), LDVT, VT( M, 1 ), LDVT, COSR,
- $ SINR )
- IF( NRU.GT.0 )
- $ CALL DROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL, SINL )
- IF( NCC.GT.0 )
- $ CALL DROT( NCC, C( M-1, 1 ), LDC, C( M, 1 ), LDC, COSL,
- $ SINL )
- M = M - 2
- GO TO 60
- END IF
-*
-* If working on new submatrix, choose shift direction
-* (from larger end diagonal element towards smaller)
-*
- IF( LL.GT.OLDM .OR. M.LT.OLDLL ) THEN
- IF( ABS( D( LL ) ).GE.ABS( D( M ) ) ) THEN
-*
-* Chase bulge from top (big end) to bottom (small end)
-*
- IDIR = 1
- ELSE
-*
-* Chase bulge from bottom (big end) to top (small end)
-*
- IDIR = 2
- END IF
- END IF
-*
-* Apply convergence tests
-*
- IF( IDIR.EQ.1 ) THEN
-*
-* Run convergence test in forward direction
-* First apply standard test to bottom of matrix
-*
- IF( ABS( E( M-1 ) ).LE.ABS( TOL )*ABS( D( M ) ) .OR.
- $ ( TOL.LT.ZERO .AND. ABS( E( M-1 ) ).LE.THRESH ) ) THEN
- E( M-1 ) = ZERO
- GO TO 60
- END IF
-*
- IF( TOL.GE.ZERO ) THEN
-*
-* If relative accuracy desired,
-* apply convergence criterion forward
-*
- MU = ABS( D( LL ) )
- SMINL = MU
- DO 100 LLL = LL, M - 1
- IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
- E( LLL ) = ZERO
- GO TO 60
- END IF
- MU = ABS( D( LLL+1 ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
- SMINL = MIN( SMINL, MU )
- 100 CONTINUE
- END IF
-*
- ELSE
-*
-* Run convergence test in backward direction
-* First apply standard test to top of matrix
-*
- IF( ABS( E( LL ) ).LE.ABS( TOL )*ABS( D( LL ) ) .OR.
- $ ( TOL.LT.ZERO .AND. ABS( E( LL ) ).LE.THRESH ) ) THEN
- E( LL ) = ZERO
- GO TO 60
- END IF
-*
- IF( TOL.GE.ZERO ) THEN
-*
-* If relative accuracy desired,
-* apply convergence criterion backward
-*
- MU = ABS( D( M ) )
- SMINL = MU
- DO 110 LLL = M - 1, LL, -1
- IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
- E( LLL ) = ZERO
- GO TO 60
- END IF
- MU = ABS( D( LLL ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
- SMINL = MIN( SMINL, MU )
- 110 CONTINUE
- END IF
- END IF
- OLDLL = LL
- OLDM = M
-*
-* Compute shift. First, test if shifting would ruin relative
-* accuracy, and if so set the shift to zero.
-*
- IF( TOL.GE.ZERO .AND. N*TOL*( SMINL / SMAX ).LE.
- $ MAX( EPS, HNDRTH*TOL ) ) THEN
-*
-* Use a zero shift to avoid loss of relative accuracy
-*
- SHIFT = ZERO
- ELSE
-*
-* Compute the shift from 2-by-2 block at end of matrix
-*
- IF( IDIR.EQ.1 ) THEN
- SLL = ABS( D( LL ) )
- CALL DLAS2( D( M-1 ), E( M-1 ), D( M ), SHIFT, R )
- ELSE
- SLL = ABS( D( M ) )
- CALL DLAS2( D( LL ), E( LL ), D( LL+1 ), SHIFT, R )
- END IF
-*
-* Test if shift negligible, and if so set to zero
-*
- IF( SLL.GT.ZERO ) THEN
- IF( ( SHIFT / SLL )**2.LT.EPS )
- $ SHIFT = ZERO
- END IF
- END IF
-*
-* Increment iteration count
-*
- ITER = ITER + M - LL
-*
-* If SHIFT = 0, do simplified QR iteration
-*
- IF( SHIFT.EQ.ZERO ) THEN
- IF( IDIR.EQ.1 ) THEN
-*
-* Chase bulge from top to bottom
-* Save cosines and sines for later singular vector updates
-*
- CS = ONE
- OLDCS = ONE
- DO 120 I = LL, M - 1
- CALL DLARTG( D( I )*CS, E( I ), CS, SN, R )
- IF( I.GT.LL )
- $ E( I-1 ) = OLDSN*R
- CALL DLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, D( I ) )
- WORK( I-LL+1 ) = CS
- WORK( I-LL+1+NM1 ) = SN
- WORK( I-LL+1+NM12 ) = OLDCS
- WORK( I-LL+1+NM13 ) = OLDSN
- 120 CONTINUE
- H = D( M )*CS
- D( M ) = H*OLDCS
- E( M-1 ) = H*OLDSN
-*
-* Update singular vectors
-*
- IF( NCVT.GT.0 )
- $ CALL DLASR( 'L', 'V', 'F', M-LL+1, NCVT, WORK( 1 ),
- $ WORK( N ), VT( LL, 1 ), LDVT )
- IF( NRU.GT.0 )
- $ CALL DLASR( 'R', 'V', 'F', NRU, M-LL+1, WORK( NM12+1 ),
- $ WORK( NM13+1 ), U( 1, LL ), LDU )
- IF( NCC.GT.0 )
- $ CALL DLASR( 'L', 'V', 'F', M-LL+1, NCC, WORK( NM12+1 ),
- $ WORK( NM13+1 ), C( LL, 1 ), LDC )
-*
-* Test convergence
-*
- IF( ABS( E( M-1 ) ).LE.THRESH )
- $ E( M-1 ) = ZERO
-*
- ELSE
-*
-* Chase bulge from bottom to top
-* Save cosines and sines for later singular vector updates
-*
- CS = ONE
- OLDCS = ONE
- DO 130 I = M, LL + 1, -1
- CALL DLARTG( D( I )*CS, E( I-1 ), CS, SN, R )
- IF( I.LT.M )
- $ E( I ) = OLDSN*R
- CALL DLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, D( I ) )
- WORK( I-LL ) = CS
- WORK( I-LL+NM1 ) = -SN
- WORK( I-LL+NM12 ) = OLDCS
- WORK( I-LL+NM13 ) = -OLDSN
- 130 CONTINUE
- H = D( LL )*CS
- D( LL ) = H*OLDCS
- E( LL ) = H*OLDSN
-*
-* Update singular vectors
-*
- IF( NCVT.GT.0 )
- $ CALL DLASR( 'L', 'V', 'B', M-LL+1, NCVT, WORK( NM12+1 ),
- $ WORK( NM13+1 ), VT( LL, 1 ), LDVT )
- IF( NRU.GT.0 )
- $ CALL DLASR( 'R', 'V', 'B', NRU, M-LL+1, WORK( 1 ),
- $ WORK( N ), U( 1, LL ), LDU )
- IF( NCC.GT.0 )
- $ CALL DLASR( 'L', 'V', 'B', M-LL+1, NCC, WORK( 1 ),
- $ WORK( N ), C( LL, 1 ), LDC )
-*
-* Test convergence
-*
- IF( ABS( E( LL ) ).LE.THRESH )
- $ E( LL ) = ZERO
- END IF
- ELSE
-*
-* Use nonzero shift
-*
- IF( IDIR.EQ.1 ) THEN
-*
-* Chase bulge from top to bottom
-* Save cosines and sines for later singular vector updates
-*
- F = ( ABS( D( LL ) )-SHIFT )*
- $ ( SIGN( ONE, D( LL ) )+SHIFT / D( LL ) )
- G = E( LL )
- DO 140 I = LL, M - 1
- CALL DLARTG( F, G, COSR, SINR, R )
- IF( I.GT.LL )
- $ E( I-1 ) = R
- F = COSR*D( I ) + SINR*E( I )
- E( I ) = COSR*E( I ) - SINR*D( I )
- G = SINR*D( I+1 )
- D( I+1 ) = COSR*D( I+1 )
- CALL DLARTG( F, G, COSL, SINL, R )
- D( I ) = R
- F = COSL*E( I ) + SINL*D( I+1 )
- D( I+1 ) = COSL*D( I+1 ) - SINL*E( I )
- IF( I.LT.M-1 ) THEN
- G = SINL*E( I+1 )
- E( I+1 ) = COSL*E( I+1 )
- END IF
- WORK( I-LL+1 ) = COSR
- WORK( I-LL+1+NM1 ) = SINR
- WORK( I-LL+1+NM12 ) = COSL
- WORK( I-LL+1+NM13 ) = SINL
- 140 CONTINUE
- E( M-1 ) = F
-*
-* Update singular vectors
-*
- IF( NCVT.GT.0 )
- $ CALL DLASR( 'L', 'V', 'F', M-LL+1, NCVT, WORK( 1 ),
- $ WORK( N ), VT( LL, 1 ), LDVT )
- IF( NRU.GT.0 )
- $ CALL DLASR( 'R', 'V', 'F', NRU, M-LL+1, WORK( NM12+1 ),
- $ WORK( NM13+1 ), U( 1, LL ), LDU )
- IF( NCC.GT.0 )
- $ CALL DLASR( 'L', 'V', 'F', M-LL+1, NCC, WORK( NM12+1 ),
- $ WORK( NM13+1 ), C( LL, 1 ), LDC )
-*
-* Test convergence
-*
- IF( ABS( E( M-1 ) ).LE.THRESH )
- $ E( M-1 ) = ZERO
-*
- ELSE
-*
-* Chase bulge from bottom to top
-* Save cosines and sines for later singular vector updates
-*
- F = ( ABS( D( M ) )-SHIFT )*( SIGN( ONE, D( M ) )+SHIFT /
- $ D( M ) )
- G = E( M-1 )
- DO 150 I = M, LL + 1, -1
- CALL DLARTG( F, G, COSR, SINR, R )
- IF( I.LT.M )
- $ E( I ) = R
- F = COSR*D( I ) + SINR*E( I-1 )
- E( I-1 ) = COSR*E( I-1 ) - SINR*D( I )
- G = SINR*D( I-1 )
- D( I-1 ) = COSR*D( I-1 )
- CALL DLARTG( F, G, COSL, SINL, R )
- D( I ) = R
- F = COSL*E( I-1 ) + SINL*D( I-1 )
- D( I-1 ) = COSL*D( I-1 ) - SINL*E( I-1 )
- IF( I.GT.LL+1 ) THEN
- G = SINL*E( I-2 )
- E( I-2 ) = COSL*E( I-2 )
- END IF
- WORK( I-LL ) = COSR
- WORK( I-LL+NM1 ) = -SINR
- WORK( I-LL+NM12 ) = COSL
- WORK( I-LL+NM13 ) = -SINL
- 150 CONTINUE
- E( LL ) = F
-*
-* Test convergence
-*
- IF( ABS( E( LL ) ).LE.THRESH )
- $ E( LL ) = ZERO
-*
-* Update singular vectors if desired
-*
- IF( NCVT.GT.0 )
- $ CALL DLASR( 'L', 'V', 'B', M-LL+1, NCVT, WORK( NM12+1 ),
- $ WORK( NM13+1 ), VT( LL, 1 ), LDVT )
- IF( NRU.GT.0 )
- $ CALL DLASR( 'R', 'V', 'B', NRU, M-LL+1, WORK( 1 ),
- $ WORK( N ), U( 1, LL ), LDU )
- IF( NCC.GT.0 )
- $ CALL DLASR( 'L', 'V', 'B', M-LL+1, NCC, WORK( 1 ),
- $ WORK( N ), C( LL, 1 ), LDC )
- END IF
- END IF
-*
-* QR iteration finished, go back and check convergence
-*
- GO TO 60
-*
-* All singular values converged, so make them positive
-*
- 160 CONTINUE
- DO 170 I = 1, N
- IF( D( I ).LT.ZERO ) THEN
- D( I ) = -D( I )
-*
-* Change sign of singular vectors, if desired
-*
- IF( NCVT.GT.0 )
- $ CALL DSCAL( NCVT, NEGONE, VT( I, 1 ), LDVT )
- END IF
- 170 CONTINUE
-*
-* Sort the singular values into decreasing order (insertion sort on
-* singular values, but only one transposition per singular vector)
-*
- DO 190 I = 1, N - 1
-*
-* Scan for smallest D(I)
-*
- ISUB = 1
- SMIN = D( 1 )
- DO 180 J = 2, N + 1 - I
- IF( D( J ).LE.SMIN ) THEN
- ISUB = J
- SMIN = D( J )
- END IF
- 180 CONTINUE
- IF( ISUB.NE.N+1-I ) THEN
-*
-* Swap singular values and vectors
-*
- D( ISUB ) = D( N+1-I )
- D( N+1-I ) = SMIN
- IF( NCVT.GT.0 )
- $ CALL DSWAP( NCVT, VT( ISUB, 1 ), LDVT, VT( N+1-I, 1 ),
- $ LDVT )
- IF( NRU.GT.0 )
- $ CALL DSWAP( NRU, U( 1, ISUB ), 1, U( 1, N+1-I ), 1 )
- IF( NCC.GT.0 )
- $ CALL DSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), LDC )
- END IF
- 190 CONTINUE
- GO TO 220
-*
-* Maximum number of iterations exceeded, failure to converge
-*
- 200 CONTINUE
- INFO = 0
- DO 210 I = 1, N - 1
- IF( E( I ).NE.ZERO )
- $ INFO = INFO + 1
- 210 CONTINUE
- 220 CONTINUE
- RETURN
-*
-* End of DBDSQR
-*
- END
diff --git a/mtx/lapack_src/dcabs1.f b/mtx/lapack_src/dcabs1.f
deleted file mode 100644
index c4acbeb5a..000000000
--- a/mtx/lapack_src/dcabs1.f
+++ /dev/null
@@ -1,16 +0,0 @@
- DOUBLE PRECISION FUNCTION DCABS1(Z)
-* .. Scalar Arguments ..
- DOUBLE COMPLEX Z
-* ..
-* ..
-* Purpose
-* =======
-*
-* DCABS1 computes absolute value of a double complex number
-*
-* .. Intrinsic Functions ..
- INTRINSIC ABS,DBLE,DIMAG
-*
- DCABS1 = ABS(DBLE(Z)) + ABS(DIMAG(Z))
- RETURN
- END
diff --git a/mtx/lapack_src/dgbcon.f b/mtx/lapack_src/dgbcon.f
deleted file mode 100644
index bf6933faf..000000000
--- a/mtx/lapack_src/dgbcon.f
+++ /dev/null
@@ -1,311 +0,0 @@
-*> \brief \b DGBCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBCON + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER INFO, KL, KU, LDAB, N
-* DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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)) ).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies whether the 1-norm condition number or the
-*> infinity-norm condition number is required:
-*> = '1' or 'O': 1-norm;
-*> = 'I': Infinity-norm.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> Details of the LU factorization of the band matrix A, as
-*> computed by DGBTRF. U is stored as an upper triangular band
-*> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
-*> the multipliers used during the factorization are stored in
-*> rows KL+KU+2 to 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= N, row i of the matrix was
-*> interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is DOUBLE PRECISION
-*> If NORM = '1' or 'O', the 1-norm of the original matrix A.
-*> If NORM = 'I', the infinity-norm of the original matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(norm(A) * norm(inv(A))).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBcomputational
-*
-* =====================================================================
- SUBROUTINE DGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER INFO, KL, KU, LDAB, N
- DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LNOTI, ONENRM
- CHARACTER NORMIN
- INTEGER IX, J, JP, KASE, KASE1, KD, LM
- DOUBLE PRECISION AINVNM, SCALE, SMLNUM, T
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DDOT, DLAMCH
- EXTERNAL LSAME, IDAMAX, DDOT, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DLACN2, DLATBS, DRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
- IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.2*KL+KU+1 ) THEN
- INFO = -6
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
- SMLNUM = DLAMCH( 'Safe minimum' )
-*
-* Estimate the norm of inv(A).
-*
- AINVNM = ZERO
- NORMIN = 'N'
- IF( ONENRM ) THEN
- KASE1 = 1
- ELSE
- KASE1 = 2
- END IF
- KD = KL + KU + 1
- LNOTI = KL.GT.0
- KASE = 0
- 10 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.KASE1 ) THEN
-*
-* Multiply by inv(L).
-*
- IF( LNOTI ) THEN
- DO 20 J = 1, N - 1
- LM = MIN( KL, N-J )
- JP = IPIV( J )
- T = WORK( JP )
- IF( JP.NE.J ) THEN
- WORK( JP ) = WORK( J )
- WORK( J ) = T
- END IF
- CALL DAXPY( LM, -T, AB( KD+1, J ), 1, WORK( J+1 ), 1 )
- 20 CONTINUE
- END IF
-*
-* Multiply by inv(U).
-*
- CALL DLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
- $ KL+KU, AB, LDAB, WORK, SCALE, WORK( 2*N+1 ),
- $ INFO )
- ELSE
-*
-* Multiply by inv(U**T).
-*
- CALL DLATBS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N,
- $ KL+KU, AB, LDAB, WORK, SCALE, WORK( 2*N+1 ),
- $ INFO )
-*
-* Multiply by inv(L**T).
-*
- IF( LNOTI ) THEN
- DO 30 J = N - 1, 1, -1
- LM = MIN( KL, N-J )
- WORK( J ) = WORK( J ) - DDOT( LM, AB( KD+1, J ), 1,
- $ WORK( J+1 ), 1 )
- JP = IPIV( J )
- IF( JP.NE.J ) THEN
- T = WORK( JP )
- WORK( JP ) = WORK( J )
- WORK( J ) = T
- END IF
- 30 CONTINUE
- END IF
- END IF
-*
-* Divide X by 1/SCALE if doing so will not cause overflow.
-*
- NORMIN = 'Y'
- IF( SCALE.NE.ONE ) THEN
- IX = IDAMAX( N, WORK, 1 )
- IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 40
- CALL DRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- 40 CONTINUE
- RETURN
-*
-* End of DGBCON
-*
- END
diff --git a/mtx/lapack_src/dgbequ.f b/mtx/lapack_src/dgbequ.f
deleted file mode 100644
index cc94fdb5b..000000000
--- a/mtx/lapack_src/dgbequ.f
+++ /dev/null
@@ -1,324 +0,0 @@
-*> \brief \b DGBEQU
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBEQU + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
-* AMAX, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, M, N
-* DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The band matrix A, stored in rows 1 to KL+KU+1. The j-th
-*> column of A is stored in the j-th column of the array AB as
-*> follows:
-*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is DOUBLE PRECISION array, dimension (M)
-*> If INFO = 0, or INFO > M, R contains the row scale factors
-*> for A.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, C contains the column scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] ROWCND
-*> \verbatim
-*> ROWCND is DOUBLE PRECISION
-*> If INFO = 0 or INFO > M, ROWCND contains the ratio of the
-*> smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
-*> AMAX is neither too large nor too small, it is not worth
-*> scaling by R.
-*> \endverbatim
-*>
-*> \param[out] COLCND
-*> \verbatim
-*> COLCND is DOUBLE PRECISION
-*> If INFO = 0, COLCND contains the ratio of the smallest
-*> C(i) to the largest C(i). If COLCND >= 0.1, it is not
-*> worth scaling by C.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= M: the i-th row of A is exactly zero
-*> > M: the (i-M)-th column of A is exactly zero
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBcomputational
-*
-* =====================================================================
- SUBROUTINE DGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
- $ AMAX, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, M, N
- DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, KD
- DOUBLE PRECISION BIGNUM, RCMAX, RCMIN, SMLNUM
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KL+KU+1 ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBEQU', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- ROWCND = ONE
- COLCND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
-*
-* Compute row scale factors.
-*
- DO 10 I = 1, M
- R( I ) = ZERO
- 10 CONTINUE
-*
-* Find the maximum element in each row.
-*
- KD = KU + 1
- DO 30 J = 1, N
- DO 20 I = MAX( J-KU, 1 ), MIN( J+KL, M )
- R( I ) = MAX( R( I ), ABS( AB( KD+I-J, J ) ) )
- 20 CONTINUE
- 30 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 40 I = 1, M
- RCMAX = MAX( RCMAX, R( I ) )
- RCMIN = MIN( RCMIN, R( I ) )
- 40 CONTINUE
- AMAX = RCMAX
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 50 I = 1, M
- IF( R( I ).EQ.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 50 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 60 I = 1, M
- R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
- 60 CONTINUE
-*
-* Compute ROWCND = min(R(I)) / max(R(I))
-*
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
-* Compute column scale factors
-*
- DO 70 J = 1, N
- C( J ) = ZERO
- 70 CONTINUE
-*
-* Find the maximum element in each column,
-* assuming the row scaling computed above.
-*
- KD = KU + 1
- DO 90 J = 1, N
- DO 80 I = MAX( J-KU, 1 ), MIN( J+KL, M )
- C( J ) = MAX( C( J ), ABS( AB( KD+I-J, J ) )*R( I ) )
- 80 CONTINUE
- 90 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 100 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 100 CONTINUE
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 110 J = 1, N
- IF( C( J ).EQ.ZERO ) THEN
- INFO = M + J
- RETURN
- END IF
- 110 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 120 J = 1, N
- C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
- 120 CONTINUE
-*
-* Compute COLCND = min(C(J)) / max(C(J))
-*
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
- RETURN
-*
-* End of DGBEQU
-*
- END
diff --git a/mtx/lapack_src/dgbrfs.f b/mtx/lapack_src/dgbrfs.f
deleted file mode 100644
index 39d91981b..000000000
--- a/mtx/lapack_src/dgbrfs.f
+++ /dev/null
@@ -1,464 +0,0 @@
-*> \brief \b DGBRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBRFS + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB,
-* IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The original band matrix A, stored in rows 1 to KL+KU+1.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] AFB
-*> \verbatim
-*> AFB is DOUBLE PRECISION array, dimension (LDAFB,N)
-*> Details of the LU factorization of the band matrix A, as
-*> computed by DGBTRF. U is stored as an upper triangular band
-*> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
-*> the multipliers used during the factorization are stored in
-*> rows KL+KU+2 to 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] LDAFB
-*> \verbatim
-*> LDAFB is INTEGER
-*> The leading dimension of the array AFB. LDAFB >= 2*KL*KU+1.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from DGBTRF; for 1<=i<=N, row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by DGBTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBcomputational
-*
-* =====================================================================
- SUBROUTINE DGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB,
- $ IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D+0 )
- DOUBLE PRECISION THREE
- PARAMETER ( THREE = 3.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
- CHARACTER TRANST
- INTEGER COUNT, I, J, K, KASE, KK, NZ
- DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGBMV, DGBTRS, DLACN2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.KL+KU+1 ) THEN
- INFO = -7
- ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN
- INFO = -9
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -12
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -14
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = MIN( KL+KU+2, N+1 )
- EPS = DLAMCH( 'Epsilon' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - op(A) * X,
-* where op(A) = A, A**T, or A**H, depending on TRANS.
-*
- CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL DGBMV( TRANS, N, N, KL, KU, -ONE, AB, LDAB, X( 1, J ), 1,
- $ ONE, WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(op(A))*abs(X) + abs(B).
-*
- IF( NOTRAN ) THEN
- DO 50 K = 1, N
- KK = KU + 1 - K
- XK = ABS( X( K, J ) )
- DO 40 I = MAX( 1, K-KU ), MIN( N, K+KL )
- WORK( I ) = WORK( I ) + ABS( AB( KK+I, K ) )*XK
- 40 CONTINUE
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- KK = KU + 1 - K
- DO 60 I = MAX( 1, K-KU ), MIN( N, K+KL )
- S = S + ABS( AB( KK+I, K ) )*ABS( X( I, J ) )
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL DGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV,
- $ WORK( N+1 ), N, INFO )
- CALL DAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(op(A)))*
-* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(op(A)) is the inverse of op(A)
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-* Use DLACN2 to estimate the infinity-norm of the matrix
-* inv(op(A)) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(op(A)**T).
-*
- CALL DGBTRS( TRANST, N, KL, KU, 1, AFB, LDAFB, IPIV,
- $ WORK( N+1 ), N, INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( N+I )*WORK( I )
- 110 CONTINUE
- ELSE
-*
-* Multiply by inv(op(A))*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( N+I )*WORK( I )
- 120 CONTINUE
- CALL DGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV,
- $ WORK( N+1 ), N, INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of DGBRFS
-*
- END
diff --git a/mtx/lapack_src/dgbsv.f b/mtx/lapack_src/dgbsv.f
deleted file mode 100644
index 93769d387..000000000
--- a/mtx/lapack_src/dgbsv.f
+++ /dev/null
@@ -1,223 +0,0 @@
-*> \brief DGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver)
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBSV + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION AB( LDAB, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows KL+1 to
-*> 2*KL+KU+1; rows 1 to KL of the array need not be set.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(KL+KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+KL)
-*> On exit, details of the factorization: U is stored as an
-*> upper triangular band matrix with KL+KU superdiagonals in
-*> rows 1 to KL+KU+1, and the multipliers used during the
-*> factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices that define the permutation matrix P;
-*> row i of the matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and the solution has not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBsolve
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> M = N = 6, KL = 2, KU = 1:
-*>
-*> On entry: On exit:
-*>
-*> * * * + + + * * * u14 u25 u36
-*> * * + + + + * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*> a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
-*> a31 a42 a53 a64 * * m31 m42 m53 m64 * *
-*>
-*> Array elements marked * are not used by the routine; elements marked
-*> + need not be set on entry, but are required by the routine to store
-*> elements of U because of fill-in resulting from the row interchanges.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION AB( LDAB, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Subroutines ..
- EXTERNAL DGBTRF, DGBTRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( KL.LT.0 ) THEN
- INFO = -2
- ELSE IF( KU.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.2*KL+KU+1 ) THEN
- INFO = -6
- ELSE IF( LDB.LT.MAX( N, 1 ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBSV ', -INFO )
- RETURN
- END IF
-*
-* Compute the LU factorization of the band matrix A.
-*
- CALL DGBTRF( N, N, KL, KU, AB, LDAB, IPIV, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL DGBTRS( 'No transpose', N, KL, KU, NRHS, AB, LDAB, IPIV,
- $ B, LDB, INFO )
- END IF
- RETURN
-*
-* End of DGBSV
-*
- END
diff --git a/mtx/lapack_src/dgbsvx.f b/mtx/lapack_src/dgbsvx.f
deleted file mode 100644
index f6911b267..000000000
--- a/mtx/lapack_src/dgbsvx.f
+++ /dev/null
@@ -1,642 +0,0 @@
-*> \brief DGBSVX computes the solution to system of linear equations A * X = B for GB matrices
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBSVX + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
-* LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX,
-* RCOND, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, FACT, TRANS
-* INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
-* $ BERR( * ), C( * ), FERR( * ), R( * ),
-* $ WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed by this subroutine:
-*>
-*> 1. If FACT = 'E', real scaling factors are computed to equilibrate
-*> the system:
-*> TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
-*> TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
-*> TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
-*> Whether or not the system will be equilibrated depends on the
-*> scaling of the matrix A, but if equilibration is used, A is
-*> overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N')
-*> or diag(C)*B (if TRANS = 'T' or 'C').
-*>
-*> 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the
-*> matrix A (after equilibration if FACT = 'E') 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.
-*>
-*> 3. If some U(i,i)=0, so that U is exactly singular, then the routine
-*> returns with INFO = i. Otherwise, the factored form of A is used
-*> to estimate the condition number of the matrix A. If the
-*> reciprocal of the condition number is less than machine precision,
-*> INFO = N+1 is returned as a warning, but the routine still goes on
-*> to solve for X and compute error bounds as described below.
-*>
-*> 4. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 5. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*>
-*> 6. If equilibration was used, the matrix X is premultiplied by
-*> diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so
-*> that it solves the original system before equilibration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of the matrix A is
-*> supplied on entry, and if not, whether the matrix A should be
-*> equilibrated before it is factored.
-*> = 'F': On entry, AFB and IPIV contain the factored form of
-*> A. If EQUED is not 'N', the matrix A has been
-*> equilibrated with scaling factors given by R and C.
-*> AB, AFB, and IPIV are not modified.
-*> = 'N': The matrix A will be copied to AFB and factored.
-*> = 'E': The matrix A will be equilibrated if necessary, then
-*> copied to AFB and factored.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations.
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
-*>
-*> If FACT = 'F' and EQUED is not 'N', then A must have been
-*> equilibrated by the scaling factors in R and/or C. AB is not
-*> modified if FACT = 'F' or 'N', or if FACT = 'E' and
-*> EQUED = 'N' on exit.
-*>
-*> On exit, if EQUED .ne. 'N', A is scaled as follows:
-*> EQUED = 'R': A := diag(R) * A
-*> EQUED = 'C': A := A * diag(C)
-*> EQUED = 'B': A := diag(R) * A * diag(C).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in,out] AFB
-*> \verbatim
-*> AFB is DOUBLE PRECISION array, dimension (LDAFB,N)
-*> If FACT = 'F', then AFB is an input argument and on entry
-*> contains details of the LU factorization of the band matrix
-*> A, as computed by DGBTRF. U is stored as an upper triangular
-*> band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1,
-*> and the multipliers used during the factorization are stored
-*> in rows KL+KU+2 to 2*KL+KU+1. If EQUED .ne. 'N', then AFB is
-*> the factored form of the equilibrated matrix A.
-*>
-*> If FACT = 'N', then AFB is an output argument and on exit
-*> returns details of the LU factorization of A.
-*>
-*> If FACT = 'E', then AFB is an output argument and on exit
-*> returns details of the LU factorization of the equilibrated
-*> matrix A (see the description of AB for the form of the
-*> equilibrated matrix).
-*> \endverbatim
-*>
-*> \param[in] LDAFB
-*> \verbatim
-*> LDAFB is INTEGER
-*> The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in,out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> If FACT = 'F', then IPIV is an input argument and on entry
-*> contains the pivot indices from the factorization A = L*U
-*> as computed by DGBTRF; row i of the matrix was interchanged
-*> with row IPIV(i).
-*>
-*> If FACT = 'N', then IPIV is an output argument and on exit
-*> contains the pivot indices from the factorization A = L*U
-*> of the original matrix A.
-*>
-*> If FACT = 'E', then IPIV is an output argument and on exit
-*> contains the pivot indices from the factorization A = L*U
-*> of the equilibrated matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration (always true if FACT = 'N').
-*> = 'R': Row equilibration, i.e., A has been premultiplied by
-*> diag(R).
-*> = 'C': Column equilibration, i.e., A has been postmultiplied
-*> by diag(C).
-*> = 'B': Both row and column equilibration, i.e., A has been
-*> replaced by diag(R) * A * diag(C).
-*> EQUED is an input argument if FACT = 'F'; otherwise, it is an
-*> output argument.
-*> \endverbatim
-*>
-*> \param[in,out] R
-*> \verbatim
-*> R is DOUBLE PRECISION array, dimension (N)
-*> The row scale factors for A. If EQUED = 'R' or 'B', A is
-*> multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
-*> is not accessed. R is an input argument if FACT = 'F';
-*> otherwise, R is an output argument. If FACT = 'F' and
-*> EQUED = 'R' or 'B', each element of R must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> The column scale factors for A. If EQUED = 'C' or 'B', A is
-*> multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
-*> is not accessed. C is an input argument if FACT = 'F';
-*> otherwise, C is an output argument. If FACT = 'F' and
-*> EQUED = 'C' or 'B', each element of C must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit,
-*> if EQUED = 'N', B is not modified;
-*> if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by
-*> diag(R)*B;
-*> if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is
-*> overwritten by diag(C)*B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X
-*> to the original system of equations. Note that A and B are
-*> modified on exit if EQUED .ne. 'N', and the solution to the
-*> equilibrated system is inv(diag(C))*X if TRANS = 'N' and
-*> EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C'
-*> and EQUED = 'R' or 'B'.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The estimate of the reciprocal condition number of the matrix
-*> A after equilibration (if done). If RCOND is less than the
-*> machine precision (in particular, if RCOND = 0), the matrix
-*> is singular to working precision. This condition is
-*> indicated by a return code of INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> On exit, WORK(1) contains the reciprocal pivot growth
-*> factor norm(A)/norm(U). The "max absolute element" norm is
-*> used. If WORK(1) is much less than 1, then the stability
-*> of the LU factorization of the (equilibrated) matrix A
-*> could be poor. This also means that the solution X, condition
-*> estimator RCOND, and forward error bound FERR could be
-*> unreliable. If factorization fails with 0 WORK(1) contains the reciprocal pivot growth factor for the
-*> leading INFO columns of A.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, so the solution and error bounds
-*> could not be computed. RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleGBsolve
-*
-* =====================================================================
- SUBROUTINE DGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
- $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX,
- $ RCOND, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, FACT, TRANS
- INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
- $ BERR( * ), C( * ), FERR( * ), R( * ),
- $ WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
- CHARACTER NORM
- INTEGER I, INFEQU, J, J1, J2
- DOUBLE PRECISION AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN,
- $ ROWCND, RPVGRW, SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANGB, DLANTB
- EXTERNAL LSAME, DLAMCH, DLANGB, DLANTB
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGBCON, DGBEQU, DGBRFS, DGBTRF, DGBTRS,
- $ DLACPY, DLAQGB, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- EQUIL = LSAME( FACT, 'E' )
- NOTRAN = LSAME( TRANS, 'N' )
- IF( NOFACT .OR. EQUIL ) THEN
- EQUED = 'N'
- ROWEQU = .FALSE.
- COLEQU = .FALSE.
- ELSE
- ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
- COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
- SMLNUM = DLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SMLNUM
- END IF
-*
-* Test the input parameters.
-*
- IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
- $ THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( KL.LT.0 ) THEN
- INFO = -4
- ELSE IF( KU.LT.0 ) THEN
- INFO = -5
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDAB.LT.KL+KU+1 ) THEN
- INFO = -8
- ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN
- INFO = -10
- ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT.
- $ ( ROWEQU .OR. COLEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN
- INFO = -12
- ELSE
- IF( ROWEQU ) THEN
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 10 J = 1, N
- RCMIN = MIN( RCMIN, R( J ) )
- RCMAX = MAX( RCMAX, R( J ) )
- 10 CONTINUE
- IF( RCMIN.LE.ZERO ) THEN
- INFO = -13
- ELSE IF( N.GT.0 ) THEN
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- ELSE
- ROWCND = ONE
- END IF
- END IF
- IF( COLEQU .AND. INFO.EQ.0 ) THEN
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 20 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 20 CONTINUE
- IF( RCMIN.LE.ZERO ) THEN
- INFO = -14
- ELSE IF( N.GT.0 ) THEN
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- ELSE
- COLCND = ONE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -16
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -18
- END IF
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBSVX', -INFO )
- RETURN
- END IF
-*
- IF( EQUIL ) THEN
-*
-* Compute row and column scalings to equilibrate the matrix A.
-*
- CALL DGBEQU( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
- $ AMAX, INFEQU )
- IF( INFEQU.EQ.0 ) THEN
-*
-* Equilibrate the matrix.
-*
- CALL DLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
- $ AMAX, EQUED )
- ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
- COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
- END IF
- END IF
-*
-* Scale the right hand side.
-*
- IF( NOTRAN ) THEN
- IF( ROWEQU ) THEN
- DO 40 J = 1, NRHS
- DO 30 I = 1, N
- B( I, J ) = R( I )*B( I, J )
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE IF( COLEQU ) THEN
- DO 60 J = 1, NRHS
- DO 50 I = 1, N
- B( I, J ) = C( I )*B( I, J )
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
- IF( NOFACT .OR. EQUIL ) THEN
-*
-* Compute the LU factorization of the band matrix A.
-*
- DO 70 J = 1, N
- J1 = MAX( J-KU, 1 )
- J2 = MIN( J+KL, N )
- CALL DCOPY( J2-J1+1, AB( KU+1-J+J1, J ), 1,
- $ AFB( KL+KU+1-J+J1, J ), 1 )
- 70 CONTINUE
-*
- CALL DGBTRF( N, N, KL, KU, AFB, LDAFB, IPIV, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 ) THEN
-*
-* Compute the reciprocal pivot growth factor of the
-* leading rank-deficient INFO columns of A.
-*
- ANORM = ZERO
- DO 90 J = 1, INFO
- DO 80 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 )
- ANORM = MAX( ANORM, ABS( AB( I, J ) ) )
- 80 CONTINUE
- 90 CONTINUE
- RPVGRW = DLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, KL+KU ),
- $ AFB( MAX( 1, KL+KU+2-INFO ), 1 ), LDAFB,
- $ WORK )
- IF( RPVGRW.EQ.ZERO ) THEN
- RPVGRW = ONE
- ELSE
- RPVGRW = ANORM / RPVGRW
- END IF
- WORK( 1 ) = RPVGRW
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A and the
-* reciprocal pivot growth factor RPVGRW.
-*
- IF( NOTRAN ) THEN
- NORM = '1'
- ELSE
- NORM = 'I'
- END IF
- ANORM = DLANGB( NORM, N, KL, KU, AB, LDAB, WORK )
- RPVGRW = DLANTB( 'M', 'U', 'N', N, KL+KU, AFB, LDAFB, WORK )
- IF( RPVGRW.EQ.ZERO ) THEN
- RPVGRW = ONE
- ELSE
- RPVGRW = DLANGB( 'M', N, KL, KU, AB, LDAB, WORK ) / RPVGRW
- END IF
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL DGBCON( NORM, N, KL, KU, AFB, LDAFB, IPIV, ANORM, RCOND,
- $ WORK, IWORK, INFO )
-*
-* Compute the solution matrix X.
-*
- CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL DGBTRS( TRANS, N, KL, KU, NRHS, AFB, LDAFB, IPIV, X, LDX,
- $ INFO )
-*
-* Use iterative refinement to improve the computed solution and
-* compute error bounds and backward error estimates for it.
-*
- CALL DGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV,
- $ B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* Transform the solution matrix X to a solution of the original
-* system.
-*
- IF( NOTRAN ) THEN
- IF( COLEQU ) THEN
- DO 110 J = 1, NRHS
- DO 100 I = 1, N
- X( I, J ) = C( I )*X( I, J )
- 100 CONTINUE
- 110 CONTINUE
- DO 120 J = 1, NRHS
- FERR( J ) = FERR( J ) / COLCND
- 120 CONTINUE
- END IF
- ELSE IF( ROWEQU ) THEN
- DO 140 J = 1, NRHS
- DO 130 I = 1, N
- X( I, J ) = R( I )*X( I, J )
- 130 CONTINUE
- 140 CONTINUE
- DO 150 J = 1, NRHS
- FERR( J ) = FERR( J ) / ROWCND
- 150 CONTINUE
- END IF
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.DLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- WORK( 1 ) = RPVGRW
- RETURN
-*
-* End of DGBSVX
-*
- END
diff --git a/mtx/lapack_src/dgbtf2.f b/mtx/lapack_src/dgbtf2.f
deleted file mode 100644
index d053e413e..000000000
--- a/mtx/lapack_src/dgbtf2.f
+++ /dev/null
@@ -1,277 +0,0 @@
-*> \brief \b DGBTF2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBTF2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION AB( LDAB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows KL+1 to
-*> 2*KL+KU+1; rows 1 to KL of the array need not be set.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
-*>
-*> On exit, details of the factorization: U is stored as an
-*> upper triangular band matrix with KL+KU superdiagonals in
-*> rows 1 to KL+KU+1, and the multipliers used during the
-*> factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> M = N = 6, KL = 2, KU = 1:
-*>
-*> On entry: On exit:
-*>
-*> * * * + + + * * * u14 u25 u36
-*> * * + + + + * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*> a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
-*> a31 a42 a53 a64 * * m31 m42 m53 m64 * *
-*>
-*> Array elements marked * are not used by the routine; elements marked
-*> + need not be set on entry, but are required by the routine to store
-*> elements of U, because of fill-in resulting from the row
-*> interchanges.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION AB( LDAB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, JP, JU, KM, KV
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- EXTERNAL IDAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL DGER, DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* KV is the number of superdiagonals in the factor U, allowing for
-* fill-in.
-*
- KV = KU + KL
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KL+KV+1 ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBTF2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Gaussian elimination with partial pivoting
-*
-* Set fill-in elements in columns KU+2 to KV to zero.
-*
- DO 20 J = KU + 2, MIN( KV, N )
- DO 10 I = KV - J + 2, KL
- AB( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
-*
-* JU is the index of the last column affected by the current stage
-* of the factorization.
-*
- JU = 1
-*
- DO 40 J = 1, MIN( M, N )
-*
-* Set fill-in elements in column J+KV to zero.
-*
- IF( J+KV.LE.N ) THEN
- DO 30 I = 1, KL
- AB( I, J+KV ) = ZERO
- 30 CONTINUE
- END IF
-*
-* Find pivot and test for singularity. KM is the number of
-* subdiagonal elements in the current column.
-*
- KM = MIN( KL, M-J )
- JP = IDAMAX( KM+1, AB( KV+1, J ), 1 )
- IPIV( J ) = JP + J - 1
- IF( AB( KV+JP, J ).NE.ZERO ) THEN
- JU = MAX( JU, MIN( J+KU+JP-1, N ) )
-*
-* Apply interchange to columns J to JU.
-*
- IF( JP.NE.1 )
- $ CALL DSWAP( JU-J+1, AB( KV+JP, J ), LDAB-1,
- $ AB( KV+1, J ), LDAB-1 )
-*
- IF( KM.GT.0 ) THEN
-*
-* Compute multipliers.
-*
- CALL DSCAL( KM, ONE / AB( KV+1, J ), AB( KV+2, J ), 1 )
-*
-* Update trailing submatrix within the band.
-*
- IF( JU.GT.J )
- $ CALL DGER( KM, JU-J, -ONE, AB( KV+2, J ), 1,
- $ AB( KV, J+1 ), LDAB-1, AB( KV+1, J+1 ),
- $ LDAB-1 )
- END IF
- ELSE
-*
-* If pivot is zero, set INFO to the index of the pivot
-* unless a zero pivot has already been found.
-*
- IF( INFO.EQ.0 )
- $ INFO = J
- END IF
- 40 CONTINUE
- RETURN
-*
-* End of DGBTF2
-*
- END
diff --git a/mtx/lapack_src/dgbtrf.f b/mtx/lapack_src/dgbtrf.f
deleted file mode 100644
index 653f8e376..000000000
--- a/mtx/lapack_src/dgbtrf.f
+++ /dev/null
@@ -1,516 +0,0 @@
-*> \brief \b DGBTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBTRF + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION AB( LDAB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows KL+1 to
-*> 2*KL+KU+1; rows 1 to KL of the array need not be set.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
-*>
-*> On exit, details of the factorization: U is stored as an
-*> upper triangular band matrix with KL+KU superdiagonals in
-*> rows 1 to KL+KU+1, and the multipliers used during the
-*> factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> M = N = 6, KL = 2, KU = 1:
-*>
-*> On entry: On exit:
-*>
-*> * * * + + + * * * u14 u25 u36
-*> * * + + + + * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*> a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
-*> a31 a42 a53 a64 * * m31 m42 m53 m64 * *
-*>
-*> Array elements marked * are not used by the routine; elements marked
-*> + need not be set on entry, but are required by the routine to store
-*> elements of U because of fill-in resulting from the row interchanges.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION AB( LDAB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
- INTEGER NBMAX, LDWORK
- PARAMETER ( NBMAX = 64, LDWORK = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I2, I3, II, IP, J, J2, J3, JB, JJ, JM, JP,
- $ JU, K2, KM, KV, NB, NW
- DOUBLE PRECISION TEMP
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION WORK13( LDWORK, NBMAX ),
- $ WORK31( LDWORK, NBMAX )
-* ..
-* .. External Functions ..
- INTEGER IDAMAX, ILAENV
- EXTERNAL IDAMAX, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGBTF2, DGEMM, DGER, DLASWP, DSCAL,
- $ DSWAP, DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* KV is the number of superdiagonals in the factor U, allowing for
-* fill-in
-*
- KV = KU + KL
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KL+KV+1 ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment
-*
- NB = ILAENV( 1, 'DGBTRF', ' ', M, N, KL, KU )
-*
-* The block size must not exceed the limit set by the size of the
-* local arrays WORK13 and WORK31.
-*
- NB = MIN( NB, NBMAX )
-*
- IF( NB.LE.1 .OR. NB.GT.KL ) THEN
-*
-* Use unblocked code
-*
- CALL DGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO )
- ELSE
-*
-* Use blocked code
-*
-* Zero the superdiagonal elements of the work array WORK13
-*
- DO 20 J = 1, NB
- DO 10 I = 1, J - 1
- WORK13( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
-*
-* Zero the subdiagonal elements of the work array WORK31
-*
- DO 40 J = 1, NB
- DO 30 I = J + 1, NB
- WORK31( I, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
-*
-* Gaussian elimination with partial pivoting
-*
-* Set fill-in elements in columns KU+2 to KV to zero
-*
- DO 60 J = KU + 2, MIN( KV, N )
- DO 50 I = KV - J + 2, KL
- AB( I, J ) = ZERO
- 50 CONTINUE
- 60 CONTINUE
-*
-* JU is the index of the last column affected by the current
-* stage of the factorization
-*
- JU = 1
-*
- DO 180 J = 1, MIN( M, N ), NB
- JB = MIN( NB, MIN( M, N )-J+1 )
-*
-* The active part of the matrix is partitioned
-*
-* A11 A12 A13
-* A21 A22 A23
-* A31 A32 A33
-*
-* Here A11, A21 and A31 denote the current block of JB columns
-* which is about to be factorized. The number of rows in the
-* partitioning are JB, I2, I3 respectively, and the numbers
-* of columns are JB, J2, J3. The superdiagonal elements of A13
-* and the subdiagonal elements of A31 lie outside the band.
-*
- I2 = MIN( KL-JB, M-J-JB+1 )
- I3 = MIN( JB, M-J-KL+1 )
-*
-* J2 and J3 are computed after JU has been updated.
-*
-* Factorize the current block of JB columns
-*
- DO 80 JJ = J, J + JB - 1
-*
-* Set fill-in elements in column JJ+KV to zero
-*
- IF( JJ+KV.LE.N ) THEN
- DO 70 I = 1, KL
- AB( I, JJ+KV ) = ZERO
- 70 CONTINUE
- END IF
-*
-* Find pivot and test for singularity. KM is the number of
-* subdiagonal elements in the current column.
-*
- KM = MIN( KL, M-JJ )
- JP = IDAMAX( KM+1, AB( KV+1, JJ ), 1 )
- IPIV( JJ ) = JP + JJ - J
- IF( AB( KV+JP, JJ ).NE.ZERO ) THEN
- JU = MAX( JU, MIN( JJ+KU+JP-1, N ) )
- IF( JP.NE.1 ) THEN
-*
-* Apply interchange to columns J to J+JB-1
-*
- IF( JP+JJ-1.LT.J+KL ) THEN
-*
- CALL DSWAP( JB, AB( KV+1+JJ-J, J ), LDAB-1,
- $ AB( KV+JP+JJ-J, J ), LDAB-1 )
- ELSE
-*
-* The interchange affects columns J to JJ-1 of A31
-* which are stored in the work array WORK31
-*
- CALL DSWAP( JJ-J, AB( KV+1+JJ-J, J ), LDAB-1,
- $ WORK31( JP+JJ-J-KL, 1 ), LDWORK )
- CALL DSWAP( J+JB-JJ, AB( KV+1, JJ ), LDAB-1,
- $ AB( KV+JP, JJ ), LDAB-1 )
- END IF
- END IF
-*
-* Compute multipliers
-*
- CALL DSCAL( KM, ONE / AB( KV+1, JJ ), AB( KV+2, JJ ),
- $ 1 )
-*
-* Update trailing submatrix within the band and within
-* the current block. JM is the index of the last column
-* which needs to be updated.
-*
- JM = MIN( JU, J+JB-1 )
- IF( JM.GT.JJ )
- $ CALL DGER( KM, JM-JJ, -ONE, AB( KV+2, JJ ), 1,
- $ AB( KV, JJ+1 ), LDAB-1,
- $ AB( KV+1, JJ+1 ), LDAB-1 )
- ELSE
-*
-* If pivot is zero, set INFO to the index of the pivot
-* unless a zero pivot has already been found.
-*
- IF( INFO.EQ.0 )
- $ INFO = JJ
- END IF
-*
-* Copy current column of A31 into the work array WORK31
-*
- NW = MIN( JJ-J+1, I3 )
- IF( NW.GT.0 )
- $ CALL DCOPY( NW, AB( KV+KL+1-JJ+J, JJ ), 1,
- $ WORK31( 1, JJ-J+1 ), 1 )
- 80 CONTINUE
- IF( J+JB.LE.N ) THEN
-*
-* Apply the row interchanges to the other blocks.
-*
- J2 = MIN( JU-J+1, KV ) - JB
- J3 = MAX( 0, JU-J-KV+1 )
-*
-* Use DLASWP to apply the row interchanges to A12, A22, and
-* A32.
-*
- CALL DLASWP( J2, AB( KV+1-JB, J+JB ), LDAB-1, 1, JB,
- $ IPIV( J ), 1 )
-*
-* Adjust the pivot indices.
-*
- DO 90 I = J, J + JB - 1
- IPIV( I ) = IPIV( I ) + J - 1
- 90 CONTINUE
-*
-* Apply the row interchanges to A13, A23, and A33
-* columnwise.
-*
- K2 = J - 1 + JB + J2
- DO 110 I = 1, J3
- JJ = K2 + I
- DO 100 II = J + I - 1, J + JB - 1
- IP = IPIV( II )
- IF( IP.NE.II ) THEN
- TEMP = AB( KV+1+II-JJ, JJ )
- AB( KV+1+II-JJ, JJ ) = AB( KV+1+IP-JJ, JJ )
- AB( KV+1+IP-JJ, JJ ) = TEMP
- END IF
- 100 CONTINUE
- 110 CONTINUE
-*
-* Update the relevant part of the trailing submatrix
-*
- IF( J2.GT.0 ) THEN
-*
-* Update A12
-*
- CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit',
- $ JB, J2, ONE, AB( KV+1, J ), LDAB-1,
- $ AB( KV+1-JB, J+JB ), LDAB-1 )
-*
- IF( I2.GT.0 ) THEN
-*
-* Update A22
-*
- CALL DGEMM( 'No transpose', 'No transpose', I2, J2,
- $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1,
- $ AB( KV+1-JB, J+JB ), LDAB-1, ONE,
- $ AB( KV+1, J+JB ), LDAB-1 )
- END IF
-*
- IF( I3.GT.0 ) THEN
-*
-* Update A32
-*
- CALL DGEMM( 'No transpose', 'No transpose', I3, J2,
- $ JB, -ONE, WORK31, LDWORK,
- $ AB( KV+1-JB, J+JB ), LDAB-1, ONE,
- $ AB( KV+KL+1-JB, J+JB ), LDAB-1 )
- END IF
- END IF
-*
- IF( J3.GT.0 ) THEN
-*
-* Copy the lower triangle of A13 into the work array
-* WORK13
-*
- DO 130 JJ = 1, J3
- DO 120 II = JJ, JB
- WORK13( II, JJ ) = AB( II-JJ+1, JJ+J+KV-1 )
- 120 CONTINUE
- 130 CONTINUE
-*
-* Update A13 in the work array
-*
- CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit',
- $ JB, J3, ONE, AB( KV+1, J ), LDAB-1,
- $ WORK13, LDWORK )
-*
- IF( I2.GT.0 ) THEN
-*
-* Update A23
-*
- CALL DGEMM( 'No transpose', 'No transpose', I2, J3,
- $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1,
- $ WORK13, LDWORK, ONE, AB( 1+JB, J+KV ),
- $ LDAB-1 )
- END IF
-*
- IF( I3.GT.0 ) THEN
-*
-* Update A33
-*
- CALL DGEMM( 'No transpose', 'No transpose', I3, J3,
- $ JB, -ONE, WORK31, LDWORK, WORK13,
- $ LDWORK, ONE, AB( 1+KL, J+KV ), LDAB-1 )
- END IF
-*
-* Copy the lower triangle of A13 back into place
-*
- DO 150 JJ = 1, J3
- DO 140 II = JJ, JB
- AB( II-JJ+1, JJ+J+KV-1 ) = WORK13( II, JJ )
- 140 CONTINUE
- 150 CONTINUE
- END IF
- ELSE
-*
-* Adjust the pivot indices.
-*
- DO 160 I = J, J + JB - 1
- IPIV( I ) = IPIV( I ) + J - 1
- 160 CONTINUE
- END IF
-*
-* Partially undo the interchanges in the current block to
-* restore the upper triangular form of A31 and copy the upper
-* triangle of A31 back into place
-*
- DO 170 JJ = J + JB - 1, J, -1
- JP = IPIV( JJ ) - JJ + 1
- IF( JP.NE.1 ) THEN
-*
-* Apply interchange to columns J to JJ-1
-*
- IF( JP+JJ-1.LT.J+KL ) THEN
-*
-* The interchange does not affect A31
-*
- CALL DSWAP( JJ-J, AB( KV+1+JJ-J, J ), LDAB-1,
- $ AB( KV+JP+JJ-J, J ), LDAB-1 )
- ELSE
-*
-* The interchange does affect A31
-*
- CALL DSWAP( JJ-J, AB( KV+1+JJ-J, J ), LDAB-1,
- $ WORK31( JP+JJ-J-KL, 1 ), LDWORK )
- END IF
- END IF
-*
-* Copy the current column of A31 back into place
-*
- NW = MIN( I3, JJ-J+1 )
- IF( NW.GT.0 )
- $ CALL DCOPY( NW, WORK31( 1, JJ-J+1 ), 1,
- $ AB( KV+KL+1-JJ+J, JJ ), 1 )
- 170 CONTINUE
- 180 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DGBTRF
-*
- END
diff --git a/mtx/lapack_src/dgbtrs.f b/mtx/lapack_src/dgbtrs.f
deleted file mode 100644
index f34ae750a..000000000
--- a/mtx/lapack_src/dgbtrs.f
+++ /dev/null
@@ -1,269 +0,0 @@
-*> \brief \b DGBTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGBTRS + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION AB( LDAB, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations.
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T* X = B (Transpose)
-*> = 'C': A**T* X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> Details of the LU factorization of the band matrix A, as
-*> computed by DGBTRF. U is stored as an upper triangular band
-*> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
-*> the multipliers used during the factorization are stored in
-*> rows KL+KU+2 to 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= N, row i of the matrix was
-*> interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBcomputational
-*
-* =====================================================================
- SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION AB( LDAB, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LNOTI, NOTRAN
- INTEGER I, J, KD, L, LM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DGER, DSWAP, DTBSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.( 2*KL+KU+1 ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGBTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- KD = KU + KL + 1
- LNOTI = KL.GT.0
-*
- IF( NOTRAN ) THEN
-*
-* Solve A*X = B.
-*
-* Solve L*X = B, overwriting B with X.
-*
-* L is represented as a product of permutations and unit lower
-* triangular matrices L = P(1) * L(1) * ... * P(n-1) * L(n-1),
-* where each transformation L(i) is a rank-one modification of
-* the identity matrix.
-*
- IF( LNOTI ) THEN
- DO 10 J = 1, N - 1
- LM = MIN( KL, N-J )
- L = IPIV( J )
- IF( L.NE.J )
- $ CALL DSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB )
- CALL DGER( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J, 1 ),
- $ LDB, B( J+1, 1 ), LDB )
- 10 CONTINUE
- END IF
-*
- DO 20 I = 1, NRHS
-*
-* Solve U*X = B, overwriting B with X.
-*
- CALL DTBSV( 'Upper', 'No transpose', 'Non-unit', N, KL+KU,
- $ AB, LDAB, B( 1, I ), 1 )
- 20 CONTINUE
-*
- ELSE
-*
-* Solve A**T*X = B.
-*
- DO 30 I = 1, NRHS
-*
-* Solve U**T*X = B, overwriting B with X.
-*
- CALL DTBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU, AB,
- $ LDAB, B( 1, I ), 1 )
- 30 CONTINUE
-*
-* Solve L**T*X = B, overwriting B with X.
-*
- IF( LNOTI ) THEN
- DO 40 J = N - 1, 1, -1
- LM = MIN( KL, N-J )
- CALL DGEMV( 'Transpose', LM, NRHS, -ONE, B( J+1, 1 ),
- $ LDB, AB( KD+1, J ), 1, ONE, B( J, 1 ), LDB )
- L = IPIV( J )
- IF( L.NE.J )
- $ CALL DSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB )
- 40 CONTINUE
- END IF
- END IF
- RETURN
-*
-* End of DGBTRS
-*
- END
diff --git a/mtx/lapack_src/dgebak.f b/mtx/lapack_src/dgebak.f
deleted file mode 100644
index 276a29818..000000000
--- a/mtx/lapack_src/dgebak.f
+++ /dev/null
@@ -1,268 +0,0 @@
-*> \brief \b DGEBAK
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEBAK + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOB, SIDE
-* INTEGER IHI, ILO, INFO, LDV, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION SCALE( * ), V( LDV, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies the type of backward transformation required:
-*> = 'N', do nothing, return immediately;
-*> = 'P', do backward transformation for permutation only;
-*> = 'S', do backward transformation for scaling only;
-*> = 'B', do backward transformations for both permutation and
-*> scaling.
-*> JOB must be the same as the argument JOB supplied to DGEBAL.
-*> \endverbatim
-*>
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'R': V contains right eigenvectors;
-*> = 'L': V contains left eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows of the matrix V. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> The integers ILO and IHI determined by DGEBAL.
-*> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*> \endverbatim
-*>
-*> \param[in] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION array, dimension (N)
-*> Details of the permutation and scaling factors, as returned
-*> by DGEBAL.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns of the matrix V. M >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,M)
-*> On entry, the matrix of right or left eigenvectors to be
-*> transformed, as returned by DHSEIN or DTREVC.
-*> On exit, V is overwritten by the transformed eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V. LDV >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOB, SIDE
- INTEGER IHI, ILO, INFO, LDV, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION SCALE( * ), V( LDV, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFTV, RIGHTV
- INTEGER I, II, K
- DOUBLE PRECISION S
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Decode and Test the input parameters
-*
- RIGHTV = LSAME( SIDE, 'R' )
- LEFTV = LSAME( SIDE, 'L' )
-*
- INFO = 0
- IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
- $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
- INFO = -5
- ELSE IF( M.LT.0 ) THEN
- INFO = -7
- ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEBAK', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
- IF( M.EQ.0 )
- $ RETURN
- IF( LSAME( JOB, 'N' ) )
- $ RETURN
-*
- IF( ILO.EQ.IHI )
- $ GO TO 30
-*
-* Backward balance
-*
- IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
-*
- IF( RIGHTV ) THEN
- DO 10 I = ILO, IHI
- S = SCALE( I )
- CALL DSCAL( M, S, V( I, 1 ), LDV )
- 10 CONTINUE
- END IF
-*
- IF( LEFTV ) THEN
- DO 20 I = ILO, IHI
- S = ONE / SCALE( I )
- CALL DSCAL( M, S, V( I, 1 ), LDV )
- 20 CONTINUE
- END IF
-*
- END IF
-*
-* Backward permutation
-*
-* For I = ILO-1 step -1 until 1,
-* IHI+1 step 1 until N do --
-*
- 30 CONTINUE
- IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
- IF( RIGHTV ) THEN
- DO 40 II = 1, N
- I = II
- IF( I.GE.ILO .AND. I.LE.IHI )
- $ GO TO 40
- IF( I.LT.ILO )
- $ I = ILO - II
- K = SCALE( I )
- IF( K.EQ.I )
- $ GO TO 40
- CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
- 40 CONTINUE
- END IF
-*
- IF( LEFTV ) THEN
- DO 50 II = 1, N
- I = II
- IF( I.GE.ILO .AND. I.LE.IHI )
- $ GO TO 50
- IF( I.LT.ILO )
- $ I = ILO - II
- K = SCALE( I )
- IF( K.EQ.I )
- $ GO TO 50
- CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
- 50 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DGEBAK
-*
- END
diff --git a/mtx/lapack_src/dgebal.f b/mtx/lapack_src/dgebal.f
deleted file mode 100644
index 5d7ed035c..000000000
--- a/mtx/lapack_src/dgebal.f
+++ /dev/null
@@ -1,405 +0,0 @@
-*> \brief \b DGEBAL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEBAL + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOB
-* INTEGER IHI, ILO, INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), SCALE( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> Specifies the operations to be performed on A:
-*> = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0
-*> for i = 1,...,N;
-*> = 'P': permute only;
-*> = 'S': scale only;
-*> = 'B': both permute and scale.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE array, dimension (LDA,N)
-*> On entry, the input matrix A.
-*> On exit, A is overwritten by the balanced matrix.
-*> If JOB = 'N', A is not referenced.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*> \param[out] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> ILO and IHI are set to integers such that on exit
-*> A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.
-*> If JOB = 'N' or 'S', ILO = 1 and IHI = N.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE array, dimension (N)
-*> Details of the permutations and scaling factors applied to
-*> A. If P(j) is the index of the row and column interchanged
-*> with row and column j and D(j) is the scaling factor
-*> applied to row and column j, then
-*> SCALE(j) = P(j) for j = 1,...,ILO-1
-*> = D(j) for j = ILO,...,IHI
-*> = P(j) for j = IHI+1,...,N.
-*> The order in which the interchanges are made is N to IHI+1,
-*> then 1 to ILO-1.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The permutations consist of row and column interchanges which put
-*> the matrix in the form
-*>
-*> ( T1 X Y )
-*> P A P = ( 0 B Z )
-*> ( 0 0 T2 )
-*>
-*> where T1 and T2 are upper triangular matrices whose eigenvalues lie
-*> along the diagonal. The column indices ILO and IHI mark the starting
-*> and ending columns of the submatrix B. Balancing consists of applying
-*> a diagonal similarity transformation inv(D) * B * D to make the
-*> 1-norms of each row of B and its corresponding column nearly equal.
-*> The output matrix is
-*>
-*> ( T1 X*D Y )
-*> ( 0 inv(D)*B*D inv(D)*Z ).
-*> ( 0 0 T2 )
-*>
-*> Information about the permutations P and the diagonal matrix D is
-*> returned in the vector SCALE.
-*>
-*> This subroutine is based on the EISPACK routine BALANC.
-*>
-*> Modified by Tzu-Yi Chen, Computer Science Division, University of
-*> California at Berkeley, USA
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOB
- INTEGER IHI, ILO, INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), SCALE( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
- DOUBLE PRECISION SCLFAC
- PARAMETER ( SCLFAC = 2.0D+0 )
- DOUBLE PRECISION FACTOR
- PARAMETER ( FACTOR = 0.95D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOCONV
- INTEGER I, ICA, IEXC, IRA, J, K, L, M
- DOUBLE PRECISION C, CA, F, G, R, RA, S, SFMAX1, SFMAX2, SFMIN1,
- $ SFMIN2
-* ..
-* .. External Functions ..
- LOGICAL DISNAN, LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH
- EXTERNAL DISNAN, LSAME, IDAMAX, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
- $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEBAL', -INFO )
- RETURN
- END IF
-*
- K = 1
- L = N
-*
- IF( N.EQ.0 )
- $ GO TO 210
-*
- IF( LSAME( JOB, 'N' ) ) THEN
- DO 10 I = 1, N
- SCALE( I ) = ONE
- 10 CONTINUE
- GO TO 210
- END IF
-*
- IF( LSAME( JOB, 'S' ) )
- $ GO TO 120
-*
-* Permutation to isolate eigenvalues if possible
-*
- GO TO 50
-*
-* Row and column exchange.
-*
- 20 CONTINUE
- SCALE( M ) = J
- IF( J.EQ.M )
- $ GO TO 30
-*
- CALL DSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
- CALL DSWAP( N-K+1, A( J, K ), LDA, A( M, K ), LDA )
-*
- 30 CONTINUE
- GO TO ( 40, 80 )IEXC
-*
-* Search for rows isolating an eigenvalue and push them down.
-*
- 40 CONTINUE
- IF( L.EQ.1 )
- $ GO TO 210
- L = L - 1
-*
- 50 CONTINUE
- DO 70 J = L, 1, -1
-*
- DO 60 I = 1, L
- IF( I.EQ.J )
- $ GO TO 60
- IF( A( J, I ).NE.ZERO )
- $ GO TO 70
- 60 CONTINUE
-*
- M = L
- IEXC = 1
- GO TO 20
- 70 CONTINUE
-*
- GO TO 90
-*
-* Search for columns isolating an eigenvalue and push them left.
-*
- 80 CONTINUE
- K = K + 1
-*
- 90 CONTINUE
- DO 110 J = K, L
-*
- DO 100 I = K, L
- IF( I.EQ.J )
- $ GO TO 100
- IF( A( I, J ).NE.ZERO )
- $ GO TO 110
- 100 CONTINUE
-*
- M = K
- IEXC = 2
- GO TO 20
- 110 CONTINUE
-*
- 120 CONTINUE
- DO 130 I = K, L
- SCALE( I ) = ONE
- 130 CONTINUE
-*
- IF( LSAME( JOB, 'P' ) )
- $ GO TO 210
-*
-* Balance the submatrix in rows K to L.
-*
-* Iterative loop for norm reduction
-*
- SFMIN1 = DLAMCH( 'S' ) / DLAMCH( 'P' )
- SFMAX1 = ONE / SFMIN1
- SFMIN2 = SFMIN1*SCLFAC
- SFMAX2 = ONE / SFMIN2
- 140 CONTINUE
- NOCONV = .FALSE.
-*
- DO 200 I = K, L
- C = ZERO
- R = ZERO
-*
- DO 150 J = K, L
- IF( J.EQ.I )
- $ GO TO 150
- C = C + ABS( A( J, I ) )
- R = R + ABS( A( I, J ) )
- 150 CONTINUE
- ICA = IDAMAX( L, A( 1, I ), 1 )
- CA = ABS( A( ICA, I ) )
- IRA = IDAMAX( N-K+1, A( I, K ), LDA )
- RA = ABS( A( I, IRA+K-1 ) )
-*
-* Guard against zero C or R due to underflow.
-*
- IF( C.EQ.ZERO .OR. R.EQ.ZERO )
- $ GO TO 200
- G = R / SCLFAC
- F = ONE
- S = C + R
- 160 CONTINUE
- IF( C.GE.G .OR. MAX( F, C, CA ).GE.SFMAX2 .OR.
- $ MIN( R, G, RA ).LE.SFMIN2 )GO TO 170
- IF( DISNAN( C+F+CA+R+G+RA ) ) THEN
-*
-* Exit if NaN to avoid infinite loop
-*
- INFO = -3
- CALL XERBLA( 'DGEBAL', -INFO )
- RETURN
- END IF
- F = F*SCLFAC
- C = C*SCLFAC
- CA = CA*SCLFAC
- R = R / SCLFAC
- G = G / SCLFAC
- RA = RA / SCLFAC
- GO TO 160
-*
- 170 CONTINUE
- G = C / SCLFAC
- 180 CONTINUE
- IF( G.LT.R .OR. MAX( R, RA ).GE.SFMAX2 .OR.
- $ MIN( F, C, G, CA ).LE.SFMIN2 )GO TO 190
- F = F / SCLFAC
- C = C / SCLFAC
- G = G / SCLFAC
- CA = CA / SCLFAC
- R = R*SCLFAC
- RA = RA*SCLFAC
- GO TO 180
-*
-* Now balance.
-*
- 190 CONTINUE
- IF( ( C+R ).GE.FACTOR*S )
- $ GO TO 200
- IF( F.LT.ONE .AND. SCALE( I ).LT.ONE ) THEN
- IF( F*SCALE( I ).LE.SFMIN1 )
- $ GO TO 200
- END IF
- IF( F.GT.ONE .AND. SCALE( I ).GT.ONE ) THEN
- IF( SCALE( I ).GE.SFMAX1 / F )
- $ GO TO 200
- END IF
- G = ONE / F
- SCALE( I ) = SCALE( I )*F
- NOCONV = .TRUE.
-*
- CALL DSCAL( N-K+1, G, A( I, K ), LDA )
- CALL DSCAL( L, F, A( 1, I ), 1 )
-*
- 200 CONTINUE
-*
- IF( NOCONV )
- $ GO TO 140
-*
- 210 CONTINUE
- ILO = K
- IHI = L
-*
- RETURN
-*
-* End of DGEBAL
-*
- END
diff --git a/mtx/lapack_src/dgebd2.f b/mtx/lapack_src/dgebd2.f
deleted file mode 100644
index c35db4904..000000000
--- a/mtx/lapack_src/dgebd2.f
+++ /dev/null
@@ -1,320 +0,0 @@
-*> \brief \b DGEBD2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEBD2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ),
-* $ TAUQ( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows in the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns in the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the m by n general matrix to be reduced.
-*> On exit,
-*> if m >= n, the diagonal and the first superdiagonal are
-*> overwritten with the upper bidiagonal matrix B; the
-*> elements below the diagonal, with the array TAUQ, represent
-*> the orthogonal matrix Q as a product of elementary
-*> reflectors, and the elements above the first superdiagonal,
-*> with the array TAUP, represent the orthogonal matrix P as
-*> a product of elementary reflectors;
-*> if m < n, the diagonal and the first subdiagonal are
-*> overwritten with the lower bidiagonal matrix B; the
-*> elements below the first subdiagonal, with the array TAUQ,
-*> represent the orthogonal matrix Q as a product of
-*> elementary reflectors, and the elements above the diagonal,
-*> with the array TAUP, represent the orthogonal matrix P as
-*> a product of elementary reflectors.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (min(M,N))
-*> The diagonal elements of the bidiagonal matrix B:
-*> D(i) = A(i,i).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (min(M,N)-1)
-*> The off-diagonal elements of the bidiagonal matrix B:
-*> if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
-*> if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
-*> \endverbatim
-*>
-*> \param[out] TAUQ
-*> \verbatim
-*> TAUQ is DOUBLE PRECISION array dimension (min(M,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Q. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] TAUP
-*> \verbatim
-*> TAUP is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix P. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (max(M,N))
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrices Q and P are represented as products of elementary
-*> reflectors:
-*>
-*> If m >= n,
-*>
-*> Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
-*>
-*> Each H(i) and G(i) has the form:
-*>
-*> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
-*>
-*> where tauq and taup are real scalars, and v and u are real vectors;
-*> v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
-*> u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
-*> tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> If m < n,
-*>
-*> Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
-*>
-*> Each H(i) and G(i) has the form:
-*>
-*> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
-*>
-*> where tauq and taup are real scalars, and v and u are real vectors;
-*> v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
-*> u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
-*> tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> The contents of A on exit are illustrated by the following examples:
-*>
-*> m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
-*>
-*> ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
-*> ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
-*> ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
-*> ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
-*> ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
-*> ( v1 v2 v3 v4 v5 )
-*>
-*> where d and e denote diagonal and off-diagonal elements of B, vi
-*> denotes an element of the vector defining H(i), and ui an element of
-*> the vector defining G(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ),
- $ TAUQ( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.LT.0 ) THEN
- CALL XERBLA( 'DGEBD2', -INFO )
- RETURN
- END IF
-*
- IF( M.GE.N ) THEN
-*
-* Reduce to upper bidiagonal form
-*
- DO 10 I = 1, N
-*
-* Generate elementary reflector H(i) to annihilate A(i+1:m,i)
-*
- CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
- $ TAUQ( I ) )
- D( I ) = A( I, I )
- A( I, I ) = ONE
-*
-* Apply H(i) to A(i:m,i+1:n) from the left
-*
- IF( I.LT.N )
- $ CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAUQ( I ),
- $ A( I, I+1 ), LDA, WORK )
- A( I, I ) = D( I )
-*
- IF( I.LT.N ) THEN
-*
-* Generate elementary reflector G(i) to annihilate
-* A(i,i+2:n)
-*
- CALL DLARFG( N-I, A( I, I+1 ), A( I, MIN( I+2, N ) ),
- $ LDA, TAUP( I ) )
- E( I ) = A( I, I+1 )
- A( I, I+1 ) = ONE
-*
-* Apply G(i) to A(i+1:m,i+1:n) from the right
-*
- CALL DLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
- $ TAUP( I ), A( I+1, I+1 ), LDA, WORK )
- A( I, I+1 ) = E( I )
- ELSE
- TAUP( I ) = ZERO
- END IF
- 10 CONTINUE
- ELSE
-*
-* Reduce to lower bidiagonal form
-*
- DO 20 I = 1, M
-*
-* Generate elementary reflector G(i) to annihilate A(i,i+1:n)
-*
- CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
- $ TAUP( I ) )
- D( I ) = A( I, I )
- A( I, I ) = ONE
-*
-* Apply G(i) to A(i+1:m,i:n) from the right
-*
- IF( I.LT.M )
- $ CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
- $ TAUP( I ), A( I+1, I ), LDA, WORK )
- A( I, I ) = D( I )
-*
- IF( I.LT.M ) THEN
-*
-* Generate elementary reflector H(i) to annihilate
-* A(i+2:m,i)
-*
- CALL DLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1,
- $ TAUQ( I ) )
- E( I ) = A( I+1, I )
- A( I+1, I ) = ONE
-*
-* Apply H(i) to A(i+1:m,i+1:n) from the left
-*
- CALL DLARF( 'Left', M-I, N-I, A( I+1, I ), 1, TAUQ( I ),
- $ A( I+1, I+1 ), LDA, WORK )
- A( I+1, I ) = E( I )
- ELSE
- TAUQ( I ) = ZERO
- END IF
- 20 CONTINUE
- END IF
- RETURN
-*
-* End of DGEBD2
-*
- END
diff --git a/mtx/lapack_src/dgebrd.f b/mtx/lapack_src/dgebrd.f
deleted file mode 100644
index 6cb61f002..000000000
--- a/mtx/lapack_src/dgebrd.f
+++ /dev/null
@@ -1,353 +0,0 @@
-*> \brief \b DGEBRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEBRD + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ),
-* $ TAUQ( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows in the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns in the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N general matrix to be reduced.
-*> On exit,
-*> if m >= n, the diagonal and the first superdiagonal are
-*> overwritten with the upper bidiagonal matrix B; the
-*> elements below the diagonal, with the array TAUQ, represent
-*> the orthogonal matrix Q as a product of elementary
-*> reflectors, and the elements above the first superdiagonal,
-*> with the array TAUP, represent the orthogonal matrix P as
-*> a product of elementary reflectors;
-*> if m < n, the diagonal and the first subdiagonal are
-*> overwritten with the lower bidiagonal matrix B; the
-*> elements below the first subdiagonal, with the array TAUQ,
-*> represent the orthogonal matrix Q as a product of
-*> elementary reflectors, and the elements above the diagonal,
-*> with the array TAUP, represent the orthogonal matrix P as
-*> a product of elementary reflectors.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (min(M,N))
-*> The diagonal elements of the bidiagonal matrix B:
-*> D(i) = A(i,i).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (min(M,N)-1)
-*> The off-diagonal elements of the bidiagonal matrix B:
-*> if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
-*> if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
-*> \endverbatim
-*>
-*> \param[out] TAUQ
-*> \verbatim
-*> TAUQ is DOUBLE PRECISION array dimension (min(M,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Q. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] TAUP
-*> \verbatim
-*> TAUP is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix P. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of the array WORK. LWORK >= max(1,M,N).
-*> For optimum performance LWORK >= (M+N)*NB, where NB
-*> is the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrices Q and P are represented as products of elementary
-*> reflectors:
-*>
-*> If m >= n,
-*>
-*> Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
-*>
-*> Each H(i) and G(i) has the form:
-*>
-*> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
-*>
-*> where tauq and taup are real scalars, and v and u are real vectors;
-*> v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
-*> u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
-*> tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> If m < n,
-*>
-*> Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
-*>
-*> Each H(i) and G(i) has the form:
-*>
-*> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
-*>
-*> where tauq and taup are real scalars, and v and u are real vectors;
-*> v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
-*> u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
-*> tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> The contents of A on exit are illustrated by the following examples:
-*>
-*> m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
-*>
-*> ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
-*> ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
-*> ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
-*> ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
-*> ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
-*> ( v1 v2 v3 v4 v5 )
-*>
-*> where d and e denote diagonal and off-diagonal elements of B, vi
-*> denotes an element of the vector defining H(i), and ui an element of
-*> the vector defining G(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ),
- $ TAUQ( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
- $ NBMIN, NX
- DOUBLE PRECISION WS
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEBD2, DGEMM, DLABRD, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE, MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- NB = MAX( 1, ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) )
- LWKOPT = ( M+N )*NB
- WORK( 1 ) = DBLE( LWKOPT )
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -10
- END IF
- IF( INFO.LT.0 ) THEN
- CALL XERBLA( 'DGEBRD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- MINMN = MIN( M, N )
- IF( MINMN.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- WS = MAX( M, N )
- LDWRKX = M
- LDWRKY = N
-*
- IF( NB.GT.1 .AND. NB.LT.MINMN ) THEN
-*
-* Set the crossover point NX.
-*
- NX = MAX( NB, ILAENV( 3, 'DGEBRD', ' ', M, N, -1, -1 ) )
-*
-* Determine when to switch from blocked to unblocked code.
-*
- IF( NX.LT.MINMN ) THEN
- WS = ( M+N )*NB
- IF( LWORK.LT.WS ) THEN
-*
-* Not enough work space for the optimal NB, consider using
-* a smaller block size.
-*
- NBMIN = ILAENV( 2, 'DGEBRD', ' ', M, N, -1, -1 )
- IF( LWORK.GE.( M+N )*NBMIN ) THEN
- NB = LWORK / ( M+N )
- ELSE
- NB = 1
- NX = MINMN
- END IF
- END IF
- END IF
- ELSE
- NX = MINMN
- END IF
-*
- DO 30 I = 1, MINMN - NX, NB
-*
-* Reduce rows and columns i:i+nb-1 to bidiagonal form and return
-* the matrices X and Y which are needed to update the unreduced
-* part of the matrix
-*
- CALL DLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ), E( I ),
- $ TAUQ( I ), TAUP( I ), WORK, LDWRKX,
- $ WORK( LDWRKX*NB+1 ), LDWRKY )
-*
-* Update the trailing submatrix A(i+nb:m,i+nb:n), using an update
-* of the form A := A - V*Y**T - X*U**T
-*
- CALL DGEMM( 'No transpose', 'Transpose', M-I-NB+1, N-I-NB+1,
- $ NB, -ONE, A( I+NB, I ), LDA,
- $ WORK( LDWRKX*NB+NB+1 ), LDWRKY, ONE,
- $ A( I+NB, I+NB ), LDA )
- CALL DGEMM( 'No transpose', 'No transpose', M-I-NB+1, N-I-NB+1,
- $ NB, -ONE, WORK( NB+1 ), LDWRKX, A( I, I+NB ), LDA,
- $ ONE, A( I+NB, I+NB ), LDA )
-*
-* Copy diagonal and off-diagonal elements of B back into A
-*
- IF( M.GE.N ) THEN
- DO 10 J = I, I + NB - 1
- A( J, J ) = D( J )
- A( J, J+1 ) = E( J )
- 10 CONTINUE
- ELSE
- DO 20 J = I, I + NB - 1
- A( J, J ) = D( J )
- A( J+1, J ) = E( J )
- 20 CONTINUE
- END IF
- 30 CONTINUE
-*
-* Use unblocked code to reduce the remainder of the matrix
-*
- CALL DGEBD2( M-I+1, N-I+1, A( I, I ), LDA, D( I ), E( I ),
- $ TAUQ( I ), TAUP( I ), WORK, IINFO )
- WORK( 1 ) = WS
- RETURN
-*
-* End of DGEBRD
-*
- END
diff --git a/mtx/lapack_src/dgecon.f b/mtx/lapack_src/dgecon.f
deleted file mode 100644
index df9d8e1c4..000000000
--- a/mtx/lapack_src/dgecon.f
+++ /dev/null
@@ -1,261 +0,0 @@
-*> \brief \b DGECON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGECON + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER INFO, LDA, N
-* DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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)) ).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies whether the 1-norm condition number or the
-*> infinity-norm condition number is required:
-*> = '1' or 'O': 1-norm;
-*> = 'I': Infinity-norm.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The factors L and U from the factorization A = P*L*U
-*> as computed by DGETRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is DOUBLE PRECISION
-*> If NORM = '1' or 'O', the 1-norm of the original matrix A.
-*> If NORM = 'I', the infinity-norm of the original matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(norm(A) * norm(inv(A))).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER INFO, LDA, N
- DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IWORK( * )
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ONENRM
- CHARACTER NORMIN
- INTEGER IX, KASE, KASE1
- DOUBLE PRECISION AINVNM, SCALE, SL, SMLNUM, SU
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, IDAMAX, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACN2, DLATRS, DRSCL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
- IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGECON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
- SMLNUM = DLAMCH( 'Safe minimum' )
-*
-* Estimate the norm of inv(A).
-*
- AINVNM = ZERO
- NORMIN = 'N'
- IF( ONENRM ) THEN
- KASE1 = 1
- ELSE
- KASE1 = 2
- END IF
- KASE = 0
- 10 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.KASE1 ) THEN
-*
-* Multiply by inv(L).
-*
- CALL DLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, A,
- $ LDA, WORK, SL, WORK( 2*N+1 ), INFO )
-*
-* Multiply by inv(U).
-*
- CALL DLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
- $ A, LDA, WORK, SU, WORK( 3*N+1 ), INFO )
- ELSE
-*
-* Multiply by inv(U**T).
-*
- CALL DLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A,
- $ LDA, WORK, SU, WORK( 3*N+1 ), INFO )
-*
-* Multiply by inv(L**T).
-*
- CALL DLATRS( 'Lower', 'Transpose', 'Unit', NORMIN, N, A,
- $ LDA, WORK, SL, WORK( 2*N+1 ), INFO )
- END IF
-*
-* Divide X by 1/(SL*SU) if doing so will not cause overflow.
-*
- SCALE = SL*SU
- NORMIN = 'Y'
- IF( SCALE.NE.ONE ) THEN
- IX = IDAMAX( N, WORK, 1 )
- IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
- $ GO TO 20
- CALL DRSCL( N, SCALE, WORK, 1 )
- END IF
- GO TO 10
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- 20 CONTINUE
- RETURN
-*
-* End of DGECON
-*
- END
diff --git a/mtx/lapack_src/dgeequ.f b/mtx/lapack_src/dgeequ.f
deleted file mode 100644
index a93af8f8d..000000000
--- a/mtx/lapack_src/dgeequ.f
+++ /dev/null
@@ -1,304 +0,0 @@
-*> \brief \b DGEEQU
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEEQU + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
-* INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The M-by-N matrix whose equilibration factors are
-*> to be computed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is DOUBLE PRECISION array, dimension (M)
-*> If INFO = 0 or INFO > M, R contains the row scale factors
-*> for A.
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> If INFO = 0, C contains the column scale factors for A.
-*> \endverbatim
-*>
-*> \param[out] ROWCND
-*> \verbatim
-*> ROWCND is DOUBLE PRECISION
-*> If INFO = 0 or INFO > M, ROWCND contains the ratio of the
-*> smallest R(i) to the largest R(i). If ROWCND >= 0.1 and
-*> AMAX is neither too large nor too small, it is not worth
-*> scaling by R.
-*> \endverbatim
-*>
-*> \param[out] COLCND
-*> \verbatim
-*> COLCND is DOUBLE PRECISION
-*> If INFO = 0, COLCND contains the ratio of the smallest
-*> C(i) to the largest C(i). If COLCND >= 0.1, it is not
-*> worth scaling by C.
-*> \endverbatim
-*>
-*> \param[out] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix element. If AMAX is very
-*> close to overflow or very close to underflow, the matrix
-*> should be scaled.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= M: the i-th row of A is exactly zero
-*> > M: the (i-M)-th column of A is exactly zero
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
- DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION BIGNUM, RCMAX, RCMIN, SMLNUM
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEEQU', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- ROWCND = ONE
- COLCND = ONE
- AMAX = ZERO
- RETURN
- END IF
-*
-* Get machine constants.
-*
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
-*
-* Compute row scale factors.
-*
- DO 10 I = 1, M
- R( I ) = ZERO
- 10 CONTINUE
-*
-* Find the maximum element in each row.
-*
- DO 30 J = 1, N
- DO 20 I = 1, M
- R( I ) = MAX( R( I ), ABS( A( I, J ) ) )
- 20 CONTINUE
- 30 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 40 I = 1, M
- RCMAX = MAX( RCMAX, R( I ) )
- RCMIN = MIN( RCMIN, R( I ) )
- 40 CONTINUE
- AMAX = RCMAX
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 50 I = 1, M
- IF( R( I ).EQ.ZERO ) THEN
- INFO = I
- RETURN
- END IF
- 50 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 60 I = 1, M
- R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
- 60 CONTINUE
-*
-* Compute ROWCND = min(R(I)) / max(R(I))
-*
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
-* Compute column scale factors
-*
- DO 70 J = 1, N
- C( J ) = ZERO
- 70 CONTINUE
-*
-* Find the maximum element in each column,
-* assuming the row scaling computed above.
-*
- DO 90 J = 1, N
- DO 80 I = 1, M
- C( J ) = MAX( C( J ), ABS( A( I, J ) )*R( I ) )
- 80 CONTINUE
- 90 CONTINUE
-*
-* Find the maximum and minimum scale factors.
-*
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 100 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 100 CONTINUE
-*
- IF( RCMIN.EQ.ZERO ) THEN
-*
-* Find the first zero scale factor and return an error code.
-*
- DO 110 J = 1, N
- IF( C( J ).EQ.ZERO ) THEN
- INFO = M + J
- RETURN
- END IF
- 110 CONTINUE
- ELSE
-*
-* Invert the scale factors.
-*
- DO 120 J = 1, N
- C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
- 120 CONTINUE
-*
-* Compute COLCND = min(C(J)) / max(C(J))
-*
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- END IF
-*
- RETURN
-*
-* End of DGEEQU
-*
- END
diff --git a/mtx/lapack_src/dgeev.f b/mtx/lapack_src/dgeev.f
deleted file mode 100644
index f2cadb0d5..000000000
--- a/mtx/lapack_src/dgeev.f
+++ /dev/null
@@ -1,516 +0,0 @@
-*> \brief DGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEEV + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR,
-* LDVR, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBVL, JOBVR
-* INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
-* $ WI( * ), WORK( * ), WR( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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)**T * A = lambda(j) * u(j)**T
-*> where u(j)**T denotes the transpose of u(j).
-*>
-*> The computed eigenvectors are normalized to have Euclidean norm
-*> equal to 1 and largest component real.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBVL
-*> \verbatim
-*> JOBVL is CHARACTER*1
-*> = 'N': left eigenvectors of A are not computed;
-*> = 'V': left eigenvectors of A are computed.
-*> \endverbatim
-*>
-*> \param[in] JOBVR
-*> \verbatim
-*> JOBVR is CHARACTER*1
-*> = 'N': right eigenvectors of A are not computed;
-*> = 'V': right eigenvectors of A are computed.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A.
-*> On exit, A has been overwritten.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION array, dimension (N)
-*> WR and WI contain the real and imaginary parts,
-*> respectively, of the computed eigenvalues. Complex
-*> conjugate pairs of eigenvalues appear consecutively
-*> with the eigenvalue having the positive imaginary part
-*> first.
-*> \endverbatim
-*>
-*> \param[out] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION array, dimension (LDVL,N)
-*> If JOBVL = 'V', the left eigenvectors u(j) are stored one
-*> after another in the columns of VL, in the same order
-*> as their eigenvalues.
-*> If JOBVL = 'N', VL is not referenced.
-*> If the j-th eigenvalue is real, then u(j) = VL(:,j),
-*> the j-th column of VL.
-*> If the j-th and (j+1)-st eigenvalues form a complex
-*> conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
-*> u(j+1) = VL(:,j) - i*VL(:,j+1).
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the array VL. LDVL >= 1; if
-*> JOBVL = 'V', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[out] VR
-*> \verbatim
-*> VR is DOUBLE PRECISION array, dimension (LDVR,N)
-*> If JOBVR = 'V', the right eigenvectors v(j) are stored one
-*> after another in the columns of VR, in the same order
-*> as their eigenvalues.
-*> If JOBVR = 'N', VR is not referenced.
-*> If the j-th eigenvalue is real, then v(j) = VR(:,j),
-*> the j-th column of VR.
-*> If the j-th and (j+1)-st eigenvalues form a complex
-*> conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
-*> v(j+1) = VR(:,j) - i*VR(:,j+1).
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR. LDVR >= 1; if
-*> JOBVR = 'V', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,3*N), and
-*> if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good
-*> performance, LWORK must generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if INFO = i, the QR algorithm failed to compute all the
-*> eigenvalues, and no eigenvectors have been computed;
-*> elements i+1:N of WR and WI contain eigenvalues which
-*> have converged.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEeigen
-*
-* =====================================================================
- SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR,
- $ LDVR, WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER JOBVL, JOBVR
- INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
- $ WI( * ), WORK( * ), WR( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, SCALEA, WANTVL, WANTVR
- CHARACTER SIDE
- INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K,
- $ MAXWRK, MINWRK, NOUT
- DOUBLE PRECISION ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM,
- $ SN
-* ..
-* .. Local Arrays ..
- LOGICAL SELECT( 1 )
- DOUBLE PRECISION DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY,
- $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX, ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE, DLAPY2, DNRM2
- EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DLANGE, DLAPY2,
- $ DNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
- WANTVL = LSAME( JOBVL, 'V' )
- WANTVR = LSAME( JOBVR, 'V' )
- IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
- INFO = -1
- ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDVL.LT.1 .OR. ( WANTVL .AND. LDVL.LT.N ) ) THEN
- INFO = -9
- ELSE IF( LDVR.LT.1 .OR. ( WANTVR .AND. LDVR.LT.N ) ) THEN
- INFO = -11
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.
-* HSWORK refers to the workspace preferred by DHSEQR, as
-* calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
-* the worst case.)
-*
- IF( INFO.EQ.0 ) THEN
- IF( N.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- ELSE
- MAXWRK = 2*N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 )
- IF( WANTVL ) THEN
- MINWRK = 4*N
- MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1,
- $ 'DORGHR', ' ', N, 1, N, -1 ) )
- CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL,
- $ WORK, -1, INFO )
- HSWORK = WORK( 1 )
- MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK )
- MAXWRK = MAX( MAXWRK, 4*N )
- ELSE IF( WANTVR ) THEN
- MINWRK = 4*N
- MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1,
- $ 'DORGHR', ' ', N, 1, N, -1 ) )
- CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR,
- $ WORK, -1, INFO )
- HSWORK = WORK( 1 )
- MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK )
- MAXWRK = MAX( MAXWRK, 4*N )
- ELSE
- MINWRK = 3*N
- CALL DHSEQR( 'E', 'N', N, 1, N, A, LDA, WR, WI, VR, LDVR,
- $ WORK, -1, INFO )
- HSWORK = WORK( 1 )
- MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK )
- END IF
- MAXWRK = MAX( MAXWRK, MINWRK )
- END IF
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEEV ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
- SMLNUM = SQRT( SMLNUM ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', N, N, A, LDA, DUM )
- SCALEA = .FALSE.
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = SMLNUM
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- SCALEA = .TRUE.
- CSCALE = BIGNUM
- END IF
- IF( SCALEA )
- $ CALL DLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
-*
-* Balance the matrix
-* (Workspace: need N)
-*
- IBAL = 1
- CALL DGEBAL( 'B', N, A, LDA, ILO, IHI, WORK( IBAL ), IERR )
-*
-* Reduce to upper Hessenberg form
-* (Workspace: need 3*N, prefer 2*N+N*NB)
-*
- ITAU = IBAL + N
- IWRK = ITAU + N
- CALL DGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
- IF( WANTVL ) THEN
-*
-* Want left eigenvectors
-* Copy Householder vectors to VL
-*
- SIDE = 'L'
- CALL DLACPY( 'L', N, N, A, LDA, VL, LDVL )
-*
-* Generate orthogonal matrix in VL
-* (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*
- CALL DORGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
-* Perform QR iteration, accumulating Schur vectors in VL
-* (Workspace: need N+1, prefer N+HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VL, LDVL,
- $ WORK( IWRK ), LWORK-IWRK+1, INFO )
-*
- IF( WANTVR ) THEN
-*
-* Want left and right eigenvectors
-* Copy Schur vectors to VR
-*
- SIDE = 'B'
- CALL DLACPY( 'F', N, N, VL, LDVL, VR, LDVR )
- END IF
-*
- ELSE IF( WANTVR ) THEN
-*
-* Want right eigenvectors
-* Copy Householder vectors to VR
-*
- SIDE = 'R'
- CALL DLACPY( 'L', N, N, A, LDA, VR, LDVR )
-*
-* Generate orthogonal matrix in VR
-* (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*
- CALL DORGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ),
- $ LWORK-IWRK+1, IERR )
-*
-* Perform QR iteration, accumulating Schur vectors in VR
-* (Workspace: need N+1, prefer N+HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR,
- $ WORK( IWRK ), LWORK-IWRK+1, INFO )
-*
- ELSE
-*
-* Compute eigenvalues only
-* (Workspace: need N+1, prefer N+HSWORK (see comments) )
-*
- IWRK = ITAU
- CALL DHSEQR( 'E', 'N', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR,
- $ WORK( IWRK ), LWORK-IWRK+1, INFO )
- END IF
-*
-* If INFO > 0 from DHSEQR, then quit
-*
- IF( INFO.GT.0 )
- $ GO TO 50
-*
- IF( WANTVL .OR. WANTVR ) THEN
-*
-* Compute left and/or right eigenvectors
-* (Workspace: need 4*N)
-*
- CALL DTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
- $ N, NOUT, WORK( IWRK ), IERR )
- END IF
-*
- IF( WANTVL ) THEN
-*
-* Undo balancing of left eigenvectors
-* (Workspace: need N)
-*
- CALL DGEBAK( 'B', 'L', N, ILO, IHI, WORK( IBAL ), N, VL, LDVL,
- $ IERR )
-*
-* Normalize left eigenvectors and make largest component real
-*
- DO 20 I = 1, N
- IF( WI( I ).EQ.ZERO ) THEN
- SCL = ONE / DNRM2( N, VL( 1, I ), 1 )
- CALL DSCAL( N, SCL, VL( 1, I ), 1 )
- ELSE IF( WI( I ).GT.ZERO ) THEN
- SCL = ONE / DLAPY2( DNRM2( N, VL( 1, I ), 1 ),
- $ DNRM2( N, VL( 1, I+1 ), 1 ) )
- CALL DSCAL( N, SCL, VL( 1, I ), 1 )
- CALL DSCAL( N, SCL, VL( 1, I+1 ), 1 )
- DO 10 K = 1, N
- WORK( IWRK+K-1 ) = VL( K, I )**2 + VL( K, I+1 )**2
- 10 CONTINUE
- K = IDAMAX( N, WORK( IWRK ), 1 )
- CALL DLARTG( VL( K, I ), VL( K, I+1 ), CS, SN, R )
- CALL DROT( N, VL( 1, I ), 1, VL( 1, I+1 ), 1, CS, SN )
- VL( K, I+1 ) = ZERO
- END IF
- 20 CONTINUE
- END IF
-*
- IF( WANTVR ) THEN
-*
-* Undo balancing of right eigenvectors
-* (Workspace: need N)
-*
- CALL DGEBAK( 'B', 'R', N, ILO, IHI, WORK( IBAL ), N, VR, LDVR,
- $ IERR )
-*
-* Normalize right eigenvectors and make largest component real
-*
- DO 40 I = 1, N
- IF( WI( I ).EQ.ZERO ) THEN
- SCL = ONE / DNRM2( N, VR( 1, I ), 1 )
- CALL DSCAL( N, SCL, VR( 1, I ), 1 )
- ELSE IF( WI( I ).GT.ZERO ) THEN
- SCL = ONE / DLAPY2( DNRM2( N, VR( 1, I ), 1 ),
- $ DNRM2( N, VR( 1, I+1 ), 1 ) )
- CALL DSCAL( N, SCL, VR( 1, I ), 1 )
- CALL DSCAL( N, SCL, VR( 1, I+1 ), 1 )
- DO 30 K = 1, N
- WORK( IWRK+K-1 ) = VR( K, I )**2 + VR( K, I+1 )**2
- 30 CONTINUE
- K = IDAMAX( N, WORK( IWRK ), 1 )
- CALL DLARTG( VR( K, I ), VR( K, I+1 ), CS, SN, R )
- CALL DROT( N, VR( 1, I ), 1, VR( 1, I+1 ), 1, CS, SN )
- VR( K, I+1 ) = ZERO
- END IF
- 40 CONTINUE
- END IF
-*
-* Undo scaling if necessary
-*
- 50 CONTINUE
- IF( SCALEA ) THEN
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WR( INFO+1 ),
- $ MAX( N-INFO, 1 ), IERR )
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WI( INFO+1 ),
- $ MAX( N-INFO, 1 ), IERR )
- IF( INFO.GT.0 ) THEN
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WR, N,
- $ IERR )
- CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WI, N,
- $ IERR )
- END IF
- END IF
-*
- WORK( 1 ) = MAXWRK
- RETURN
-*
-* End of DGEEV
-*
- END
diff --git a/mtx/lapack_src/dgehd2.f b/mtx/lapack_src/dgehd2.f
deleted file mode 100644
index 499b0d811..000000000
--- a/mtx/lapack_src/dgehd2.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b DGEHD2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEHD2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, ILO, INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEHD2 reduces a real general matrix A to upper Hessenberg form H by
-*> an orthogonal similarity transformation: Q**T * A * Q = H .
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> It is assumed that A is already upper triangular in rows
-*> and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
-*> set by a previous call to DGEBAL; otherwise they should be
-*> set to 1 and N respectively. See Further Details.
-*> 1 <= ILO <= IHI <= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the n by n general matrix to be reduced.
-*> On exit, the upper triangle and the first subdiagonal of A
-*> are overwritten with the upper Hessenberg matrix H, and the
-*> elements below the first subdiagonal, with the array TAU,
-*> represent the orthogonal matrix Q as a product of elementary
-*> reflectors. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (N-1)
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of (ihi-ilo) elementary
-*> reflectors
-*>
-*> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
-*> exit in A(i+2:ihi,i), and tau in TAU(i).
-*>
-*> The contents of A are illustrated by the following example, with
-*> n = 7, ilo = 2 and ihi = 6:
-*>
-*> on entry, on exit,
-*>
-*> ( a a a a a a a ) ( a a h h h h a )
-*> ( a a a a a a ) ( a h h h h a )
-*> ( a a a a a a ) ( h h h h h h )
-*> ( a a a a a a ) ( v2 h h h h h )
-*> ( a a a a a a ) ( v2 v3 h h h h )
-*> ( a a a a a a ) ( v2 v3 v4 h h h )
-*> ( a ) ( a )
-*>
-*> where a denotes an element of the original matrix A, h denotes a
-*> modified element of the upper Hessenberg matrix H, and vi denotes an
-*> element of the vector defining H(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHI, ILO, INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION AII
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
- INFO = -2
- ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEHD2', -INFO )
- RETURN
- END IF
-*
- DO 10 I = ILO, IHI - 1
-*
-* Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
-*
- CALL DLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
- $ TAU( I ) )
- AII = A( I+1, I )
- A( I+1, I ) = ONE
-*
-* Apply H(i) to A(1:ihi,i+1:ihi) from the right
-*
- CALL DLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
- $ A( 1, I+1 ), LDA, WORK )
-*
-* Apply H(i) to A(i+1:ihi,i+1:n) from the left
-*
- CALL DLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1, TAU( I ),
- $ A( I+1, I+1 ), LDA, WORK )
-*
- A( I+1, I ) = AII
- 10 CONTINUE
-*
- RETURN
-*
-* End of DGEHD2
-*
- END
diff --git a/mtx/lapack_src/dgehrd.f b/mtx/lapack_src/dgehrd.f
deleted file mode 100644
index 0dda2e2f9..000000000
--- a/mtx/lapack_src/dgehrd.f
+++ /dev/null
@@ -1,352 +0,0 @@
-*> \brief \b DGEHRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEHRD + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, ILO, INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEHRD reduces a real general matrix A to upper Hessenberg form H by
-*> an orthogonal similarity transformation: Q**T * A * Q = H .
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> It is assumed that A is already upper triangular in rows
-*> and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
-*> set by a previous call to DGEBAL; otherwise they should be
-*> set to 1 and N respectively. See Further Details.
-*> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N general matrix to be reduced.
-*> On exit, the upper triangle and the first subdiagonal of A
-*> are overwritten with the upper Hessenberg matrix H, and the
-*> elements below the first subdiagonal, with the array TAU,
-*> represent the orthogonal matrix Q as a product of elementary
-*> reflectors. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (N-1)
-*> The scalar factors of the elementary reflectors (see Further
-*> Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to
-*> zero.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The length of the array WORK. LWORK >= max(1,N).
-*> For optimum performance LWORK >= N*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of (ihi-ilo) elementary
-*> reflectors
-*>
-*> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
-*> exit in A(i+2:ihi,i), and tau in TAU(i).
-*>
-*> The contents of A are illustrated by the following example, with
-*> n = 7, ilo = 2 and ihi = 6:
-*>
-*> on entry, on exit,
-*>
-*> ( a a a a a a a ) ( a a h h h h a )
-*> ( a a a a a a ) ( a h h h h a )
-*> ( a a a a a a ) ( h h h h h h )
-*> ( a a a a a a ) ( v2 h h h h h )
-*> ( a a a a a a ) ( v2 v3 h h h h )
-*> ( a a a a a a ) ( v2 v3 v4 h h h )
-*> ( a ) ( a )
-*>
-*> where a denotes an element of the original matrix A, h denotes a
-*> modified element of the upper Hessenberg matrix H, and vi denotes an
-*> element of the vector defining H(i).
-*>
-*> This file is a slight modification of LAPACK-3.0's DGEHRD
-*> subroutine incorporating improvements proposed by Quintana-Orti and
-*> Van de Geijn (2006). (See DLAHR2.)
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHI, ILO, INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NBMAX, LDT
- PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0,
- $ ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, J, LDWORK, LWKOPT, NB,
- $ NBMIN, NH, NX
- DOUBLE PRECISION EI
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION T( LDT, NBMAX )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DGEHD2, DGEMM, DLAHR2, DLARFB, DTRMM,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, -1 ) )
- LWKOPT = N*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
- INFO = -2
- ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEHRD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Set elements 1:ILO-1 and IHI:N-1 of TAU to zero
-*
- DO 10 I = 1, ILO - 1
- TAU( I ) = ZERO
- 10 CONTINUE
- DO 20 I = MAX( 1, IHI ), N - 1
- TAU( I ) = ZERO
- 20 CONTINUE
-*
-* Quick return if possible
-*
- NH = IHI - ILO + 1
- IF( NH.LE.1 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
-* Determine the block size
-*
- NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, -1 ) )
- NBMIN = 2
- IWS = 1
- IF( NB.GT.1 .AND. NB.LT.NH ) THEN
-*
-* Determine when to cross over from blocked to unblocked code
-* (last block is always handled by unblocked code)
-*
- NX = MAX( NB, ILAENV( 3, 'DGEHRD', ' ', N, ILO, IHI, -1 ) )
- IF( NX.LT.NH ) THEN
-*
-* Determine if workspace is large enough for blocked code
-*
- IWS = N*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: determine the
-* minimum value of NB, and reduce NB or force use of
-* unblocked code
-*
- NBMIN = MAX( 2, ILAENV( 2, 'DGEHRD', ' ', N, ILO, IHI,
- $ -1 ) )
- IF( LWORK.GE.N*NBMIN ) THEN
- NB = LWORK / N
- ELSE
- NB = 1
- END IF
- END IF
- END IF
- END IF
- LDWORK = N
-*
- IF( NB.LT.NBMIN .OR. NB.GE.NH ) THEN
-*
-* Use unblocked code below
-*
- I = ILO
-*
- ELSE
-*
-* Use blocked code
-*
- DO 40 I = ILO, IHI - 1 - NX, NB
- IB = MIN( NB, IHI-I )
-*
-* Reduce columns i:i+ib-1 to Hessenberg form, returning the
-* matrices V and T of the block reflector H = I - V*T*V**T
-* which performs the reduction, and also the matrix Y = A*V*T
-*
- CALL DLAHR2( IHI, I, IB, A( 1, I ), LDA, TAU( I ), T, LDT,
- $ WORK, LDWORK )
-*
-* Apply the block reflector H to A(1:ihi,i+ib:ihi) from the
-* right, computing A := A - Y * V**T. V(i+ib,ib-1) must be set
-* to 1
-*
- EI = A( I+IB, I+IB-1 )
- A( I+IB, I+IB-1 ) = ONE
- CALL DGEMM( 'No transpose', 'Transpose',
- $ IHI, IHI-I-IB+1,
- $ IB, -ONE, WORK, LDWORK, A( I+IB, I ), LDA, ONE,
- $ A( 1, I+IB ), LDA )
- A( I+IB, I+IB-1 ) = EI
-*
-* Apply the block reflector H to A(1:i,i+1:i+ib-1) from the
-* right
-*
- CALL DTRMM( 'Right', 'Lower', 'Transpose',
- $ 'Unit', I, IB-1,
- $ ONE, A( I+1, I ), LDA, WORK, LDWORK )
- DO 30 J = 0, IB-2
- CALL DAXPY( I, -ONE, WORK( LDWORK*J+1 ), 1,
- $ A( 1, I+J+1 ), 1 )
- 30 CONTINUE
-*
-* Apply the block reflector H to A(i+1:ihi,i+ib:n) from the
-* left
-*
- CALL DLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise',
- $ IHI-I, N-I-IB+1, IB, A( I+1, I ), LDA, T, LDT,
- $ A( I+1, I+IB ), LDA, WORK, LDWORK )
- 40 CONTINUE
- END IF
-*
-* Use unblocked code to reduce the rest of the matrix
-*
- CALL DGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO )
- WORK( 1 ) = IWS
-*
- RETURN
-*
-* End of DGEHRD
-*
- END
diff --git a/mtx/lapack_src/dgelq2.f b/mtx/lapack_src/dgelq2.f
deleted file mode 100644
index 73315c9c8..000000000
--- a/mtx/lapack_src/dgelq2.f
+++ /dev/null
@@ -1,192 +0,0 @@
-*> \brief \b DGELQ2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGELQ2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGELQ2 computes an LQ factorization of a real m by n matrix A:
-*> A = L * Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the m by n matrix A.
-*> On exit, the elements on and below the diagonal of the array
-*> contain the m by min(m,n) lower trapezoidal matrix L (L is
-*> lower triangular if m <= n); the elements above the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of elementary reflectors (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (M)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K
- DOUBLE PRECISION AII
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGELQ2', -INFO )
- RETURN
- END IF
-*
- K = MIN( M, N )
-*
- DO 10 I = 1, K
-*
-* Generate elementary reflector H(i) to annihilate A(i,i+1:n)
-*
- CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
- $ TAU( I ) )
- IF( I.LT.M ) THEN
-*
-* Apply H(i) to A(i+1:m,i:n) from the right
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAU( I ),
- $ A( I+1, I ), LDA, WORK )
- A( I, I ) = AII
- END IF
- 10 CONTINUE
- RETURN
-*
-* End of DGELQ2
-*
- END
diff --git a/mtx/lapack_src/dgelqf.f b/mtx/lapack_src/dgelqf.f
deleted file mode 100644
index d27b04ab1..000000000
--- a/mtx/lapack_src/dgelqf.f
+++ /dev/null
@@ -1,269 +0,0 @@
-*> \brief \b DGELQF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGELQF + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGELQF computes an LQ factorization of a real M-by-N matrix A:
-*> A = L * Q.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and below the diagonal of the array
-*> contain the m-by-min(m,n) lower trapezoidal matrix L (L is
-*> lower triangular if m <= n); the elements above the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of elementary reflectors (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,M).
-*> For optimum performance LWORK >= M*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(k) . . . H(2) H(1), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
- $ NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL DGELQ2, DLARFB, DLARFT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NB = ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
- LWKOPT = M*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGELQF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- K = MIN( M, N )
- IF( K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = M
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'DGELQF', ' ', M, N, -1, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = M
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DGELQF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code initially
-*
- DO 10 I = 1, K - NX, NB
- IB = MIN( K-I+1, NB )
-*
-* Compute the LQ factorization of the current block
-* A(i:i+ib-1,i:n)
-*
- CALL DGELQ2( IB, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
- IF( I+IB.LE.M ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ),
- $ LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H to A(i+ib:m,i:n) from the right
-*
- CALL DLARFB( 'Right', 'No transpose', 'Forward',
- $ 'Rowwise', M-I-IB+1, N-I+1, IB, A( I, I ),
- $ LDA, WORK, LDWORK, A( I+IB, I ), LDA,
- $ WORK( IB+1 ), LDWORK )
- END IF
- 10 CONTINUE
- ELSE
- I = 1
- END IF
-*
-* Use unblocked code to factor the last or only block.
-*
- IF( I.LE.K )
- $ CALL DGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DGELQF
-*
- END
diff --git a/mtx/lapack_src/dgeqr2.f b/mtx/lapack_src/dgeqr2.f
deleted file mode 100644
index d253d6bd6..000000000
--- a/mtx/lapack_src/dgeqr2.f
+++ /dev/null
@@ -1,192 +0,0 @@
-*> \brief \b DGEQR2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEQR2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEQR2 computes a QR factorization of a real m by n matrix A:
-*> A = Q * R.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the m by n matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(m,n) by n upper trapezoidal matrix R (R is
-*> upper triangular if m >= n); the elements below the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of elementary reflectors (see Further Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, K
- DOUBLE PRECISION AII
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DLARFG, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEQR2', -INFO )
- RETURN
- END IF
-*
- K = MIN( M, N )
-*
- DO 10 I = 1, K
-*
-* Generate elementary reflector H(i) to annihilate A(i+1:m,i)
-*
- CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
- $ TAU( I ) )
- IF( I.LT.N ) THEN
-*
-* Apply H(i) to A(i:m,i+1:n) from the left
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
- $ A( I, I+1 ), LDA, WORK )
- A( I, I ) = AII
- END IF
- 10 CONTINUE
- RETURN
-*
-* End of DGEQR2
-*
- END
diff --git a/mtx/lapack_src/dgeqrf.f b/mtx/lapack_src/dgeqrf.f
deleted file mode 100644
index 299025758..000000000
--- a/mtx/lapack_src/dgeqrf.f
+++ /dev/null
@@ -1,270 +0,0 @@
-*> \brief \b DGEQRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGEQRF + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGEQRF computes a QR factorization of a real M-by-N matrix A:
-*> A = Q * R.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and above the diagonal of the array
-*> contain the min(M,N)-by-N upper trapezoidal matrix R (R is
-*> upper triangular if m >= n); the elements below the diagonal,
-*> with the array TAU, represent the orthogonal matrix Q as a
-*> product of min(m,n) elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
-*> The scalar factors of the elementary reflectors (see Further
-*> Details).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> For optimum performance LWORK >= N*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-*> and tau in TAU(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
- $ NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEQR2, DLARFB, DLARFT, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
- LWKOPT = N*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGEQRF', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- K = MIN( M, N )
- IF( K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = N
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'DGEQRF', ' ', M, N, -1, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = N
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DGEQRF', ' ', M, N, -1,
- $ -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code initially
-*
- DO 10 I = 1, K - NX, NB
- IB = MIN( K-I+1, NB )
-*
-* Compute the QR factorization of the current block
-* A(i:m,i:i+ib-1)
-*
- CALL DGEQR2( M-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
- IF( I+IB.LE.N ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB,
- $ A( I, I ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H**T to A(i:m,i+ib:n) from the left
-*
- CALL DLARFB( 'Left', 'Transpose', 'Forward',
- $ 'Columnwise', M-I+1, N-I-IB+1, IB,
- $ A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
- $ LDA, WORK( IB+1 ), LDWORK )
- END IF
- 10 CONTINUE
- ELSE
- I = 1
- END IF
-*
-* Use unblocked code to factor the last or only block.
-*
- IF( I.LE.K )
- $ CALL DGEQR2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DGEQRF
-*
- END
diff --git a/mtx/lapack_src/dgerfs.f b/mtx/lapack_src/dgerfs.f
deleted file mode 100644
index 9a48db9e1..000000000
--- a/mtx/lapack_src/dgerfs.f
+++ /dev/null
@@ -1,438 +0,0 @@
-*> \brief \b DGERFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGERFS + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
-* X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-* $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DGERFS improves the computed solution to a system of linear
-*> equations and provides error bounds and backward error estimates for
-*> the solution.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The original N-by-N matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] AF
-*> \verbatim
-*> AF is DOUBLE PRECISION array, dimension (LDAF,N)
-*> The factors L and U from the factorization A = P*L*U
-*> as computed by DGETRF.
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from DGETRF; for 1<=i<=N, row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by DGETRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
- $ X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
- $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D+0 )
- DOUBLE PRECISION THREE
- PARAMETER ( THREE = 3.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
- CHARACTER TRANST
- INTEGER COUNT, I, J, K, KASE, NZ
- DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGEMV, DGETRS, DLACN2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -12
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGERFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = N + 1
- EPS = DLAMCH( 'Epsilon' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 140 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - op(A) * X,
-* where op(A) = A, A**T, or A**H, depending on TRANS.
-*
- CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL DGEMV( TRANS, N, N, -ONE, A, LDA, X( 1, J ), 1, ONE,
- $ WORK( N+1 ), 1 )
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- DO 30 I = 1, N
- WORK( I ) = ABS( B( I, J ) )
- 30 CONTINUE
-*
-* Compute abs(op(A))*abs(X) + abs(B).
-*
- IF( NOTRAN ) THEN
- DO 50 K = 1, N
- XK = ABS( X( K, J ) )
- DO 40 I = 1, N
- WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
- 40 CONTINUE
- 50 CONTINUE
- ELSE
- DO 70 K = 1, N
- S = ZERO
- DO 60 I = 1, N
- S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
- 60 CONTINUE
- WORK( K ) = WORK( K ) + S
- 70 CONTINUE
- END IF
- S = ZERO
- DO 80 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 80 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL DGETRS( TRANS, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N,
- $ INFO )
- CALL DAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(op(A)))*
-* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(op(A)) is the inverse of op(A)
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-* Use DLACN2 to estimate the infinity-norm of the matrix
-* inv(op(A)) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
- DO 90 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 90 CONTINUE
-*
- KASE = 0
- 100 CONTINUE
- CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(op(A)**T).
-*
- CALL DGETRS( TRANST, N, 1, AF, LDAF, IPIV, WORK( N+1 ),
- $ N, INFO )
- DO 110 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 110 CONTINUE
- ELSE
-*
-* Multiply by inv(op(A))*diag(W).
-*
- DO 120 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 120 CONTINUE
- CALL DGETRS( TRANS, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N,
- $ INFO )
- END IF
- GO TO 100
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 130 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 130 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 140 CONTINUE
-*
- RETURN
-*
-* End of DGERFS
-*
- END
diff --git a/mtx/lapack_src/dgesv.f b/mtx/lapack_src/dgesv.f
deleted file mode 100644
index 8d47f839d..000000000
--- a/mtx/lapack_src/dgesv.f
+++ /dev/null
@@ -1,179 +0,0 @@
-*> \brief DGESV computes the solution to system of linear equations A * X = B for GE matrices
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGESV + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N coefficient matrix A.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U; the unit diagonal elements of L are not stored.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices that define the permutation matrix P;
-*> row i of the matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS matrix of right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, so the solution could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEsolve
-*
-* =====================================================================
- SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Subroutines ..
- EXTERNAL DGETRF, DGETRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGESV ', -INFO )
- RETURN
- END IF
-*
-* Compute the LU factorization of A.
-*
- CALL DGETRF( N, N, A, LDA, IPIV, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL DGETRS( 'No transpose', N, NRHS, A, LDA, IPIV, B, LDB,
- $ INFO )
- END IF
- RETURN
-*
-* End of DGESV
-*
- END
diff --git a/mtx/lapack_src/dgesvd.f b/mtx/lapack_src/dgesvd.f
deleted file mode 100644
index 898570b66..000000000
--- a/mtx/lapack_src/dgesvd.f
+++ /dev/null
@@ -1,3493 +0,0 @@
-*> \brief DGESVD computes the singular value decomposition (SVD) for GE matrices
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGESVD + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER JOBU, JOBVT
-* INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), S( * ), U( LDU, * ),
-* $ VT( LDVT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOBU
-*> \verbatim
-*> JOBU is CHARACTER*1
-*> Specifies options for computing all or part of the matrix U:
-*> = 'A': all M columns of U are returned in array U:
-*> = 'S': the first min(m,n) columns of U (the left singular
-*> vectors) are returned in the array U;
-*> = 'O': the first min(m,n) columns of U (the left singular
-*> vectors) are overwritten on the array A;
-*> = 'N': no columns of U (no left singular vectors) are
-*> computed.
-*> \endverbatim
-*>
-*> \param[in] JOBVT
-*> \verbatim
-*> JOBVT is CHARACTER*1
-*> Specifies options for computing all or part of the matrix
-*> V**T:
-*> = 'A': all N rows of V**T are returned in the array VT;
-*> = 'S': the first min(m,n) rows of V**T (the right singular
-*> vectors) are returned in the array VT;
-*> = 'O': the first min(m,n) rows of V**T (the right singular
-*> vectors) are overwritten on the array A;
-*> = 'N': no rows of V**T (no right singular vectors) are
-*> computed.
-*>
-*> JOBVT and JOBU cannot both be 'O'.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the input matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the input matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix A.
-*> On exit,
-*> if JOBU = 'O', A is overwritten with the first min(m,n)
-*> columns of U (the left singular vectors,
-*> stored columnwise);
-*> if JOBVT = 'O', A is overwritten with the first min(m,n)
-*> rows of V**T (the right singular vectors,
-*> stored rowwise);
-*> if JOBU .ne. 'O' and JOBVT .ne. 'O', the contents of A
-*> are destroyed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension (min(M,N))
-*> The singular values of A, sorted so that S(i) >= S(i+1).
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array, dimension (LDU,UCOL)
-*> (LDU,M) if JOBU = 'A' or (LDU,min(M,N)) if JOBU = 'S'.
-*> If JOBU = 'A', U contains the M-by-M orthogonal matrix U;
-*> if JOBU = 'S', U contains the first min(m,n) columns of U
-*> (the left singular vectors, stored columnwise);
-*> if JOBU = 'N' or 'O', U is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is INTEGER
-*> The leading dimension of the array U. LDU >= 1; if
-*> JOBU = 'S' or 'A', LDU >= M.
-*> \endverbatim
-*>
-*> \param[out] VT
-*> \verbatim
-*> VT is DOUBLE PRECISION array, dimension (LDVT,N)
-*> If JOBVT = 'A', VT contains the N-by-N orthogonal matrix
-*> V**T;
-*> if JOBVT = 'S', VT contains the first min(m,n) rows of
-*> V**T (the right singular vectors, stored rowwise);
-*> if JOBVT = 'N' or 'O', VT is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDVT
-*> \verbatim
-*> LDVT is INTEGER
-*> The leading dimension of the array VT. LDVT >= 1; if
-*> JOBVT = 'A', LDVT >= N; if JOBVT = 'S', LDVT >= min(M,N).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
-*> if INFO > 0, WORK(2:MIN(M,N)) contains the unconverged
-*> superdiagonal elements of an upper bidiagonal matrix B
-*> whose diagonal is in S (not necessarily sorted). B
-*> satisfies A = U * B * VT, so it has the same singular values
-*> as A, and singular vectors related by U and VT.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> LWORK >= MAX(1,5*MIN(M,N)) for the paths (see comments inside code):
-*> - PATH 1 (M much larger than N, JOBU='N')
-*> - PATH 1t (N much larger than M, JOBVT='N')
-*> LWORK >= MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) for the other paths
-*> For good performance, LWORK should generally be larger.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit.
-*> < 0: if INFO = -i, the i-th argument had an illegal value.
-*> > 0: if DBDSQR did not converge, INFO specifies how many
-*> superdiagonals of an intermediate bidiagonal form B
-*> did not converge to zero. See the description of WORK
-*> above for details.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleGEsing
-*
-* =====================================================================
- SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU,
- $ VT, LDVT, WORK, LWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER JOBU, JOBVT
- INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), S( * ), U( LDU, * ),
- $ VT( LDVT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS,
- $ WNTVA, WNTVAS, WNTVN, WNTVO, WNTVS
- INTEGER BDSPAC, BLK, CHUNK, I, IE, IERR, IR, ISCL,
- $ ITAU, ITAUP, ITAUQ, IU, IWORK, LDWRKR, LDWRKU,
- $ MAXWRK, MINMN, MINWRK, MNTHR, NCU, NCVT, NRU,
- $ NRVT, WRKBL
- INTEGER LWORK_DGEQRF, LWORK_DORGQR_N, LWORK_DORGQR_M,
- $ LWORK_DGEBRD, LWORK_DORGBR_P, LWORK_DORGBR_Q,
- $ LWORK_DGELQF, LWORK_DORGLQ_N, LWORK_DORGLQ_M
- DOUBLE PRECISION ANRM, BIGNUM, EPS, SMLNUM
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION DUM( 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DBDSQR, DGEBRD, DGELQF, DGEMM, DGEQRF, DLACPY,
- $ DLASCL, DLASET, DORGBR, DORGLQ, DORGQR, DORMBR,
- $ XERBLA
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- MINMN = MIN( M, N )
- WNTUA = LSAME( JOBU, 'A' )
- WNTUS = LSAME( JOBU, 'S' )
- WNTUAS = WNTUA .OR. WNTUS
- WNTUO = LSAME( JOBU, 'O' )
- WNTUN = LSAME( JOBU, 'N' )
- WNTVA = LSAME( JOBVT, 'A' )
- WNTVS = LSAME( JOBVT, 'S' )
- WNTVAS = WNTVA .OR. WNTVS
- WNTVO = LSAME( JOBVT, 'O' )
- WNTVN = LSAME( JOBVT, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
- IF( .NOT.( WNTUA .OR. WNTUS .OR. WNTUO .OR. WNTUN ) ) THEN
- INFO = -1
- ELSE IF( .NOT.( WNTVA .OR. WNTVS .OR. WNTVO .OR. WNTVN ) .OR.
- $ ( WNTVO .AND. WNTUO ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -6
- ELSE IF( LDU.LT.1 .OR. ( WNTUAS .AND. LDU.LT.M ) ) THEN
- INFO = -9
- ELSE IF( LDVT.LT.1 .OR. ( WNTVA .AND. LDVT.LT.N ) .OR.
- $ ( WNTVS .AND. LDVT.LT.MINMN ) ) THEN
- INFO = -11
- END IF
-*
-* Compute workspace
-* (Note: Comments in the code beginning "Workspace:" describe the
-* minimal amount of workspace needed at that point in the code,
-* as well as the preferred amount for good performance.
-* NB refers to the optimal block size for the immediately
-* following subroutine, as returned by ILAENV.)
-*
- IF( INFO.EQ.0 ) THEN
- MINWRK = 1
- MAXWRK = 1
- IF( M.GE.N .AND. MINMN.GT.0 ) THEN
-*
-* Compute space needed for DBDSQR
-*
- MNTHR = ILAENV( 6, 'DGESVD', JOBU // JOBVT, M, N, 0, 0 )
- BDSPAC = 5*N
-* Compute space needed for DGEQRF
- CALL DGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR )
- LWORK_DGEQRF=DUM(1)
-* Compute space needed for DORGQR
- CALL DORGQR( M, N, N, A, LDA, DUM(1), DUM(1), -1, IERR )
- LWORK_DORGQR_N=DUM(1)
- CALL DORGQR( M, M, N, A, LDA, DUM(1), DUM(1), -1, IERR )
- LWORK_DORGQR_M=DUM(1)
-* Compute space needed for DGEBRD
- CALL DGEBRD( N, N, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, IERR )
- LWORK_DGEBRD=DUM(1)
-* Compute space needed for DORGBR P
- CALL DORGBR( 'P', N, N, N, A, LDA, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_P=DUM(1)
-* Compute space needed for DORGBR Q
- CALL DORGBR( 'Q', N, N, N, A, LDA, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_Q=DUM(1)
-*
- IF( M.GE.MNTHR ) THEN
- IF( WNTUN ) THEN
-*
-* Path 1 (M much larger than N, JOBU='N')
-*
- MAXWRK = N + LWORK_DGEQRF
- MAXWRK = MAX( MAXWRK, 3*N+LWORK_DGEBRD )
- IF( WNTVO .OR. WNTVAS )
- $ MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_P )
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MINWRK = MAX( 4*N, BDSPAC )
- ELSE IF( WNTUO .AND. WNTVN ) THEN
-*
-* Path 2 (M much larger than N, JOBU='O', JOBVT='N')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = MAX( N*N+WRKBL, N*N+M*N+N )
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUO .AND. WNTVAS ) THEN
-*
-* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or
-* 'A')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = MAX( N*N+WRKBL, N*N+M*N+N )
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUS .AND. WNTVN ) THEN
-*
-* Path 4 (M much larger than N, JOBU='S', JOBVT='N')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUS .AND. WNTVO ) THEN
-*
-* Path 5 (M much larger than N, JOBU='S', JOBVT='O')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = 2*N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUS .AND. WNTVAS ) THEN
-*
-* Path 6 (M much larger than N, JOBU='S', JOBVT='S' or
-* 'A')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUA .AND. WNTVN ) THEN
-*
-* Path 7 (M much larger than N, JOBU='A', JOBVT='N')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_M )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUA .AND. WNTVO ) THEN
-*
-* Path 8 (M much larger than N, JOBU='A', JOBVT='O')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_M )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = 2*N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- ELSE IF( WNTUA .AND. WNTVAS ) THEN
-*
-* Path 9 (M much larger than N, JOBU='A', JOBVT='S' or
-* 'A')
-*
- WRKBL = N + LWORK_DGEQRF
- WRKBL = MAX( WRKBL, N+LWORK_DORGQR_M )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = N*N + WRKBL
- MINWRK = MAX( 3*N+M, BDSPAC )
- END IF
- ELSE
-*
-* Path 10 (M at least N, but not much larger)
-*
- CALL DGEBRD( M, N, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, IERR )
- LWORK_DGEBRD=DUM(1)
- MAXWRK = 3*N + LWORK_DGEBRD
- IF( WNTUS .OR. WNTUO ) THEN
- CALL DORGBR( 'Q', M, N, N, A, LDA, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_Q=DUM(1)
- MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_Q )
- END IF
- IF( WNTUA ) THEN
- CALL DORGBR( 'Q', M, M, N, A, LDA, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_Q=DUM(1)
- MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_Q )
- END IF
- IF( .NOT.WNTVN ) THEN
- MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_P )
- END IF
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MINWRK = MAX( 3*N+M, BDSPAC )
- END IF
- ELSE IF( MINMN.GT.0 ) THEN
-*
-* Compute space needed for DBDSQR
-*
- MNTHR = ILAENV( 6, 'DGESVD', JOBU // JOBVT, M, N, 0, 0 )
- BDSPAC = 5*M
-* Compute space needed for DGELQF
- CALL DGELQF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR )
- LWORK_DGELQF=DUM(1)
-* Compute space needed for DORGLQ
- CALL DORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, IERR )
- LWORK_DORGLQ_N=DUM(1)
- CALL DORGLQ( M, N, M, A, LDA, DUM(1), DUM(1), -1, IERR )
- LWORK_DORGLQ_M=DUM(1)
-* Compute space needed for DGEBRD
- CALL DGEBRD( M, M, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, IERR )
- LWORK_DGEBRD=DUM(1)
-* Compute space needed for DORGBR P
- CALL DORGBR( 'P', M, M, M, A, N, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_P=DUM(1)
-* Compute space needed for DORGBR Q
- CALL DORGBR( 'Q', M, M, M, A, N, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_Q=DUM(1)
- IF( N.GE.MNTHR ) THEN
- IF( WNTVN ) THEN
-*
-* Path 1t(N much larger than M, JOBVT='N')
-*
- MAXWRK = M + LWORK_DGELQF
- MAXWRK = MAX( MAXWRK, 3*M+LWORK_DGEBRD )
- IF( WNTUO .OR. WNTUAS )
- $ MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_Q )
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MINWRK = MAX( 4*M, BDSPAC )
- ELSE IF( WNTVO .AND. WNTUN ) THEN
-*
-* Path 2t(N much larger than M, JOBU='N', JOBVT='O')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = MAX( M*M+WRKBL, M*M+M*N+M )
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVO .AND. WNTUAS ) THEN
-*
-* Path 3t(N much larger than M, JOBU='S' or 'A',
-* JOBVT='O')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = MAX( M*M+WRKBL, M*M+M*N+M )
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVS .AND. WNTUN ) THEN
-*
-* Path 4t(N much larger than M, JOBU='N', JOBVT='S')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVS .AND. WNTUO ) THEN
-*
-* Path 5t(N much larger than M, JOBU='O', JOBVT='S')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = 2*M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVS .AND. WNTUAS ) THEN
-*
-* Path 6t(N much larger than M, JOBU='S' or 'A',
-* JOBVT='S')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVA .AND. WNTUN ) THEN
-*
-* Path 7t(N much larger than M, JOBU='N', JOBVT='A')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_N )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVA .AND. WNTUO ) THEN
-*
-* Path 8t(N much larger than M, JOBU='O', JOBVT='A')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_N )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = 2*M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- ELSE IF( WNTVA .AND. WNTUAS ) THEN
-*
-* Path 9t(N much larger than M, JOBU='S' or 'A',
-* JOBVT='A')
-*
- WRKBL = M + LWORK_DGELQF
- WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_N )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P )
- WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q )
- WRKBL = MAX( WRKBL, BDSPAC )
- MAXWRK = M*M + WRKBL
- MINWRK = MAX( 3*M+N, BDSPAC )
- END IF
- ELSE
-*
-* Path 10t(N greater than M, but not much larger)
-*
- CALL DGEBRD( M, N, A, LDA, S, DUM(1), DUM(1),
- $ DUM(1), DUM(1), -1, IERR )
- LWORK_DGEBRD=DUM(1)
- MAXWRK = 3*M + LWORK_DGEBRD
- IF( WNTVS .OR. WNTVO ) THEN
-* Compute space needed for DORGBR P
- CALL DORGBR( 'P', M, N, M, A, N, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_P=DUM(1)
- MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_P )
- END IF
- IF( WNTVA ) THEN
- CALL DORGBR( 'P', N, N, M, A, N, DUM(1),
- $ DUM(1), -1, IERR )
- LWORK_DORGBR_P=DUM(1)
- MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_P )
- END IF
- IF( .NOT.WNTUN ) THEN
- MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_Q )
- END IF
- MAXWRK = MAX( MAXWRK, BDSPAC )
- MINWRK = MAX( 3*M+N, BDSPAC )
- END IF
- END IF
- MAXWRK = MAX( MAXWRK, MINWRK )
- WORK( 1 ) = MAXWRK
-*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGESVD', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- RETURN
- END IF
-*
-* Get machine constants
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = SQRT( DLAMCH( 'S' ) ) / EPS
- BIGNUM = ONE / SMLNUM
-*
-* Scale A if max element outside range [SMLNUM,BIGNUM]
-*
- ANRM = DLANGE( 'M', M, N, A, LDA, DUM )
- ISCL = 0
- IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
- ISCL = 1
- CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, IERR )
- ELSE IF( ANRM.GT.BIGNUM ) THEN
- ISCL = 1
- CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, IERR )
- END IF
-*
- IF( M.GE.N ) THEN
-*
-* A has at least as many rows as columns. If A has sufficiently
-* more rows than columns, first reduce using the QR
-* decomposition (if sufficient workspace available)
-*
- IF( M.GE.MNTHR ) THEN
-*
- IF( WNTUN ) THEN
-*
-* Path 1 (M much larger than N, JOBU='N')
-* No left singular vectors to be computed
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Zero out below R
-*
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA )
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ IERR )
- NCVT = 0
- IF( WNTVO .OR. WNTVAS ) THEN
-*
-* If right singular vectors desired, generate P'.
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- NCVT = N
- END IF
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of A in A if desired
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, NCVT, 0, 0, S, WORK( IE ), A, LDA,
- $ DUM, 1, DUM, 1, WORK( IWORK ), INFO )
-*
-* If right singular vectors desired in VT, copy them there
-*
- IF( WNTVAS )
- $ CALL DLACPY( 'F', N, N, A, LDA, VT, LDVT )
-*
- ELSE IF( WNTUO .AND. WNTVN ) THEN
-*
-* Path 2 (M much larger than N, JOBU='O', JOBVT='N')
-* N left singular vectors to be overwritten on A and
-* no right singular vectors to be computed
-*
- IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+LDA*N ) THEN
-*
-* WORK(IU) is LDA by N, WORK(IR) is LDA by N
-*
- LDWRKU = LDA
- LDWRKR = LDA
- ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+N*N ) THEN
-*
-* WORK(IU) is LDA by N, WORK(IR) is N by N
-*
- LDWRKU = LDA
- LDWRKR = N
- ELSE
-*
-* WORK(IU) is LDWRKU by N, WORK(IR) is N by N
-*
- LDWRKU = ( LWORK-N*N-N ) / N
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IR) and zero out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ),
- $ LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left vectors bidiagonalizing R
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IR)
-* (Workspace: need N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, 1,
- $ WORK( IR ), LDWRKR, DUM, 1,
- $ WORK( IWORK ), INFO )
- IU = IE + N
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IR), storing result in WORK(IU) and copying to A
-* (Workspace: need N*N+2*N, prefer N*N+M*N+N)
-*
- DO 10 I = 1, M, LDWRKU
- CHUNK = MIN( M-I+1, LDWRKU )
- CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ),
- $ LDA, WORK( IR ), LDWRKR, ZERO,
- $ WORK( IU ), LDWRKU )
- CALL DLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU,
- $ A( I, 1 ), LDA )
- 10 CONTINUE
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize A
-* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB)
-*
- CALL DGEBRD( M, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left vectors bidiagonalizing A
-* (Workspace: need 4*N, prefer 3*N+N*NB)
-*
- CALL DORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in A
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM, 1,
- $ A, LDA, DUM, 1, WORK( IWORK ), INFO )
-*
- END IF
-*
- ELSE IF( WNTUO .AND. WNTVAS ) THEN
-*
-* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or 'A')
-* N left singular vectors to be overwritten on A and
-* N right singular vectors to be computed in VT
-*
- IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+LDA*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is LDA by N
-*
- LDWRKU = LDA
- LDWRKR = LDA
- ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+N*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is N by N
-*
- LDWRKU = LDA
- LDWRKR = N
- ELSE
-*
-* WORK(IU) is LDWRKU by N and WORK(IR) is N by N
-*
- LDWRKU = ( LWORK-N*N-N ) / N
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to VT, zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
- IF( N.GT.1 )
- $ CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ VT( 2, 1 ), LDVT )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in VT, copying result to WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', N, N, VT, LDVT, WORK( IR ), LDWRKR )
-*
-* Generate left vectors bidiagonalizing R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing R in VT
-* (Workspace: need N*N+4*N-1, prefer N*N+3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IR) and computing right
-* singular vectors of R in VT
-* (Workspace: need N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT, LDVT,
- $ WORK( IR ), LDWRKR, DUM, 1,
- $ WORK( IWORK ), INFO )
- IU = IE + N
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IR), storing result in WORK(IU) and copying to A
-* (Workspace: need N*N+2*N, prefer N*N+M*N+N)
-*
- DO 20 I = 1, M, LDWRKU
- CHUNK = MIN( M-I+1, LDWRKU )
- CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ),
- $ LDA, WORK( IR ), LDWRKR, ZERO,
- $ WORK( IU ), LDWRKU )
- CALL DLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU,
- $ A( I, 1 ), LDA )
- 20 CONTINUE
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to VT, zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
- IF( N.GT.1 )
- $ CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ VT( 2, 1 ), LDVT )
-*
-* Generate Q in A
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in VT
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in A by left vectors bidiagonalizing R
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
- $ WORK( ITAUQ ), A, LDA, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing R in VT
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in A and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT, LDVT,
- $ A, LDA, DUM, 1, WORK( IWORK ), INFO )
-*
- END IF
-*
- ELSE IF( WNTUS ) THEN
-*
- IF( WNTVN ) THEN
-*
-* Path 4 (M much larger than N, JOBU='S', JOBVT='N')
-* N left singular vectors to be computed in U and
-* no right singular vectors to be computed
-*
- IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-* WORK(IR) is LDA by N
-*
- LDWRKR = LDA
- ELSE
-*
-* WORK(IR) is N by N
-*
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IR), zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ),
- $ LDWRKR )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IR+1 ), LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left vectors bidiagonalizing R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IR)
-* (Workspace: need N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM,
- $ 1, WORK( IR ), LDWRKR, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IR), storing result in U
-* (Workspace: need N*N)
-*
- CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA,
- $ WORK( IR ), LDWRKR, ZERO, U, LDU )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Zero out below R in A
-*
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
- $ LDA )
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left vectors bidiagonalizing R
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM,
- $ 1, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTVO ) THEN
-*
-* Path 5 (M much larger than N, JOBU='S', JOBVT='O')
-* N left singular vectors to be computed in U and
-* N right singular vectors to be overwritten on A
-*
- IF( LWORK.GE.2*N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+2*LDA*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is LDA by N
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*N
- LDWRKR = LDA
- ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is N by N
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*N
- LDWRKR = N
- ELSE
-*
-* WORK(IU) is N by N and WORK(IR) is N by N
-*
- LDWRKU = N
- IR = IU + LDWRKU*N
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IU), zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IU+1 ), LDWRKU )
-*
-* Generate Q in A
-* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
-*
- CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IU), copying result to
-* WORK(IR)
-* (Workspace: need 2*N*N+4*N,
-* prefer 2*N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU,
- $ WORK( IR ), LDWRKR )
-*
-* Generate left bidiagonalizing vectors in WORK(IU)
-* (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in WORK(IR)
-* (Workspace: need 2*N*N+4*N-1,
-* prefer 2*N*N+3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IU) and computing
-* right singular vectors of R in WORK(IR)
-* (Workspace: need 2*N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, WORK( IU ),
- $ LDWRKU, DUM, 1, WORK( IWORK ), INFO )
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IU), storing result in U
-* (Workspace: need N*N)
-*
- CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA,
- $ WORK( IU ), LDWRKU, ZERO, U, LDU )
-*
-* Copy right singular vectors of R to A
-* (Workspace: need N*N)
-*
- CALL DLACPY( 'F', N, N, WORK( IR ), LDWRKR, A,
- $ LDA )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Zero out below R in A
-*
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
- $ LDA )
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left vectors bidiagonalizing R
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing R in A
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in A
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), A,
- $ LDA, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTVAS ) THEN
-*
-* Path 6 (M much larger than N, JOBU='S', JOBVT='S'
-* or 'A')
-* N left singular vectors to be computed in U and
-* N right singular vectors to be computed in VT
-*
- IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-* WORK(IU) is LDA by N
-*
- LDWRKU = LDA
- ELSE
-*
-* WORK(IU) is N by N
-*
- LDWRKU = N
- END IF
- ITAU = IU + LDWRKU*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IU), zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IU+1 ), LDWRKU )
-*
-* Generate Q in A
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IU), copying result to VT
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU, VT,
- $ LDVT )
-*
-* Generate left bidiagonalizing vectors in WORK(IU)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in VT
-* (Workspace: need N*N+4*N-1,
-* prefer N*N+3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IU) and computing
-* right singular vectors of R in VT
-* (Workspace: need N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT,
- $ LDVT, WORK( IU ), LDWRKU, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply Q in A by left singular vectors of R in
-* WORK(IU), storing result in U
-* (Workspace: need N*N)
-*
- CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA,
- $ WORK( IU ), LDWRKU, ZERO, U, LDU )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to VT, zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
- IF( N.GT.1 )
- $ CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ VT( 2, 1 ), LDVT )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in VT
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left bidiagonalizing vectors
-* in VT
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in VT
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- END IF
-*
- ELSE IF( WNTUA ) THEN
-*
- IF( WNTVN ) THEN
-*
-* Path 7 (M much larger than N, JOBU='A', JOBVT='N')
-* M left singular vectors to be computed in U and
-* no right singular vectors to be computed
-*
- IF( LWORK.GE.N*N+MAX( N+M, 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-* WORK(IR) is LDA by N
-*
- LDWRKR = LDA
- ELSE
-*
-* WORK(IR) is N by N
-*
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Copy R to WORK(IR), zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ),
- $ LDWRKR )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IR+1 ), LDWRKR )
-*
-* Generate Q in U
-* (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
-*
- CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in WORK(IR)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IR)
-* (Workspace: need N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM,
- $ 1, WORK( IR ), LDWRKR, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply Q in U by left singular vectors of R in
-* WORK(IR), storing result in A
-* (Workspace: need N*N)
-*
- CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU,
- $ WORK( IR ), LDWRKR, ZERO, A, LDA )
-*
-* Copy left singular vectors of A from A to U
-*
- CALL DLACPY( 'F', M, N, A, LDA, U, LDU )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need N+M, prefer N+M*NB)
-*
- CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Zero out below R in A
-*
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
- $ LDA )
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left bidiagonalizing vectors
-* in A
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM,
- $ 1, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTVO ) THEN
-*
-* Path 8 (M much larger than N, JOBU='A', JOBVT='O')
-* M left singular vectors to be computed in U and
-* N right singular vectors to be overwritten on A
-*
- IF( LWORK.GE.2*N*N+MAX( N+M, 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+2*LDA*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is LDA by N
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*N
- LDWRKR = LDA
- ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is N by N
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*N
- LDWRKR = N
- ELSE
-*
-* WORK(IU) is N by N and WORK(IR) is N by N
-*
- LDWRKU = N
- IR = IU + LDWRKU*N
- LDWRKR = N
- END IF
- ITAU = IR + LDWRKR*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need 2*N*N+N+M, prefer 2*N*N+N+M*NB)
-*
- CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IU), zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IU+1 ), LDWRKU )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IU), copying result to
-* WORK(IR)
-* (Workspace: need 2*N*N+4*N,
-* prefer 2*N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU,
- $ WORK( IR ), LDWRKR )
-*
-* Generate left bidiagonalizing vectors in WORK(IU)
-* (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in WORK(IR)
-* (Workspace: need 2*N*N+4*N-1,
-* prefer 2*N*N+3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IU) and computing
-* right singular vectors of R in WORK(IR)
-* (Workspace: need 2*N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, WORK( IU ),
- $ LDWRKU, DUM, 1, WORK( IWORK ), INFO )
-*
-* Multiply Q in U by left singular vectors of R in
-* WORK(IU), storing result in A
-* (Workspace: need N*N)
-*
- CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU,
- $ WORK( IU ), LDWRKU, ZERO, A, LDA )
-*
-* Copy left singular vectors of A from A to U
-*
- CALL DLACPY( 'F', M, N, A, LDA, U, LDU )
-*
-* Copy right singular vectors of R from WORK(IR) to A
-*
- CALL DLACPY( 'F', N, N, WORK( IR ), LDWRKR, A,
- $ LDA )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need N+M, prefer N+M*NB)
-*
- CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Zero out below R in A
-*
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
- $ LDA )
-*
-* Bidiagonalize R in A
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left bidiagonalizing vectors
-* in A
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in A
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in A
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), A,
- $ LDA, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTVAS ) THEN
-*
-* Path 9 (M much larger than N, JOBU='A', JOBVT='S'
-* or 'A')
-* M left singular vectors to be computed in U and
-* N right singular vectors to be computed in VT
-*
- IF( LWORK.GE.N*N+MAX( N+M, 4*N, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-* WORK(IU) is LDA by N
-*
- LDWRKU = LDA
- ELSE
-*
-* WORK(IU) is N by N
-*
- LDWRKU = N
- END IF
- ITAU = IU + LDWRKU*N
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
-*
- CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R to WORK(IU), zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ WORK( IU+1 ), LDWRKU )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in WORK(IU), copying result to VT
-* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU, VT,
- $ LDVT )
-*
-* Generate left bidiagonalizing vectors in WORK(IU)
-* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
- CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in VT
-* (Workspace: need N*N+4*N-1,
-* prefer N*N+3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of R in WORK(IU) and computing
-* right singular vectors of R in VT
-* (Workspace: need N*N+BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT,
- $ LDVT, WORK( IU ), LDWRKU, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply Q in U by left singular vectors of R in
-* WORK(IU), storing result in A
-* (Workspace: need N*N)
-*
- CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU,
- $ WORK( IU ), LDWRKU, ZERO, A, LDA )
-*
-* Copy left singular vectors of A from A to U
-*
- CALL DLACPY( 'F', M, N, A, LDA, U, LDU )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + N
-*
-* Compute A=Q*R, copying result to U
-* (Workspace: need 2*N, prefer N+N*NB)
-*
- CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-* Generate Q in U
-* (Workspace: need N+M, prefer N+M*NB)
-*
- CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy R from A to VT, zeroing out below it
-*
- CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
- IF( N.GT.1 )
- $ CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
- $ VT( 2, 1 ), LDVT )
- IE = ITAU
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize R in VT
-* (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
- CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply Q in U by left bidiagonalizing vectors
-* in VT
-* (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
- CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
- $ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in VT
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + N
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* M .LT. MNTHR
-*
-* Path 10 (M at least N, but not much larger)
-* Reduce to bidiagonal form without QR decomposition
-*
- IE = 1
- ITAUQ = IE + N
- ITAUP = ITAUQ + N
- IWORK = ITAUP + N
-*
-* Bidiagonalize A
-* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB)
-*
- CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ IERR )
- IF( WNTUAS ) THEN
-*
-* If left singular vectors desired in U, copy result to U
-* and generate left bidiagonalizing vectors in U
-* (Workspace: need 3*N+NCU, prefer 3*N+NCU*NB)
-*
- CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
- IF( WNTUS )
- $ NCU = N
- IF( WNTUA )
- $ NCU = M
- CALL DORGBR( 'Q', M, NCU, N, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTVAS ) THEN
-*
-* If right singular vectors desired in VT, copy result to
-* VT and generate right bidiagonalizing vectors in VT
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
- CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTUO ) THEN
-*
-* If left singular vectors desired in A, generate left
-* bidiagonalizing vectors in A
-* (Workspace: need 4*N, prefer 3*N+N*NB)
-*
- CALL DORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTVO ) THEN
-*
-* If right singular vectors desired in A, generate right
-* bidiagonalizing vectors in A
-* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
- CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IWORK = IE + N
- IF( WNTUAS .OR. WNTUO )
- $ NRU = M
- IF( WNTUN )
- $ NRU = 0
- IF( WNTVAS .OR. WNTVO )
- $ NCVT = N
- IF( WNTVN )
- $ NCVT = 0
- IF( ( .NOT.WNTUO ) .AND. ( .NOT.WNTVO ) ) THEN
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in U and computing right singular
-* vectors in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ), INFO )
- ELSE IF( ( .NOT.WNTUO ) .AND. WNTVO ) THEN
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in U and computing right singular
-* vectors in A
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), A, LDA,
- $ U, LDU, DUM, 1, WORK( IWORK ), INFO )
- ELSE
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in A and computing right singular
-* vectors in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), VT,
- $ LDVT, A, LDA, DUM, 1, WORK( IWORK ), INFO )
- END IF
-*
- END IF
-*
- ELSE
-*
-* A has more columns than rows. If A has sufficiently more
-* columns than rows, first reduce using the LQ decomposition (if
-* sufficient workspace available)
-*
- IF( N.GE.MNTHR ) THEN
-*
- IF( WNTVN ) THEN
-*
-* Path 1t(N much larger than M, JOBVT='N')
-* No right singular vectors to be computed
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Zero out above L
-*
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), LDA )
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ IERR )
- IF( WNTUO .OR. WNTUAS ) THEN
-*
-* If left singular vectors desired, generate Q
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IWORK = IE + M
- NRU = 0
- IF( WNTUO .OR. WNTUAS )
- $ NRU = M
-*
-* Perform bidiagonal QR iteration, computing left singular
-* vectors of A in A if desired
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, 0, NRU, 0, S, WORK( IE ), DUM, 1, A,
- $ LDA, DUM, 1, WORK( IWORK ), INFO )
-*
-* If left singular vectors desired in U, copy them there
-*
- IF( WNTUAS )
- $ CALL DLACPY( 'F', M, M, A, LDA, U, LDU )
-*
- ELSE IF( WNTVO .AND. WNTUN ) THEN
-*
-* Path 2t(N much larger than M, JOBU='N', JOBVT='O')
-* M right singular vectors to be overwritten on A and
-* no left singular vectors to be computed
-*
- IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+LDA*M ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is LDA by M
-*
- LDWRKU = LDA
- CHUNK = N
- LDWRKR = LDA
- ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+M*M ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is M by M
-*
- LDWRKU = LDA
- CHUNK = N
- LDWRKR = M
- ELSE
-*
-* WORK(IU) is M by CHUNK and WORK(IR) is M by M
-*
- LDWRKU = M
- CHUNK = ( LWORK-M*M-M ) / M
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IR) and zero out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IR ), LDWRKR )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IR+LDWRKR ), LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IR)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing L
-* (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of L in WORK(IR)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, DUM, 1, DUM, 1,
- $ WORK( IWORK ), INFO )
- IU = IE + M
-*
-* Multiply right singular vectors of L in WORK(IR) by Q
-* in A, storing result in WORK(IU) and copying to A
-* (Workspace: need M*M+2*M, prefer M*M+M*N+M)
-*
- DO 30 I = 1, N, CHUNK
- BLK = MIN( N-I+1, CHUNK )
- CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IR ),
- $ LDWRKR, A( 1, I ), LDA, ZERO,
- $ WORK( IU ), LDWRKU )
- CALL DLACPY( 'F', M, BLK, WORK( IU ), LDWRKU,
- $ A( 1, I ), LDA )
- 30 CONTINUE
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize A
-* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
-*
- CALL DGEBRD( M, N, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing A
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of A in A
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'L', M, N, 0, 0, S, WORK( IE ), A, LDA,
- $ DUM, 1, DUM, 1, WORK( IWORK ), INFO )
-*
- END IF
-*
- ELSE IF( WNTVO .AND. WNTUAS ) THEN
-*
-* Path 3t(N much larger than M, JOBU='S' or 'A', JOBVT='O')
-* M right singular vectors to be overwritten on A and
-* M left singular vectors to be computed in U
-*
- IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+LDA*M ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is LDA by M
-*
- LDWRKU = LDA
- CHUNK = N
- LDWRKR = LDA
- ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+M*M ) THEN
-*
-* WORK(IU) is LDA by N and WORK(IR) is M by M
-*
- LDWRKU = LDA
- CHUNK = N
- LDWRKR = M
- ELSE
-*
-* WORK(IU) is M by CHUNK and WORK(IR) is M by M
-*
- LDWRKU = M
- CHUNK = ( LWORK-M*M-M ) / M
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to U, zeroing about above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
- $ LDU )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in U, copying result to WORK(IR)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, M, U, LDU, WORK( IR ), LDWRKR )
-*
-* Generate right vectors bidiagonalizing L in WORK(IR)
-* (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left vectors bidiagonalizing L in U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of L in U, and computing right
-* singular vectors of L in WORK(IR)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, U, LDU, DUM, 1,
- $ WORK( IWORK ), INFO )
- IU = IE + M
-*
-* Multiply right singular vectors of L in WORK(IR) by Q
-* in A, storing result in WORK(IU) and copying to A
-* (Workspace: need M*M+2*M, prefer M*M+M*N+M))
-*
- DO 40 I = 1, N, CHUNK
- BLK = MIN( N-I+1, CHUNK )
- CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IR ),
- $ LDWRKR, A( 1, I ), LDA, ZERO,
- $ WORK( IU ), LDWRKU )
- CALL DLACPY( 'F', M, BLK, WORK( IU ), LDWRKU,
- $ A( 1, I ), LDA )
- 40 CONTINUE
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to U, zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
- $ LDU )
-*
-* Generate Q in A
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in U
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right vectors bidiagonalizing L by Q in A
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU,
- $ WORK( ITAUP ), A, LDA, WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left vectors bidiagonalizing L in U
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in A
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), A, LDA,
- $ U, LDU, DUM, 1, WORK( IWORK ), INFO )
-*
- END IF
-*
- ELSE IF( WNTVS ) THEN
-*
- IF( WNTUN ) THEN
-*
-* Path 4t(N much larger than M, JOBU='N', JOBVT='S')
-* M right singular vectors to be computed in VT and
-* no left singular vectors to be computed
-*
- IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-* WORK(IR) is LDA by M
-*
- LDWRKR = LDA
- ELSE
-*
-* WORK(IR) is M by M
-*
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IR), zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IR ),
- $ LDWRKR )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IR+LDWRKR ), LDWRKR )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IR)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right vectors bidiagonalizing L in
-* WORK(IR)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of L in WORK(IR)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, DUM, 1, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IR) by
-* Q in A, storing result in VT
-* (Workspace: need M*M)
-*
- CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IR ),
- $ LDWRKR, A, LDA, ZERO, VT, LDVT )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy result to VT
-*
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Zero out above L in A
-*
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
- $ LDA )
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right vectors bidiagonalizing L by Q in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, N, 0, 0, S, WORK( IE ), VT,
- $ LDVT, DUM, 1, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTUO ) THEN
-*
-* Path 5t(N much larger than M, JOBU='O', JOBVT='S')
-* M right singular vectors to be computed in VT and
-* M left singular vectors to be overwritten on A
-*
- IF( LWORK.GE.2*M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+2*LDA*M ) THEN
-*
-* WORK(IU) is LDA by M and WORK(IR) is LDA by M
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*M
- LDWRKR = LDA
- ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN
-*
-* WORK(IU) is LDA by M and WORK(IR) is M by M
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*M
- LDWRKR = M
- ELSE
-*
-* WORK(IU) is M by M and WORK(IR) is M by M
-*
- LDWRKU = M
- IR = IU + LDWRKU*M
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IU), zeroing out below it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IU+LDWRKU ), LDWRKU )
-*
-* Generate Q in A
-* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
-*
- CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IU), copying result to
-* WORK(IR)
-* (Workspace: need 2*M*M+4*M,
-* prefer 2*M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU,
- $ WORK( IR ), LDWRKR )
-*
-* Generate right bidiagonalizing vectors in WORK(IU)
-* (Workspace: need 2*M*M+4*M-1,
-* prefer 2*M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in WORK(IR)
-* (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of L in WORK(IR) and computing
-* right singular vectors of L in WORK(IU)
-* (Workspace: need 2*M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
- $ WORK( IU ), LDWRKU, WORK( IR ),
- $ LDWRKR, DUM, 1, WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IU) by
-* Q in A, storing result in VT
-* (Workspace: need M*M)
-*
- CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
- $ LDWRKU, A, LDA, ZERO, VT, LDVT )
-*
-* Copy left singular vectors of L to A
-* (Workspace: need M*M)
-*
- CALL DLACPY( 'F', M, M, WORK( IR ), LDWRKR, A,
- $ LDA )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Zero out above L in A
-*
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
- $ LDA )
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right vectors bidiagonalizing L by Q in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors of L in A
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, compute left
-* singular vectors of A in A and compute right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, A, LDA, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTUAS ) THEN
-*
-* Path 6t(N much larger than M, JOBU='S' or 'A',
-* JOBVT='S')
-* M right singular vectors to be computed in VT and
-* M left singular vectors to be computed in U
-*
- IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-* WORK(IU) is LDA by N
-*
- LDWRKU = LDA
- ELSE
-*
-* WORK(IU) is LDA by M
-*
- LDWRKU = M
- END IF
- ITAU = IU + LDWRKU*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IU), zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IU+LDWRKU ), LDWRKU )
-*
-* Generate Q in A
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IU), copying result to U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU, U,
- $ LDU )
-*
-* Generate right bidiagonalizing vectors in WORK(IU)
-* (Workspace: need M*M+4*M-1,
-* prefer M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of L in U and computing right
-* singular vectors of L in WORK(IU)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
- $ WORK( IU ), LDWRKU, U, LDU, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IU) by
-* Q in A, storing result in VT
-* (Workspace: need M*M)
-*
- CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
- $ LDWRKU, A, LDA, ZERO, VT, LDVT )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to U, zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
- $ LDU )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in U
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right bidiagonalizing vectors in U by Q
-* in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in U
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- END IF
-*
- ELSE IF( WNTVA ) THEN
-*
- IF( WNTUN ) THEN
-*
-* Path 7t(N much larger than M, JOBU='N', JOBVT='A')
-* N right singular vectors to be computed in VT and
-* no left singular vectors to be computed
-*
- IF( LWORK.GE.M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IR = 1
- IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-* WORK(IR) is LDA by M
-*
- LDWRKR = LDA
- ELSE
-*
-* WORK(IR) is M by M
-*
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Copy L to WORK(IR), zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IR ),
- $ LDWRKR )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IR+LDWRKR ), LDWRKR )
-*
-* Generate Q in VT
-* (Workspace: need M*M+M+N, prefer M*M+M+N*NB)
-*
- CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IR)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate right bidiagonalizing vectors in WORK(IR)
-* (Workspace: need M*M+4*M-1,
-* prefer M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of L in WORK(IR)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ),
- $ WORK( IR ), LDWRKR, DUM, 1, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IR) by
-* Q in VT, storing result in A
-* (Workspace: need M*M)
-*
- CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IR ),
- $ LDWRKR, VT, LDVT, ZERO, A, LDA )
-*
-* Copy right singular vectors of A from A to VT
-*
- CALL DLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need M+N, prefer M+N*NB)
-*
- CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Zero out above L in A
-*
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
- $ LDA )
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right bidiagonalizing vectors in A by Q
-* in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, N, 0, 0, S, WORK( IE ), VT,
- $ LDVT, DUM, 1, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTUO ) THEN
-*
-* Path 8t(N much larger than M, JOBU='O', JOBVT='A')
-* N right singular vectors to be computed in VT and
-* M left singular vectors to be overwritten on A
-*
- IF( LWORK.GE.2*M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+2*LDA*M ) THEN
-*
-* WORK(IU) is LDA by M and WORK(IR) is LDA by M
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*M
- LDWRKR = LDA
- ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN
-*
-* WORK(IU) is LDA by M and WORK(IR) is M by M
-*
- LDWRKU = LDA
- IR = IU + LDWRKU*M
- LDWRKR = M
- ELSE
-*
-* WORK(IU) is M by M and WORK(IR) is M by M
-*
- LDWRKU = M
- IR = IU + LDWRKU*M
- LDWRKR = M
- END IF
- ITAU = IR + LDWRKR*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need 2*M*M+M+N, prefer 2*M*M+M+N*NB)
-*
- CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IU), zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IU+LDWRKU ), LDWRKU )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IU), copying result to
-* WORK(IR)
-* (Workspace: need 2*M*M+4*M,
-* prefer 2*M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU,
- $ WORK( IR ), LDWRKR )
-*
-* Generate right bidiagonalizing vectors in WORK(IU)
-* (Workspace: need 2*M*M+4*M-1,
-* prefer 2*M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in WORK(IR)
-* (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, WORK( IR ), LDWRKR,
- $ WORK( ITAUQ ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of L in WORK(IR) and computing
-* right singular vectors of L in WORK(IU)
-* (Workspace: need 2*M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
- $ WORK( IU ), LDWRKU, WORK( IR ),
- $ LDWRKR, DUM, 1, WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IU) by
-* Q in VT, storing result in A
-* (Workspace: need M*M)
-*
- CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
- $ LDWRKU, VT, LDVT, ZERO, A, LDA )
-*
-* Copy right singular vectors of A from A to VT
-*
- CALL DLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
-* Copy left singular vectors of A from WORK(IR) to A
-*
- CALL DLACPY( 'F', M, M, WORK( IR ), LDWRKR, A,
- $ LDA )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need M+N, prefer M+N*NB)
-*
- CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Zero out above L in A
-*
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
- $ LDA )
-*
-* Bidiagonalize L in A
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right bidiagonalizing vectors in A by Q
-* in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in A
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in A and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, A, LDA, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- ELSE IF( WNTUAS ) THEN
-*
-* Path 9t(N much larger than M, JOBU='S' or 'A',
-* JOBVT='A')
-* N right singular vectors to be computed in VT and
-* M left singular vectors to be computed in U
-*
- IF( LWORK.GE.M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN
-*
-* Sufficient workspace for a fast algorithm
-*
- IU = 1
- IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-* WORK(IU) is LDA by M
-*
- LDWRKU = LDA
- ELSE
-*
-* WORK(IU) is M by M
-*
- LDWRKU = M
- END IF
- ITAU = IU + LDWRKU*M
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need M*M+M+N, prefer M*M+M+N*NB)
-*
- CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to WORK(IU), zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
- $ LDWRKU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
- $ WORK( IU+LDWRKU ), LDWRKU )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in WORK(IU), copying result to U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
- $ WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
- CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU, U,
- $ LDU )
-*
-* Generate right bidiagonalizing vectors in WORK(IU)
-* (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB)
-*
- CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
- $ WORK( ITAUP ), WORK( IWORK ),
- $ LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in U
-* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of L in U and computing right
-* singular vectors of L in WORK(IU)
-* (Workspace: need M*M+BDSPAC)
-*
- CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
- $ WORK( IU ), LDWRKU, U, LDU, DUM, 1,
- $ WORK( IWORK ), INFO )
-*
-* Multiply right singular vectors of L in WORK(IU) by
-* Q in VT, storing result in A
-* (Workspace: need M*M)
-*
- CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
- $ LDWRKU, VT, LDVT, ZERO, A, LDA )
-*
-* Copy right singular vectors of A from A to VT
-*
- CALL DLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
- ELSE
-*
-* Insufficient workspace for a fast algorithm
-*
- ITAU = 1
- IWORK = ITAU + M
-*
-* Compute A=L*Q, copying result to VT
-* (Workspace: need 2*M, prefer M+M*NB)
-*
- CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-* Generate Q in VT
-* (Workspace: need M+N, prefer M+N*NB)
-*
- CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Copy L to U, zeroing out above it
-*
- CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
- CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
- $ LDU )
- IE = ITAU
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize L in U
-* (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
- CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
- $ WORK( ITAUQ ), WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Multiply right bidiagonalizing vectors in U by Q
-* in VT
-* (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
- CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU,
- $ WORK( ITAUP ), VT, LDVT,
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-* Generate left bidiagonalizing vectors in U
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- IWORK = IE + M
-*
-* Perform bidiagonal QR iteration, computing left
-* singular vectors of A in U and computing right
-* singular vectors of A in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ),
- $ INFO )
-*
- END IF
-*
- END IF
-*
- END IF
-*
- ELSE
-*
-* N .LT. MNTHR
-*
-* Path 10t(N greater than M, but not much larger)
-* Reduce to bidiagonal form without LQ decomposition
-*
- IE = 1
- ITAUQ = IE + M
- ITAUP = ITAUQ + M
- IWORK = ITAUP + M
-*
-* Bidiagonalize A
-* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
-*
- CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
- $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
- $ IERR )
- IF( WNTUAS ) THEN
-*
-* If left singular vectors desired in U, copy result to U
-* and generate left bidiagonalizing vectors in U
-* (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB)
-*
- CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
- CALL DORGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTVAS ) THEN
-*
-* If right singular vectors desired in VT, copy result to
-* VT and generate right bidiagonalizing vectors in VT
-* (Workspace: need 3*M+NRVT, prefer 3*M+NRVT*NB)
-*
- CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
- IF( WNTVA )
- $ NRVT = N
- IF( WNTVS )
- $ NRVT = M
- CALL DORGBR( 'P', NRVT, N, M, VT, LDVT, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTUO ) THEN
-*
-* If left singular vectors desired in A, generate left
-* bidiagonalizing vectors in A
-* (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB)
-*
- CALL DORGBR( 'Q', M, M, N, A, LDA, WORK( ITAUQ ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IF( WNTVO ) THEN
-*
-* If right singular vectors desired in A, generate right
-* bidiagonalizing vectors in A
-* (Workspace: need 4*M, prefer 3*M+M*NB)
-*
- CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
- $ WORK( IWORK ), LWORK-IWORK+1, IERR )
- END IF
- IWORK = IE + M
- IF( WNTUAS .OR. WNTUO )
- $ NRU = M
- IF( WNTUN )
- $ NRU = 0
- IF( WNTVAS .OR. WNTVO )
- $ NCVT = N
- IF( WNTVN )
- $ NCVT = 0
- IF( ( .NOT.WNTUO ) .AND. ( .NOT.WNTVO ) ) THEN
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in U and computing right singular
-* vectors in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), VT,
- $ LDVT, U, LDU, DUM, 1, WORK( IWORK ), INFO )
- ELSE IF( ( .NOT.WNTUO ) .AND. WNTVO ) THEN
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in U and computing right singular
-* vectors in A
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), A, LDA,
- $ U, LDU, DUM, 1, WORK( IWORK ), INFO )
- ELSE
-*
-* Perform bidiagonal QR iteration, if desired, computing
-* left singular vectors in A and computing right singular
-* vectors in VT
-* (Workspace: need BDSPAC)
-*
- CALL DBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), VT,
- $ LDVT, A, LDA, DUM, 1, WORK( IWORK ), INFO )
- END IF
-*
- END IF
-*
- END IF
-*
-* If DBDSQR failed to converge, copy unconverged superdiagonals
-* to WORK( 2:MINMN )
-*
- IF( INFO.NE.0 ) THEN
- IF( IE.GT.2 ) THEN
- DO 50 I = 1, MINMN - 1
- WORK( I+1 ) = WORK( I+IE-1 )
- 50 CONTINUE
- END IF
- IF( IE.LT.2 ) THEN
- DO 60 I = MINMN - 1, 1, -1
- WORK( I+1 ) = WORK( I+IE-1 )
- 60 CONTINUE
- END IF
- END IF
-*
-* Undo scaling if necessary
-*
- IF( ISCL.EQ.1 ) THEN
- IF( ANRM.GT.BIGNUM )
- $ CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
- $ IERR )
- IF( INFO.NE.0 .AND. ANRM.GT.BIGNUM )
- $ CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN-1, 1, WORK( 2 ),
- $ MINMN, IERR )
- IF( ANRM.LT.SMLNUM )
- $ CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
- $ IERR )
- IF( INFO.NE.0 .AND. ANRM.LT.SMLNUM )
- $ CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN-1, 1, WORK( 2 ),
- $ MINMN, IERR )
- END IF
-*
-* Return optimal workspace in WORK(1)
-*
- WORK( 1 ) = MAXWRK
-*
- RETURN
-*
-* End of DGESVD
-*
- END
diff --git a/mtx/lapack_src/dgesvx.f b/mtx/lapack_src/dgesvx.f
deleted file mode 100644
index aac205324..000000000
--- a/mtx/lapack_src/dgesvx.f
+++ /dev/null
@@ -1,602 +0,0 @@
-*> \brief DGESVX computes the solution to system of linear equations A * X = B for GE matrices
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGESVX + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
-* EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED, FACT, TRANS
-* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-* $ BERR( * ), C( * ), FERR( * ), R( * ),
-* $ WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'E', real scaling factors are computed to equilibrate
-*> the system:
-*> TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B
-*> TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
-*> TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
-*> Whether or not the system will be equilibrated depends on the
-*> scaling of the matrix A, but if equilibration is used, A is
-*> overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N')
-*> or diag(C)*B (if TRANS = 'T' or 'C').
-*>
-*> 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the
-*> matrix A (after equilibration if FACT = 'E') as
-*> A = P * L * U,
-*> where P is a permutation matrix, L is a unit lower triangular
-*> matrix, and U is upper triangular.
-*>
-*> 3. If some U(i,i)=0, so that U is exactly singular, then the routine
-*> returns with INFO = i. Otherwise, the factored form of A is used
-*> to estimate the condition number of the matrix A. If the
-*> reciprocal of the condition number is less than machine precision,
-*> INFO = N+1 is returned as a warning, but the routine still goes on
-*> to solve for X and compute error bounds as described below.
-*>
-*> 4. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 5. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*>
-*> 6. If equilibration was used, the matrix X is premultiplied by
-*> diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so
-*> that it solves the original system before equilibration.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of the matrix A is
-*> supplied on entry, and if not, whether the matrix A should be
-*> equilibrated before it is factored.
-*> = 'F': On entry, AF and IPIV contain the factored form of A.
-*> If EQUED is not 'N', the matrix A has been
-*> equilibrated with scaling factors given by R and C.
-*> A, AF, and IPIV are not modified.
-*> = 'N': The matrix A will be copied to AF and factored.
-*> = 'E': The matrix A will be equilibrated if necessary, then
-*> copied to AF and factored.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices B and X. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the N-by-N matrix A. If FACT = 'F' and EQUED is
-*> not 'N', then A must have been equilibrated by the scaling
-*> factors in R and/or C. A is not modified if FACT = 'F' or
-*> 'N', or if FACT = 'E' and EQUED = 'N' on exit.
-*>
-*> On exit, if EQUED .ne. 'N', A is scaled as follows:
-*> EQUED = 'R': A := diag(R) * A
-*> EQUED = 'C': A := A * diag(C)
-*> EQUED = 'B': A := diag(R) * A * diag(C).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] AF
-*> \verbatim
-*> AF is DOUBLE PRECISION array, dimension (LDAF,N)
-*> If FACT = 'F', then AF is an input argument and on entry
-*> contains the factors L and U from the factorization
-*> A = P*L*U as computed by DGETRF. If EQUED .ne. 'N', then
-*> AF is the factored form of the equilibrated matrix A.
-*>
-*> If FACT = 'N', then AF is an output argument and on exit
-*> returns the factors L and U from the factorization A = P*L*U
-*> of the original matrix A.
-*>
-*> If FACT = 'E', then AF is an output argument and on exit
-*> returns the factors L and U from the factorization A = P*L*U
-*> of the equilibrated matrix A (see the description of A for
-*> the form of the equilibrated matrix).
-*> \endverbatim
-*>
-*> \param[in] LDAF
-*> \verbatim
-*> LDAF is INTEGER
-*> The leading dimension of the array AF. LDAF >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> If FACT = 'F', then IPIV is an input argument and on entry
-*> contains the pivot indices from the factorization A = P*L*U
-*> as computed by DGETRF; row i of the matrix was interchanged
-*> with row IPIV(i).
-*>
-*> If FACT = 'N', then IPIV is an output argument and on exit
-*> contains the pivot indices from the factorization A = P*L*U
-*> of the original matrix A.
-*>
-*> If FACT = 'E', then IPIV is an output argument and on exit
-*> contains the pivot indices from the factorization A = P*L*U
-*> of the equilibrated matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration (always true if FACT = 'N').
-*> = 'R': Row equilibration, i.e., A has been premultiplied by
-*> diag(R).
-*> = 'C': Column equilibration, i.e., A has been postmultiplied
-*> by diag(C).
-*> = 'B': Both row and column equilibration, i.e., A has been
-*> replaced by diag(R) * A * diag(C).
-*> EQUED is an input argument if FACT = 'F'; otherwise, it is an
-*> output argument.
-*> \endverbatim
-*>
-*> \param[in,out] R
-*> \verbatim
-*> R is DOUBLE PRECISION array, dimension (N)
-*> The row scale factors for A. If EQUED = 'R' or 'B', A is
-*> multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
-*> is not accessed. R is an input argument if FACT = 'F';
-*> otherwise, R is an output argument. If FACT = 'F' and
-*> EQUED = 'R' or 'B', each element of R must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> The column scale factors for A. If EQUED = 'C' or 'B', A is
-*> multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
-*> is not accessed. C is an input argument if FACT = 'F';
-*> otherwise, C is an output argument. If FACT = 'F' and
-*> EQUED = 'C' or 'B', each element of C must be positive.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS right hand side matrix B.
-*> On exit,
-*> if EQUED = 'N', B is not modified;
-*> if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by
-*> diag(R)*B;
-*> if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is
-*> overwritten by diag(C)*B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X
-*> to the original system of equations. Note that A and B are
-*> modified on exit if EQUED .ne. 'N', and the solution to the
-*> equilibrated system is inv(diag(C))*X if TRANS = 'N' and
-*> EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C'
-*> and EQUED = 'R' or 'B'.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The estimate of the reciprocal condition number of the matrix
-*> A after equilibration (if done). If RCOND is less than the
-*> machine precision (in particular, if RCOND = 0), the matrix
-*> is singular to working precision. This condition is
-*> indicated by a return code of INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (4*N)
-*> On exit, WORK(1) contains the reciprocal pivot growth
-*> factor norm(A)/norm(U). The "max absolute element" norm is
-*> used. If WORK(1) is much less than 1, then the stability
-*> of the LU factorization of the (equilibrated) matrix A
-*> could be poor. This also means that the solution X, condition
-*> estimator RCOND, and forward error bound FERR could be
-*> unreliable. If factorization fails with 0 WORK(1) contains the reciprocal pivot growth factor for the
-*> leading INFO columns of A.
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: U(i,i) is exactly zero. The factorization has
-*> been completed, but the factor U is exactly
-*> singular, so the solution and error bounds
-*> could not be computed. RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleGEsolve
-*
-* =====================================================================
- SUBROUTINE DGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
- $ EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK driver routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED, FACT, TRANS
- INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
- $ BERR( * ), C( * ), FERR( * ), R( * ),
- $ WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
- CHARACTER NORM
- INTEGER I, INFEQU, J
- DOUBLE PRECISION AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN,
- $ ROWCND, RPVGRW, SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANGE, DLANTR
- EXTERNAL LSAME, DLAMCH, DLANGE, DLANTR
-* ..
-* .. External Subroutines ..
- EXTERNAL DGECON, DGEEQU, DGERFS, DGETRF, DGETRS, DLACPY,
- $ DLAQGE, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- EQUIL = LSAME( FACT, 'E' )
- NOTRAN = LSAME( TRANS, 'N' )
- IF( NOFACT .OR. EQUIL ) THEN
- EQUED = 'N'
- ROWEQU = .FALSE.
- COLEQU = .FALSE.
- ELSE
- ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
- COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
- SMLNUM = DLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SMLNUM
- END IF
-*
-* Test the input parameters.
-*
- IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
- $ THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
- INFO = -8
- ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT.
- $ ( ROWEQU .OR. COLEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN
- INFO = -10
- ELSE
- IF( ROWEQU ) THEN
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 10 J = 1, N
- RCMIN = MIN( RCMIN, R( J ) )
- RCMAX = MAX( RCMAX, R( J ) )
- 10 CONTINUE
- IF( RCMIN.LE.ZERO ) THEN
- INFO = -11
- ELSE IF( N.GT.0 ) THEN
- ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- ELSE
- ROWCND = ONE
- END IF
- END IF
- IF( COLEQU .AND. INFO.EQ.0 ) THEN
- RCMIN = BIGNUM
- RCMAX = ZERO
- DO 20 J = 1, N
- RCMIN = MIN( RCMIN, C( J ) )
- RCMAX = MAX( RCMAX, C( J ) )
- 20 CONTINUE
- IF( RCMIN.LE.ZERO ) THEN
- INFO = -12
- ELSE IF( N.GT.0 ) THEN
- COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
- ELSE
- COLCND = ONE
- END IF
- END IF
- IF( INFO.EQ.0 ) THEN
- IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -14
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -16
- END IF
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGESVX', -INFO )
- RETURN
- END IF
-*
- IF( EQUIL ) THEN
-*
-* Compute row and column scalings to equilibrate the matrix A.
-*
- CALL DGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFEQU )
- IF( INFEQU.EQ.0 ) THEN
-*
-* Equilibrate the matrix.
-*
- CALL DLAQGE( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
- $ EQUED )
- ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
- COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
- END IF
- END IF
-*
-* Scale the right hand side.
-*
- IF( NOTRAN ) THEN
- IF( ROWEQU ) THEN
- DO 40 J = 1, NRHS
- DO 30 I = 1, N
- B( I, J ) = R( I )*B( I, J )
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE IF( COLEQU ) THEN
- DO 60 J = 1, NRHS
- DO 50 I = 1, N
- B( I, J ) = C( I )*B( I, J )
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
- IF( NOFACT .OR. EQUIL ) THEN
-*
-* Compute the LU factorization of A.
-*
- CALL DLACPY( 'Full', N, N, A, LDA, AF, LDAF )
- CALL DGETRF( N, N, AF, LDAF, IPIV, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 ) THEN
-*
-* Compute the reciprocal pivot growth factor of the
-* leading rank-deficient INFO columns of A.
-*
- RPVGRW = DLANTR( 'M', 'U', 'N', INFO, INFO, AF, LDAF,
- $ WORK )
- IF( RPVGRW.EQ.ZERO ) THEN
- RPVGRW = ONE
- ELSE
- RPVGRW = DLANGE( 'M', N, INFO, A, LDA, WORK ) / RPVGRW
- END IF
- WORK( 1 ) = RPVGRW
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A and the
-* reciprocal pivot growth factor RPVGRW.
-*
- IF( NOTRAN ) THEN
- NORM = '1'
- ELSE
- NORM = 'I'
- END IF
- ANORM = DLANGE( NORM, N, N, A, LDA, WORK )
- RPVGRW = DLANTR( 'M', 'U', 'N', N, N, AF, LDAF, WORK )
- IF( RPVGRW.EQ.ZERO ) THEN
- RPVGRW = ONE
- ELSE
- RPVGRW = DLANGE( 'M', N, N, A, LDA, WORK ) / RPVGRW
- END IF
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL DGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO )
-*
-* Compute the solution matrix X.
-*
- CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL DGETRS( TRANS, N, NRHS, AF, LDAF, IPIV, X, LDX, INFO )
-*
-* Use iterative refinement to improve the computed solution and
-* compute error bounds and backward error estimates for it.
-*
- CALL DGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X,
- $ LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* Transform the solution matrix X to a solution of the original
-* system.
-*
- IF( NOTRAN ) THEN
- IF( COLEQU ) THEN
- DO 80 J = 1, NRHS
- DO 70 I = 1, N
- X( I, J ) = C( I )*X( I, J )
- 70 CONTINUE
- 80 CONTINUE
- DO 90 J = 1, NRHS
- FERR( J ) = FERR( J ) / COLCND
- 90 CONTINUE
- END IF
- ELSE IF( ROWEQU ) THEN
- DO 110 J = 1, NRHS
- DO 100 I = 1, N
- X( I, J ) = R( I )*X( I, J )
- 100 CONTINUE
- 110 CONTINUE
- DO 120 J = 1, NRHS
- FERR( J ) = FERR( J ) / ROWCND
- 120 CONTINUE
- END IF
-*
- WORK( 1 ) = RPVGRW
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.DLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
- RETURN
-*
-* End of DGESVX
-*
- END
diff --git a/mtx/lapack_src/dgetf2.f b/mtx/lapack_src/dgetf2.f
deleted file mode 100644
index ebe99ab93..000000000
--- a/mtx/lapack_src/dgetf2.f
+++ /dev/null
@@ -1,213 +0,0 @@
-*> \brief \b DGETF2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGETF2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the m by n matrix to be factored.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U; the unit diagonal elements of L are not stored.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, U(k,k) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION SFMIN
- INTEGER I, J, JP
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- INTEGER IDAMAX
- EXTERNAL DLAMCH, IDAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL DGER, DSCAL, DSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGETF2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Compute machine safe minimum
-*
- SFMIN = DLAMCH('S')
-*
- DO 10 J = 1, MIN( M, N )
-*
-* Find pivot and test for singularity.
-*
- JP = J - 1 + IDAMAX( M-J+1, A( J, J ), 1 )
- IPIV( J ) = JP
- IF( A( JP, J ).NE.ZERO ) THEN
-*
-* Apply the interchange to columns 1:N.
-*
- IF( JP.NE.J )
- $ CALL DSWAP( N, A( J, 1 ), LDA, A( JP, 1 ), LDA )
-*
-* Compute elements J+1:M of J-th column.
-*
- IF( J.LT.M ) THEN
- IF( ABS(A( J, J )) .GE. SFMIN ) THEN
- CALL DSCAL( M-J, ONE / A( J, J ), A( J+1, J ), 1 )
- ELSE
- DO 20 I = 1, M-J
- A( J+I, J ) = A( J+I, J ) / A( J, J )
- 20 CONTINUE
- END IF
- END IF
-*
- ELSE IF( INFO.EQ.0 ) THEN
-*
- INFO = J
- END IF
-*
- IF( J.LT.MIN( M, N ) ) THEN
-*
-* Update trailing submatrix.
-*
- CALL DGER( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ), LDA,
- $ A( J+1, J+1 ), LDA )
- END IF
- 10 CONTINUE
- RETURN
-*
-* End of DGETF2
-*
- END
diff --git a/mtx/lapack_src/dgetrf.f b/mtx/lapack_src/dgetrf.f
deleted file mode 100644
index 45bb97f30..000000000
--- a/mtx/lapack_src/dgetrf.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b DGETRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGETRF + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M-by-N matrix to be factored.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U; the unit diagonal elements of L are not stored.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IINFO, J, JB, NB
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DGETF2, DLASWP, DTRSM, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGETRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'DGETRF', ' ', M, N, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN
-*
-* Use unblocked code.
-*
- CALL DGETF2( M, N, A, LDA, IPIV, INFO )
- ELSE
-*
-* Use blocked code.
-*
- DO 20 J = 1, MIN( M, N ), NB
- JB = MIN( MIN( M, N )-J+1, NB )
-*
-* Factor diagonal and subdiagonal blocks and test for exact
-* singularity.
-*
- CALL DGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
-*
-* Adjust INFO and the pivot indices.
-*
- IF( INFO.EQ.0 .AND. IINFO.GT.0 )
- $ INFO = IINFO + J - 1
- DO 10 I = J, MIN( M, J+JB-1 )
- IPIV( I ) = J - 1 + IPIV( I )
- 10 CONTINUE
-*
-* Apply interchanges to columns 1:J-1.
-*
- CALL DLASWP( J-1, A, LDA, J, J+JB-1, IPIV, 1 )
-*
- IF( J+JB.LE.N ) THEN
-*
-* Apply interchanges to columns J+JB:N.
-*
- CALL DLASWP( N-J-JB+1, A( 1, J+JB ), LDA, J, J+JB-1,
- $ IPIV, 1 )
-*
-* Compute block row of U.
-*
- CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB,
- $ N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ),
- $ LDA )
- IF( J+JB.LE.M ) THEN
-*
-* Update trailing submatrix.
-*
- CALL DGEMM( 'No transpose', 'No transpose', M-J-JB+1,
- $ N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA,
- $ A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ),
- $ LDA )
- END IF
- END IF
- 20 CONTINUE
- END IF
- RETURN
-*
-* End of DGETRF
-*
- END
diff --git a/mtx/lapack_src/dgetri.f b/mtx/lapack_src/dgetri.f
deleted file mode 100644
index ad5324c07..000000000
--- a/mtx/lapack_src/dgetri.f
+++ /dev/null
@@ -1,261 +0,0 @@
-*> \brief \b DGETRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGETRI + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the factors L and U from the factorization
-*> A = P*L*U as computed by DGETRF.
-*> On exit, if INFO = 0, the inverse of the original matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from DGETRF; for 1<=i<=N, row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO=0, then WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> For optimal performance LWORK >= N*NB, where NB is
-*> the optimal blocksize returned by ILAENV.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero; the matrix is
-*> singular and its inverse could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IWS, J, JB, JJ, JP, LDWORK, LWKOPT, NB,
- $ NBMIN, NN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DGEMV, DSWAP, DTRSM, DTRTRI, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NB = ILAENV( 1, 'DGETRI', ' ', N, -1, -1, -1 )
- LWKOPT = N*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -3
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGETRI', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Form inv(U). If INFO > 0 from DTRTRI, then U is singular,
-* and the inverse is not computed.
-*
- CALL DTRTRI( 'Upper', 'Non-unit', N, A, LDA, INFO )
- IF( INFO.GT.0 )
- $ RETURN
-*
- NBMIN = 2
- LDWORK = N
- IF( NB.GT.1 .AND. NB.LT.N ) THEN
- IWS = MAX( LDWORK*NB, 1 )
- IF( LWORK.LT.IWS ) THEN
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DGETRI', ' ', N, -1, -1, -1 ) )
- END IF
- ELSE
- IWS = N
- END IF
-*
-* Solve the equation inv(A)*L = inv(U) for inv(A).
-*
- IF( NB.LT.NBMIN .OR. NB.GE.N ) THEN
-*
-* Use unblocked code.
-*
- DO 20 J = N, 1, -1
-*
-* Copy current column of L to WORK and replace with zeros.
-*
- DO 10 I = J + 1, N
- WORK( I ) = A( I, J )
- A( I, J ) = ZERO
- 10 CONTINUE
-*
-* Compute current column of inv(A).
-*
- IF( J.LT.N )
- $ CALL DGEMV( 'No transpose', N, N-J, -ONE, A( 1, J+1 ),
- $ LDA, WORK( J+1 ), 1, ONE, A( 1, J ), 1 )
- 20 CONTINUE
- ELSE
-*
-* Use blocked code.
-*
- NN = ( ( N-1 ) / NB )*NB + 1
- DO 50 J = NN, 1, -NB
- JB = MIN( NB, N-J+1 )
-*
-* Copy current block column of L to WORK and replace with
-* zeros.
-*
- DO 40 JJ = J, J + JB - 1
- DO 30 I = JJ + 1, N
- WORK( I+( JJ-J )*LDWORK ) = A( I, JJ )
- A( I, JJ ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
-*
-* Compute current block column of inv(A).
-*
- IF( J+JB.LE.N )
- $ CALL DGEMM( 'No transpose', 'No transpose', N, JB,
- $ N-J-JB+1, -ONE, A( 1, J+JB ), LDA,
- $ WORK( J+JB ), LDWORK, ONE, A( 1, J ), LDA )
- CALL DTRSM( 'Right', 'Lower', 'No transpose', 'Unit', N, JB,
- $ ONE, WORK( J ), LDWORK, A( 1, J ), LDA )
- 50 CONTINUE
- END IF
-*
-* Apply column interchanges.
-*
- DO 60 J = N - 1, 1, -1
- JP = IPIV( J )
- IF( JP.NE.J )
- $ CALL DSWAP( N, A( 1, J ), 1, A( 1, JP ), 1 )
- 60 CONTINUE
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DGETRI
-*
- END
diff --git a/mtx/lapack_src/dgetrs.f b/mtx/lapack_src/dgetrs.f
deleted file mode 100644
index 02e9832af..000000000
--- a/mtx/lapack_src/dgetrs.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b DGETRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGETRS + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T* X = B (Transpose)
-*> = 'C': A**T* X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The factors L and U from the factorization A = P*L*U
-*> as computed by DGETRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from DGETRF; for 1<=i<=N, row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEcomputational
-*
-* =====================================================================
- SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASWP, DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGETRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( NOTRAN ) THEN
-*
-* Solve A * X = B.
-*
-* Apply row interchanges to the right hand sides.
-*
- CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
-*
-* Solve L*X = B, overwriting B with X.
-*
- CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
- $ ONE, A, LDA, B, LDB )
-*
-* Solve U*X = B, overwriting B with X.
-*
- CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
- $ NRHS, ONE, A, LDA, B, LDB )
- ELSE
-*
-* Solve A**T * X = B.
-*
-* Solve U**T *X = B, overwriting B with X.
-*
- CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS,
- $ ONE, A, LDA, B, LDB )
-*
-* Solve L**T *X = B, overwriting B with X.
-*
- CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, ONE,
- $ A, LDA, B, LDB )
-*
-* Apply row interchanges to the solution vectors.
-*
- CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
- END IF
-*
- RETURN
-*
-* End of DGETRS
-*
- END
diff --git a/mtx/lapack_src/dgtcon.f b/mtx/lapack_src/dgtcon.f
deleted file mode 100644
index 500fa0dfb..000000000
--- a/mtx/lapack_src/dgtcon.f
+++ /dev/null
@@ -1,255 +0,0 @@
-*> \brief \b DGTCON
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGTCON + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER INFO, N
-* DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION D( * ), DL( * ), DU( * ), DU2( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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))).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies whether the 1-norm condition number or the
-*> infinity-norm condition number is required:
-*> = '1' or 'O': 1-norm;
-*> = 'I': Infinity-norm.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) multipliers that define the matrix L from the
-*> LU factorization of A as computed by DGTTRF.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the upper triangular matrix U from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) elements of the first superdiagonal of U.
-*> \endverbatim
-*>
-*> \param[in] DU2
-*> \verbatim
-*> DU2 is DOUBLE PRECISION array, dimension (N-2)
-*> The (n-2) elements of the second superdiagonal of U.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[in] ANORM
-*> \verbatim
-*> ANORM is DOUBLE PRECISION
-*> If NORM = '1' or 'O', the 1-norm of the original matrix A.
-*> If NORM = 'I', the infinity-norm of the original matrix A.
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The reciprocal of the condition number of the matrix A,
-*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
-*> estimate of the 1-norm of inv(A) computed in this routine.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (2*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER INFO, N
- DOUBLE PRECISION ANORM, RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION D( * ), DL( * ), DU( * ), DU2( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ONENRM
- INTEGER I, KASE, KASE1
- DOUBLE PRECISION AINVNM
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DGTTRS, DLACN2, XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments.
-*
- INFO = 0
- ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
- IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( ANORM.LT.ZERO ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGTCON', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- RCOND = ZERO
- IF( N.EQ.0 ) THEN
- RCOND = ONE
- RETURN
- ELSE IF( ANORM.EQ.ZERO ) THEN
- RETURN
- END IF
-*
-* Check that D(1:N) is non-zero.
-*
- DO 10 I = 1, N
- IF( D( I ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
-*
- AINVNM = ZERO
- IF( ONENRM ) THEN
- KASE1 = 1
- ELSE
- KASE1 = 2
- END IF
- KASE = 0
- 20 CONTINUE
- CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.KASE1 ) THEN
-*
-* Multiply by inv(U)*inv(L).
-*
- CALL DGTTRS( 'No transpose', N, 1, DL, D, DU, DU2, IPIV,
- $ WORK, N, INFO )
- ELSE
-*
-* Multiply by inv(L**T)*inv(U**T).
-*
- CALL DGTTRS( 'Transpose', N, 1, DL, D, DU, DU2, IPIV, WORK,
- $ N, INFO )
- END IF
- GO TO 20
- END IF
-*
-* Compute the estimate of the reciprocal condition number.
-*
- IF( AINVNM.NE.ZERO )
- $ RCOND = ( ONE / AINVNM ) / ANORM
-*
- RETURN
-*
-* End of DGTCON
-*
- END
diff --git a/mtx/lapack_src/dgtrfs.f b/mtx/lapack_src/dgtrfs.f
deleted file mode 100644
index 932945b1d..000000000
--- a/mtx/lapack_src/dgtrfs.f
+++ /dev/null
@@ -1,474 +0,0 @@
-*> \brief \b DGTRFS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGTRFS + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2,
-* IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
-* $ DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ),
-* $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) subdiagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The diagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) superdiagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] DLF
-*> \verbatim
-*> DLF is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) multipliers that define the matrix L from the
-*> LU factorization of A as computed by DGTTRF.
-*> \endverbatim
-*>
-*> \param[in] DF
-*> \verbatim
-*> DF is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the upper triangular matrix U from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] DUF
-*> \verbatim
-*> DUF is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) elements of the first superdiagonal of U.
-*> \endverbatim
-*>
-*> \param[in] DU2
-*> \verbatim
-*> DU2 is DOUBLE PRECISION array, dimension (N-2)
-*> The (n-2) elements of the second superdiagonal of U.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> On entry, the solution matrix X, as computed by DGTTRS.
-*> On exit, the improved solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> ITMAX is the maximum number of steps of iterative refinement.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2,
- $ IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDB, LDX, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
- $ DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ),
- $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D+0 )
- DOUBLE PRECISION THREE
- PARAMETER ( THREE = 3.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
- CHARACTER TRANSN, TRANST
- INTEGER COUNT, I, J, KASE, NZ
- DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN
-* ..
-* .. Local Arrays ..
- INTEGER ISAVE( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGTTRS, DLACN2, DLAGTM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -13
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -15
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGTRFS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
- DO 10 J = 1, NRHS
- FERR( J ) = ZERO
- BERR( J ) = ZERO
- 10 CONTINUE
- RETURN
- END IF
-*
- IF( NOTRAN ) THEN
- TRANSN = 'N'
- TRANST = 'T'
- ELSE
- TRANSN = 'T'
- TRANST = 'N'
- END IF
-*
-* NZ = maximum number of nonzero elements in each row of A, plus 1
-*
- NZ = 4
- EPS = DLAMCH( 'Epsilon' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SAFE1 = NZ*SAFMIN
- SAFE2 = SAFE1 / EPS
-*
-* Do for each right hand side
-*
- DO 110 J = 1, NRHS
-*
- COUNT = 1
- LSTRES = THREE
- 20 CONTINUE
-*
-* Loop until stopping criterion is satisfied.
-*
-* Compute residual R = B - op(A) * X,
-* where op(A) = A, A**T, or A**H, depending on TRANS.
-*
- CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
- CALL DLAGTM( TRANS, N, 1, -ONE, DL, D, DU, X( 1, J ), LDX, ONE,
- $ WORK( N+1 ), N )
-*
-* Compute abs(op(A))*abs(x) + abs(b) for use in the backward
-* error bound.
-*
- IF( NOTRAN ) THEN
- IF( N.EQ.1 ) THEN
- WORK( 1 ) = ABS( B( 1, J ) ) + ABS( D( 1 )*X( 1, J ) )
- ELSE
- WORK( 1 ) = ABS( B( 1, J ) ) + ABS( D( 1 )*X( 1, J ) ) +
- $ ABS( DU( 1 )*X( 2, J ) )
- DO 30 I = 2, N - 1
- WORK( I ) = ABS( B( I, J ) ) +
- $ ABS( DL( I-1 )*X( I-1, J ) ) +
- $ ABS( D( I )*X( I, J ) ) +
- $ ABS( DU( I )*X( I+1, J ) )
- 30 CONTINUE
- WORK( N ) = ABS( B( N, J ) ) +
- $ ABS( DL( N-1 )*X( N-1, J ) ) +
- $ ABS( D( N )*X( N, J ) )
- END IF
- ELSE
- IF( N.EQ.1 ) THEN
- WORK( 1 ) = ABS( B( 1, J ) ) + ABS( D( 1 )*X( 1, J ) )
- ELSE
- WORK( 1 ) = ABS( B( 1, J ) ) + ABS( D( 1 )*X( 1, J ) ) +
- $ ABS( DL( 1 )*X( 2, J ) )
- DO 40 I = 2, N - 1
- WORK( I ) = ABS( B( I, J ) ) +
- $ ABS( DU( I-1 )*X( I-1, J ) ) +
- $ ABS( D( I )*X( I, J ) ) +
- $ ABS( DL( I )*X( I+1, J ) )
- 40 CONTINUE
- WORK( N ) = ABS( B( N, J ) ) +
- $ ABS( DU( N-1 )*X( N-1, J ) ) +
- $ ABS( D( N )*X( N, J ) )
- END IF
- END IF
-*
-* Compute componentwise relative backward error from formula
-*
-* max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-* where abs(Z) is the componentwise absolute value of the matrix
-* or vector Z. If the i-th component of the denominator is less
-* than SAFE2, then SAFE1 is added to the i-th components of the
-* numerator and denominator before dividing.
-*
- S = ZERO
- DO 50 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
- ELSE
- S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
- $ ( WORK( I )+SAFE1 ) )
- END IF
- 50 CONTINUE
- BERR( J ) = S
-*
-* Test stopping criterion. Continue iterating if
-* 1) The residual BERR(J) is larger than machine epsilon, and
-* 2) BERR(J) decreased by at least a factor of 2 during the
-* last iteration, and
-* 3) At most ITMAX iterations tried.
-*
- IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
- $ COUNT.LE.ITMAX ) THEN
-*
-* Update solution and try again.
-*
- CALL DGTTRS( TRANS, N, 1, DLF, DF, DUF, DU2, IPIV,
- $ WORK( N+1 ), N, INFO )
- CALL DAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
- LSTRES = BERR( J )
- COUNT = COUNT + 1
- GO TO 20
- END IF
-*
-* Bound error from formula
-*
-* norm(X - XTRUE) / norm(X) .le. FERR =
-* norm( abs(inv(op(A)))*
-* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-* where
-* norm(Z) is the magnitude of the largest component of Z
-* inv(op(A)) is the inverse of op(A)
-* abs(Z) is the componentwise absolute value of the matrix or
-* vector Z
-* NZ is the maximum number of nonzeros in any row of A, plus 1
-* EPS is machine epsilon
-*
-* The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-* is incremented by SAFE1 if the i-th component of
-* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-* Use DLACN2 to estimate the infinity-norm of the matrix
-* inv(op(A)) * diag(W),
-* where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
- DO 60 I = 1, N
- IF( WORK( I ).GT.SAFE2 ) THEN
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
- ELSE
- WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
- END IF
- 60 CONTINUE
-*
- KASE = 0
- 70 CONTINUE
- CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
- $ KASE, ISAVE )
- IF( KASE.NE.0 ) THEN
- IF( KASE.EQ.1 ) THEN
-*
-* Multiply by diag(W)*inv(op(A)**T).
-*
- CALL DGTTRS( TRANST, N, 1, DLF, DF, DUF, DU2, IPIV,
- $ WORK( N+1 ), N, INFO )
- DO 80 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 80 CONTINUE
- ELSE
-*
-* Multiply by inv(op(A))*diag(W).
-*
- DO 90 I = 1, N
- WORK( N+I ) = WORK( I )*WORK( N+I )
- 90 CONTINUE
- CALL DGTTRS( TRANSN, N, 1, DLF, DF, DUF, DU2, IPIV,
- $ WORK( N+1 ), N, INFO )
- END IF
- GO TO 70
- END IF
-*
-* Normalize error.
-*
- LSTRES = ZERO
- DO 100 I = 1, N
- LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
- 100 CONTINUE
- IF( LSTRES.NE.ZERO )
- $ FERR( J ) = FERR( J ) / LSTRES
-*
- 110 CONTINUE
-*
- RETURN
-*
-* End of DGTRFS
-*
- END
diff --git a/mtx/lapack_src/dgtsv.f b/mtx/lapack_src/dgtsv.f
deleted file mode 100644
index b170b92cf..000000000
--- a/mtx/lapack_src/dgtsv.f
+++ /dev/null
@@ -1,333 +0,0 @@
-*> \brief \b DGTSV
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGTSV + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, DL must contain the (n-1) sub-diagonal elements of
-*> A.
-*>
-*> On exit, DL is overwritten by the (n-2) elements of the
-*> second super-diagonal of the upper triangular matrix U from
-*> the LU factorization of A, in DL(1), ..., DL(n-2).
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, D must contain the diagonal elements of A.
-*>
-*> On exit, D is overwritten by the n diagonal elements of U.
-*> \endverbatim
-*>
-*> \param[in,out] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, DU must contain the (n-1) super-diagonal elements
-*> of A.
-*>
-*> On exit, DU is overwritten by the (n-1) elements of the first
-*> super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N by NRHS matrix of right hand side matrix B.
-*> On exit, if INFO = 0, the N by NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero, and the solution
-*> has not been computed. The factorization has not been
-*> completed unless i = N.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION FACT, TEMP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGTSV ', -INFO )
- RETURN
- END IF
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( NRHS.EQ.1 ) THEN
- DO 10 I = 1, N - 2
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
-*
-* No row interchange required
-*
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- B( I+1, 1 ) = B( I+1, 1 ) - FACT*B( I, 1 )
- ELSE
- INFO = I
- RETURN
- END IF
- DL( I ) = ZERO
- ELSE
-*
-* Interchange rows I and I+1
-*
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- TEMP = D( I+1 )
- D( I+1 ) = DU( I ) - FACT*TEMP
- DL( I ) = DU( I+1 )
- DU( I+1 ) = -FACT*DL( I )
- DU( I ) = TEMP
- TEMP = B( I, 1 )
- B( I, 1 ) = B( I+1, 1 )
- B( I+1, 1 ) = TEMP - FACT*B( I+1, 1 )
- END IF
- 10 CONTINUE
- IF( N.GT.1 ) THEN
- I = N - 1
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- B( I+1, 1 ) = B( I+1, 1 ) - FACT*B( I, 1 )
- ELSE
- INFO = I
- RETURN
- END IF
- ELSE
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- TEMP = D( I+1 )
- D( I+1 ) = DU( I ) - FACT*TEMP
- DU( I ) = TEMP
- TEMP = B( I, 1 )
- B( I, 1 ) = B( I+1, 1 )
- B( I+1, 1 ) = TEMP - FACT*B( I+1, 1 )
- END IF
- END IF
- IF( D( N ).EQ.ZERO ) THEN
- INFO = N
- RETURN
- END IF
- ELSE
- DO 40 I = 1, N - 2
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
-*
-* No row interchange required
-*
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- DO 20 J = 1, NRHS
- B( I+1, J ) = B( I+1, J ) - FACT*B( I, J )
- 20 CONTINUE
- ELSE
- INFO = I
- RETURN
- END IF
- DL( I ) = ZERO
- ELSE
-*
-* Interchange rows I and I+1
-*
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- TEMP = D( I+1 )
- D( I+1 ) = DU( I ) - FACT*TEMP
- DL( I ) = DU( I+1 )
- DU( I+1 ) = -FACT*DL( I )
- DU( I ) = TEMP
- DO 30 J = 1, NRHS
- TEMP = B( I, J )
- B( I, J ) = B( I+1, J )
- B( I+1, J ) = TEMP - FACT*B( I+1, J )
- 30 CONTINUE
- END IF
- 40 CONTINUE
- IF( N.GT.1 ) THEN
- I = N - 1
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- DO 50 J = 1, NRHS
- B( I+1, J ) = B( I+1, J ) - FACT*B( I, J )
- 50 CONTINUE
- ELSE
- INFO = I
- RETURN
- END IF
- ELSE
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- TEMP = D( I+1 )
- D( I+1 ) = DU( I ) - FACT*TEMP
- DU( I ) = TEMP
- DO 60 J = 1, NRHS
- TEMP = B( I, J )
- B( I, J ) = B( I+1, J )
- B( I+1, J ) = TEMP - FACT*B( I+1, J )
- 60 CONTINUE
- END IF
- END IF
- IF( D( N ).EQ.ZERO ) THEN
- INFO = N
- RETURN
- END IF
- END IF
-*
-* Back solve with the matrix U from the factorization.
-*
- IF( NRHS.LE.2 ) THEN
- J = 1
- 70 CONTINUE
- B( N, J ) = B( N, J ) / D( N )
- IF( N.GT.1 )
- $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) / D( N-1 )
- DO 80 I = N - 2, 1, -1
- B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DL( I )*
- $ B( I+2, J ) ) / D( I )
- 80 CONTINUE
- IF( J.LT.NRHS ) THEN
- J = J + 1
- GO TO 70
- END IF
- ELSE
- DO 100 J = 1, NRHS
- B( N, J ) = B( N, J ) / D( N )
- IF( N.GT.1 )
- $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
- $ D( N-1 )
- DO 90 I = N - 2, 1, -1
- B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DL( I )*
- $ B( I+2, J ) ) / D( I )
- 90 CONTINUE
- 100 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DGTSV
-*
- END
diff --git a/mtx/lapack_src/dgtsvx.f b/mtx/lapack_src/dgtsvx.f
deleted file mode 100644
index 4f4818c7e..000000000
--- a/mtx/lapack_src/dgtsvx.f
+++ /dev/null
@@ -1,414 +0,0 @@
-*> \brief \b DGTSVX
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGTSVX + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF,
-* DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR,
-* WORK, IWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER FACT, TRANS
-* INTEGER INFO, LDB, LDX, N, NRHS
-* DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * ), IWORK( * )
-* DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
-* $ DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ),
-* $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-*> \par Description:
-* =================
-*>
-*> \verbatim
-*>
-*> The following steps are performed:
-*>
-*> 1. If FACT = 'N', the LU decomposition is used to factor the matrix A
-*> as 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.
-*>
-*> 2. If some U(i,i)=0, so that U is exactly singular, then the routine
-*> returns with INFO = i. Otherwise, the factored form of A is used
-*> to estimate the condition number of the matrix A. If the
-*> reciprocal of the condition number is less than machine precision,
-*> INFO = N+1 is returned as a warning, but the routine still goes on
-*> to solve for X and compute error bounds as described below.
-*>
-*> 3. The system of equations is solved for X using the factored form
-*> of A.
-*>
-*> 4. Iterative refinement is applied to improve the computed solution
-*> matrix and calculate error bounds and backward error estimates
-*> for it.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] FACT
-*> \verbatim
-*> FACT is CHARACTER*1
-*> Specifies whether or not the factored form of A has been
-*> supplied on entry.
-*> = 'F': DLF, DF, DUF, DU2, and IPIV contain the factored
-*> form of A; DL, D, DU, DLF, DF, DUF, DU2 and IPIV
-*> will not be modified.
-*> = 'N': The matrix will be copied to DLF, DF, and DUF
-*> and factored.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) subdiagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) superdiagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in,out] DLF
-*> \verbatim
-*> DLF is DOUBLE PRECISION array, dimension (N-1)
-*> If FACT = 'F', then DLF is an input argument and on entry
-*> contains the (n-1) multipliers that define the matrix L from
-*> the LU factorization of A as computed by DGTTRF.
-*>
-*> If FACT = 'N', then DLF is an output argument and on exit
-*> contains the (n-1) multipliers that define the matrix L from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] DF
-*> \verbatim
-*> DF is DOUBLE PRECISION array, dimension (N)
-*> If FACT = 'F', then DF is an input argument and on entry
-*> contains the n diagonal elements of the upper triangular
-*> matrix U from the LU factorization of A.
-*>
-*> If FACT = 'N', then DF is an output argument and on exit
-*> contains the n diagonal elements of the upper triangular
-*> matrix U from the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] DUF
-*> \verbatim
-*> DUF is DOUBLE PRECISION array, dimension (N-1)
-*> If FACT = 'F', then DUF is an input argument and on entry
-*> contains the (n-1) elements of the first superdiagonal of U.
-*>
-*> If FACT = 'N', then DUF is an output argument and on exit
-*> contains the (n-1) elements of the first superdiagonal of U.
-*> \endverbatim
-*>
-*> \param[in,out] DU2
-*> \verbatim
-*> DU2 is DOUBLE PRECISION array, dimension (N-2)
-*> If FACT = 'F', then DU2 is an input argument and on entry
-*> contains the (n-2) elements of the second superdiagonal of
-*> U.
-*>
-*> If FACT = 'N', then DU2 is an output argument and on exit
-*> contains the (n-2) elements of the second superdiagonal of
-*> U.
-*> \endverbatim
-*>
-*> \param[in,out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> If FACT = 'F', then IPIV is an input argument and on entry
-*> contains the pivot indices from the LU factorization of A as
-*> computed by DGTTRF.
-*>
-*> If FACT = 'N', then IPIV is an output argument and on exit
-*> contains the pivot indices from the LU factorization of A;
-*> row i of the matrix was interchanged with row IPIV(i).
-*> IPIV(i) will always be either i or i+1; IPIV(i) = i indicates
-*> a row interchange was not required.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> The N-by-NRHS right hand side matrix B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] RCOND
-*> \verbatim
-*> RCOND is DOUBLE PRECISION
-*> The estimate of the reciprocal condition number of the matrix
-*> A. If RCOND is less than the machine precision (in
-*> particular, if RCOND = 0), the matrix is singular to working
-*> precision. This condition is indicated by a return code of
-*> INFO > 0.
-*> \endverbatim
-*>
-*> \param[out] FERR
-*> \verbatim
-*> FERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The estimated forward error bound for each solution vector
-*> X(j) (the j-th column of the solution matrix X).
-*> If XTRUE is the true solution corresponding to X(j), FERR(j)
-*> is an estimated upper bound for the magnitude of the largest
-*> element in (X(j) - XTRUE) divided by the magnitude of the
-*> largest element in X(j). The estimate is as reliable as
-*> the estimate for RCOND, and is almost always a slight
-*> overestimate of the true error.
-*> \endverbatim
-*>
-*> \param[out] BERR
-*> \verbatim
-*> BERR is DOUBLE PRECISION array, dimension (NRHS)
-*> The componentwise relative backward error of each solution
-*> vector X(j) (i.e., the smallest relative change in
-*> any element of A or B that makes X(j) an exact solution).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] IWORK
-*> \verbatim
-*> IWORK is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, and i is
-*> <= N: U(i,i) is exactly zero. The factorization
-*> has not been completed unless i = N, but the
-*> factor U is exactly singular, so the solution
-*> and error bounds could not be computed.
-*> RCOND = 0 is returned.
-*> = N+1: U is nonsingular, but RCOND is less than machine
-*> precision, meaning that the matrix is singular
-*> to working precision. Nevertheless, the
-*> solution and error bounds are computed because
-*> there are a number of situations where the
-*> computed solution can be more accurate than the
-*> value of RCOND would suggest.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF,
- $ DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR,
- $ WORK, IWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER FACT, TRANS
- INTEGER INFO, LDB, LDX, N, NRHS
- DOUBLE PRECISION RCOND
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), IWORK( * )
- DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
- $ DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ),
- $ FERR( * ), WORK( * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOFACT, NOTRAN
- CHARACTER NORM
- DOUBLE PRECISION ANORM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- DOUBLE PRECISION DLAMCH, DLANGT
- EXTERNAL LSAME, DLAMCH, DLANGT
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGTCON, DGTRFS, DGTTRF, DGTTRS, DLACPY,
- $ XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOFACT = LSAME( FACT, 'N' )
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -14
- ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
- INFO = -16
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGTSVX', -INFO )
- RETURN
- END IF
-*
- IF( NOFACT ) THEN
-*
-* Compute the LU factorization of A.
-*
- CALL DCOPY( N, D, 1, DF, 1 )
- IF( N.GT.1 ) THEN
- CALL DCOPY( N-1, DL, 1, DLF, 1 )
- CALL DCOPY( N-1, DU, 1, DUF, 1 )
- END IF
- CALL DGTTRF( N, DLF, DF, DUF, DU2, IPIV, INFO )
-*
-* Return if INFO is non-zero.
-*
- IF( INFO.GT.0 )THEN
- RCOND = ZERO
- RETURN
- END IF
- END IF
-*
-* Compute the norm of the matrix A.
-*
- IF( NOTRAN ) THEN
- NORM = '1'
- ELSE
- NORM = 'I'
- END IF
- ANORM = DLANGT( NORM, N, DL, D, DU )
-*
-* Compute the reciprocal of the condition number of A.
-*
- CALL DGTCON( NORM, N, DLF, DF, DUF, DU2, IPIV, ANORM, RCOND, WORK,
- $ IWORK, INFO )
-*
-* Compute the solution vectors X.
-*
- CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
- CALL DGTTRS( TRANS, N, NRHS, DLF, DF, DUF, DU2, IPIV, X, LDX,
- $ INFO )
-*
-* Use iterative refinement to improve the computed solutions and
-* compute error bounds and backward error estimates for them.
-*
- CALL DGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV,
- $ B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-* Set INFO = N+1 if the matrix is singular to working precision.
-*
- IF( RCOND.LT.DLAMCH( 'Epsilon' ) )
- $ INFO = N + 1
-*
- RETURN
-*
-* End of DGTSVX
-*
- END
diff --git a/mtx/lapack_src/dgttrf.f b/mtx/lapack_src/dgttrf.f
deleted file mode 100644
index 154fb31a4..000000000
--- a/mtx/lapack_src/dgttrf.f
+++ /dev/null
@@ -1,237 +0,0 @@
-*> \brief \b DGTTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGTTRF + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, DL must contain the (n-1) sub-diagonal elements of
-*> A.
-*>
-*> On exit, DL is overwritten by the (n-1) multipliers that
-*> define the matrix L from the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, D must contain the diagonal elements of A.
-*>
-*> On exit, D is overwritten by the n diagonal elements of the
-*> upper triangular matrix U from the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> On entry, DU must contain the (n-1) super-diagonal elements
-*> of A.
-*>
-*> On exit, DU is overwritten by the (n-1) elements of the first
-*> super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[out] DU2
-*> \verbatim
-*> DU2 is DOUBLE PRECISION array, dimension (N-2)
-*> On exit, DU2 is overwritten by the (n-2) elements of the
-*> second super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, U(k,k) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION FACT, TEMP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- CALL XERBLA( 'DGTTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Initialize IPIV(i) = i and DU2(I) = 0
-*
- DO 10 I = 1, N
- IPIV( I ) = I
- 10 CONTINUE
- DO 20 I = 1, N - 2
- DU2( I ) = ZERO
- 20 CONTINUE
-*
- DO 30 I = 1, N - 2
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
-*
-* No row interchange required, eliminate DL(I)
-*
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- DL( I ) = FACT
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- END IF
- ELSE
-*
-* Interchange rows I and I+1, eliminate DL(I)
-*
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- DL( I ) = FACT
- TEMP = DU( I )
- DU( I ) = D( I+1 )
- D( I+1 ) = TEMP - FACT*D( I+1 )
- DU2( I ) = DU( I+1 )
- DU( I+1 ) = -FACT*DU( I+1 )
- IPIV( I ) = I + 1
- END IF
- 30 CONTINUE
- IF( N.GT.1 ) THEN
- I = N - 1
- IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
- IF( D( I ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- DL( I ) = FACT
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- END IF
- ELSE
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- DL( I ) = FACT
- TEMP = DU( I )
- DU( I ) = D( I+1 )
- D( I+1 ) = TEMP - FACT*D( I+1 )
- IPIV( I ) = I + 1
- END IF
- END IF
-*
-* Check for a zero on the diagonal of U.
-*
- DO 40 I = 1, N
- IF( D( I ).EQ.ZERO ) THEN
- INFO = I
- GO TO 50
- END IF
- 40 CONTINUE
- 50 CONTINUE
-*
- RETURN
-*
-* End of DGTTRF
-*
- END
diff --git a/mtx/lapack_src/dgttrs.f b/mtx/lapack_src/dgttrs.f
deleted file mode 100644
index 6507c4963..000000000
--- a/mtx/lapack_src/dgttrs.f
+++ /dev/null
@@ -1,223 +0,0 @@
-*> \brief \b DGTTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGTTRS + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations.
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T* X = B (Transpose)
-*> = 'C': A**T* X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) multipliers that define the matrix L from the
-*> LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the upper triangular matrix U from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) elements of the first super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] DU2
-*> \verbatim
-*> DU2 is DOUBLE PRECISION array, dimension (N-2)
-*> The (n-2) elements of the second super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the matrix of right hand side vectors B.
-*> On exit, B is overwritten by the solution vectors X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL NOTRAN
- INTEGER ITRANS, J, JB, NB
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DGTTS2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOTRAN = ( TRANS.EQ.'N' .OR. TRANS.EQ.'n' )
- IF( .NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T' .OR. TRANS.EQ.
- $ 't' ) .AND. .NOT.( TRANS.EQ.'C' .OR. TRANS.EQ.'c' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( N, 1 ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGTTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
-* Decode TRANS
-*
- IF( NOTRAN ) THEN
- ITRANS = 0
- ELSE
- ITRANS = 1
- END IF
-*
-* Determine the number of right-hand sides to solve at a time.
-*
- IF( NRHS.EQ.1 ) THEN
- NB = 1
- ELSE
- NB = MAX( 1, ILAENV( 1, 'DGTTRS', TRANS, N, NRHS, -1, -1 ) )
- END IF
-*
- IF( NB.GE.NRHS ) THEN
- CALL DGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
- ELSE
- DO 10 J = 1, NRHS, NB
- JB = MIN( NRHS-J+1, NB )
- CALL DGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ),
- $ LDB )
- 10 CONTINUE
- END IF
-*
-* End of DGTTRS
-*
- END
diff --git a/mtx/lapack_src/dgtts2.f b/mtx/lapack_src/dgtts2.f
deleted file mode 100644
index a582b7331..000000000
--- a/mtx/lapack_src/dgtts2.f
+++ /dev/null
@@ -1,274 +0,0 @@
-*> \brief \b DGTTS2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DGTTS2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
-*
-* .. Scalar Arguments ..
-* INTEGER ITRANS, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITRANS
-*> \verbatim
-*> ITRANS is INTEGER
-*> Specifies the form of the system of equations.
-*> = 0: A * X = B (No transpose)
-*> = 1: A**T* X = B (Transpose)
-*> = 2: A**T* X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) multipliers that define the matrix L from the
-*> LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The n diagonal elements of the upper triangular matrix U from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) elements of the first super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] DU2
-*> \verbatim
-*> DU2 is DOUBLE PRECISION array, dimension (N-2)
-*> The (n-2) elements of the second super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the matrix of right hand side vectors B.
-*> On exit, B is overwritten by the solution vectors X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER ITRANS, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IP, J
- DOUBLE PRECISION TEMP
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( ITRANS.EQ.0 ) THEN
-*
-* Solve A*X = B using the LU factorization of A,
-* overwriting each right hand side vector with its solution.
-*
- IF( NRHS.LE.1 ) THEN
- J = 1
- 10 CONTINUE
-*
-* Solve L*x = b.
-*
- DO 20 I = 1, N - 1
- IP = IPIV( I )
- TEMP = B( I+1-IP+I, J ) - DL( I )*B( IP, J )
- B( I, J ) = B( IP, J )
- B( I+1, J ) = TEMP
- 20 CONTINUE
-*
-* Solve U*x = b.
-*
- B( N, J ) = B( N, J ) / D( N )
- IF( N.GT.1 )
- $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
- $ D( N-1 )
- DO 30 I = N - 2, 1, -1
- B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )*
- $ B( I+2, J ) ) / D( I )
- 30 CONTINUE
- IF( J.LT.NRHS ) THEN
- J = J + 1
- GO TO 10
- END IF
- ELSE
- DO 60 J = 1, NRHS
-*
-* Solve L*x = b.
-*
- DO 40 I = 1, N - 1
- IF( IPIV( I ).EQ.I ) THEN
- B( I+1, J ) = B( I+1, J ) - DL( I )*B( I, J )
- ELSE
- TEMP = B( I, J )
- B( I, J ) = B( I+1, J )
- B( I+1, J ) = TEMP - DL( I )*B( I, J )
- END IF
- 40 CONTINUE
-*
-* Solve U*x = b.
-*
- B( N, J ) = B( N, J ) / D( N )
- IF( N.GT.1 )
- $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
- $ D( N-1 )
- DO 50 I = N - 2, 1, -1
- B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )*
- $ B( I+2, J ) ) / D( I )
- 50 CONTINUE
- 60 CONTINUE
- END IF
- ELSE
-*
-* Solve A**T * X = B.
-*
- IF( NRHS.LE.1 ) THEN
-*
-* Solve U**T*x = b.
-*
- J = 1
- 70 CONTINUE
- B( 1, J ) = B( 1, J ) / D( 1 )
- IF( N.GT.1 )
- $ B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 )
- DO 80 I = 3, N
- B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-DU2( I-2 )*
- $ B( I-2, J ) ) / D( I )
- 80 CONTINUE
-*
-* Solve L**T*x = b.
-*
- DO 90 I = N - 1, 1, -1
- IP = IPIV( I )
- TEMP = B( I, J ) - DL( I )*B( I+1, J )
- B( I, J ) = B( IP, J )
- B( IP, J ) = TEMP
- 90 CONTINUE
- IF( J.LT.NRHS ) THEN
- J = J + 1
- GO TO 70
- END IF
-*
- ELSE
- DO 120 J = 1, NRHS
-*
-* Solve U**T*x = b.
-*
- B( 1, J ) = B( 1, J ) / D( 1 )
- IF( N.GT.1 )
- $ B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 )
- DO 100 I = 3, N
- B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-
- $ DU2( I-2 )*B( I-2, J ) ) / D( I )
- 100 CONTINUE
- DO 110 I = N - 1, 1, -1
- IF( IPIV( I ).EQ.I ) THEN
- B( I, J ) = B( I, J ) - DL( I )*B( I+1, J )
- ELSE
- TEMP = B( I+1, J )
- B( I+1, J ) = B( I, J ) - DL( I )*TEMP
- B( I, J ) = TEMP
- END IF
- 110 CONTINUE
- 120 CONTINUE
- END IF
- END IF
-*
-* End of DGTTS2
-*
- END
diff --git a/mtx/lapack_src/dhseqr.f b/mtx/lapack_src/dhseqr.f
deleted file mode 100644
index 3ee16cad3..000000000
--- a/mtx/lapack_src/dhseqr.f
+++ /dev/null
@@ -1,516 +0,0 @@
-*> \brief \b DHSEQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DHSEQR + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z,
-* LDZ, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N
-* CHARACTER COMPZ, JOB
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] JOB
-*> \verbatim
-*> JOB is CHARACTER*1
-*> = 'E': compute eigenvalues only;
-*> = 'S': compute eigenvalues and the Schur form T.
-*> \endverbatim
-*>
-*> \param[in] COMPZ
-*> \verbatim
-*> COMPZ is CHARACTER*1
-*> = 'N': no Schur vectors are computed;
-*> = 'I': Z is initialized to the unit matrix and the matrix Z
-*> of Schur vectors of H is returned;
-*> = 'V': Z must contain an orthogonal matrix Q on entry, and
-*> the product Q*Z is returned.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N .GE. 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> It is assumed that H is already upper triangular in rows
-*> and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
-*> set by a previous call to DGEBAL, and then passed to ZGEHRD
-*> when the matrix output by DGEBAL is reduced to Hessenberg
-*> form. Otherwise ILO and IHI should be set to 1 and N
-*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
-*> If N = 0, then ILO = 1 and IHI = 0.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is DOUBLE PRECISION array, dimension (LDH,N)
-*> On entry, the upper Hessenberg matrix H.
-*> On exit, if INFO = 0 and JOB = 'S', then H contains the
-*> upper quasi-triangular matrix T from the Schur decomposition
-*> (the Schur form); 2-by-2 diagonal blocks (corresponding to
-*> complex conjugate pairs of eigenvalues) are returned in
-*> standard form, with H(i,i) = H(i+1,i+1) and
-*> H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and JOB = 'E', the
-*> contents of H are unspecified on exit. (The output value of
-*> H when INFO.GT.0 is given under the description of INFO
-*> below.)
-*>
-*> Unlike earlier versions of DHSEQR, this subroutine may
-*> explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1
-*> or j = IHI+1, IHI+2, ... N.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH .GE. max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION array, dimension (N)
-*>
-*> The real and imaginary parts, respectively, of the computed
-*> eigenvalues. If two eigenvalues are computed as a complex
-*> conjugate pair, they are stored in consecutive elements of
-*> WR and WI, say the i-th and (i+1)th, with WI(i) .GT. 0 and
-*> WI(i+1) .LT. 0. If JOB = 'S', the eigenvalues are stored in
-*> the same order as on the diagonal of the Schur form returned
-*> in H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2
-*> diagonal block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
-*> WI(i+1) = -WI(i).
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,N)
-*> If COMPZ = 'N', Z is not referenced.
-*> If COMPZ = 'I', on entry Z need not be set and on exit,
-*> if INFO = 0, Z contains the orthogonal matrix Z of the Schur
-*> vectors of H. If COMPZ = 'V', on entry Z must contain an
-*> N-by-N matrix Q, which is assumed to be equal to the unit
-*> matrix except for the submatrix Z(ILO:IHI,ILO:IHI). On exit,
-*> if INFO = 0, Z contains Q*Z.
-*> Normally Q is the orthogonal matrix generated by DORGHR
-*> after the call to DGEHRD which formed the Hessenberg matrix
-*> H. (The output value of Z when INFO.GT.0 is given under
-*> the description of INFO below.)
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. if COMPZ = 'I' or
-*> COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LWORK)
-*> On exit, if INFO = 0, WORK(1) returns an estimate of
-*> the optimal value for LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK .GE. max(1,N)
-*> is sufficient and delivers very good and sometimes
-*> optimal performance. However, LWORK as large as 11*N
-*> may be required for optimal performance. A workspace
-*> query is recommended to determine the optimal workspace
-*> size.
-*>
-*> If LWORK = -1, then DHSEQR does a workspace query.
-*> In this case, DHSEQR checks the input parameters and
-*> estimates the optimal workspace size for the given
-*> values of N, ILO and IHI. The estimate is returned
-*> in WORK(1). No error message related to LWORK is
-*> issued by XERBLA. Neither H nor Z are accessed.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> .LT. 0: if INFO = -i, the i-th argument had an illegal
-*> value
-*> .GT. 0: if INFO = i, DHSEQR failed to compute all of
-*> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
-*> and WI contain those eigenvalues which have been
-*> successfully computed. (Failures are rare.)
-*>
-*> If INFO .GT. 0 and JOB = 'E', then on exit, the
-*> remaining unconverged eigenvalues are the eigen-
-*> values of the upper Hessenberg matrix rows and
-*> columns ILO through INFO of the final, output
-*> value of H.
-*>
-*> If INFO .GT. 0 and JOB = 'S', then on exit
-*>
-*> (*) (initial value of H)*U = U*(final value of H)
-*>
-*> where U is an orthogonal matrix. The final
-*> value of H is upper Hessenberg and quasi-triangular
-*> in rows and columns INFO+1 through IHI.
-*>
-*> If INFO .GT. 0 and COMPZ = 'V', then on exit
-*>
-*> (final value of Z) = (initial value of Z)*U
-*>
-*> where U is the orthogonal matrix in (*) (regard-
-*> less of the value of JOB.)
-*>
-*> If INFO .GT. 0 and COMPZ = 'I', then on exit
-*> (final value of Z) = U
-*> where U is the orthogonal matrix in (*) (regard-
-*> less of the value of JOB.)
-*>
-*> If INFO .GT. 0 and COMPZ = 'N', then Z is not
-*> accessed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Default values supplied by
-*> ILAENV(ISPEC,'DHSEQR',JOB(:1)//COMPZ(:1),N,ILO,IHI,LWORK).
-*> It is suggested that these defaults be adjusted in order
-*> to attain best performance in each particular
-*> computational environment.
-*>
-*> ISPEC=12: The DLAHQR vs DLAQR0 crossover point.
-*> Default: 75. (Must be at least 11.)
-*>
-*> ISPEC=13: Recommended deflation window size.
-*> This depends on ILO, IHI and NS. NS is the
-*> number of simultaneous shifts returned
-*> by ILAENV(ISPEC=15). (See ISPEC=15 below.)
-*> The default for (IHI-ILO+1).LE.500 is NS.
-*> The default for (IHI-ILO+1).GT.500 is 3*NS/2.
-*>
-*> ISPEC=14: Nibble crossover point. (See IPARMQ for
-*> details.) Default: 14% of deflation window
-*> size.
-*>
-*> ISPEC=15: Number of simultaneous shifts in a multishift
-*> QR iteration.
-*>
-*> If IHI-ILO+1 is ...
-*>
-*> greater than ...but less ... the
-*> or equal to ... than default is
-*>
-*> 1 30 NS = 2(+)
-*> 30 60 NS = 4(+)
-*> 60 150 NS = 10(+)
-*> 150 590 NS = **
-*> 590 3000 NS = 64
-*> 3000 6000 NS = 128
-*> 6000 infinity NS = 256
-*>
-*> (+) By default some or all matrices of this order
-*> are passed to the implicit double shift routine
-*> DLAHQR and this parameter is ignored. See
-*> ISPEC=12 above and comments in IPARMQ for
-*> details.
-*>
-*> (**) The asterisks (**) indicate an ad-hoc
-*> function of N increasing from 10 to 64.
-*>
-*> ISPEC=16: Select structured matrix multiply.
-*> If the number of simultaneous shifts (specified
-*> by ISPEC=15) is less than 14, then the default
-*> for ISPEC=16 is 0. Otherwise the default for
-*> ISPEC=16 is 2.
-*> \endverbatim
-*
-*> \par References:
-* ================
-*>
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*> Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*> 929--947, 2002.
-*> \n
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part II: Aggressive Early Deflation, SIAM Journal
-*> of Matrix Analysis, volume 23, pages 948--973, 2002.
-*
-* =====================================================================
- SUBROUTINE DHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z,
- $ LDZ, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N
- CHARACTER COMPZ, JOB
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ),
- $ Z( LDZ, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
-*
-* ==== Matrices of order NTINY or smaller must be processed by
-* . DLAHQR because of insufficient subdiagonal scratch space.
-* . (This is a hard limit.) ====
- INTEGER NTINY
- PARAMETER ( NTINY = 11 )
-*
-* ==== NL allocates some local workspace to help small matrices
-* . through a rare DLAHQR failure. NL .GT. NTINY = 11 is
-* . required and NL .LE. NMIN = ILAENV(ISPEC=12,...) is recom-
-* . mended. (The default value of NMIN is 75.) Using NL = 49
-* . allows up to six simultaneous shifts and a 16-by-16
-* . deflation window. ====
- INTEGER NL
- PARAMETER ( NL = 49 )
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0 )
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION HL( NL, NL ), WORKL( NL )
-* ..
-* .. Local Scalars ..
- INTEGER I, KBOT, NMIN
- LOGICAL INITZ, LQUERY, WANTT, WANTZ
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- LOGICAL LSAME
- EXTERNAL ILAENV, LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACPY, DLAHQR, DLAQR0, DLASET, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DBLE, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* ==== Decode and check the input parameters. ====
-*
- WANTT = LSAME( JOB, 'S' )
- INITZ = LSAME( COMPZ, 'I' )
- WANTZ = INITZ .OR. LSAME( COMPZ, 'V' )
- WORK( 1 ) = DBLE( MAX( 1, N ) )
- LQUERY = LWORK.EQ.-1
-*
- INFO = 0
- IF( .NOT.LSAME( JOB, 'E' ) .AND. .NOT.WANTT ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( COMPZ, 'N' ) .AND. .NOT.WANTZ ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
- INFO = -5
- ELSE IF( LDH.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.MAX( 1, N ) ) ) THEN
- INFO = -11
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
-*
- IF( INFO.NE.0 ) THEN
-*
-* ==== Quick return in case of invalid argument. ====
-*
- CALL XERBLA( 'DHSEQR', -INFO )
- RETURN
-*
- ELSE IF( N.EQ.0 ) THEN
-*
-* ==== Quick return in case N = 0; nothing to do. ====
-*
- RETURN
-*
- ELSE IF( LQUERY ) THEN
-*
-* ==== Quick return in case of a workspace query ====
-*
- CALL DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO,
- $ IHI, Z, LDZ, WORK, LWORK, INFO )
-* ==== Ensure reported workspace size is backward-compatible with
-* . previous LAPACK versions. ====
- WORK( 1 ) = MAX( DBLE( MAX( 1, N ) ), WORK( 1 ) )
- RETURN
-*
- ELSE
-*
-* ==== copy eigenvalues isolated by DGEBAL ====
-*
- DO 10 I = 1, ILO - 1
- WR( I ) = H( I, I )
- WI( I ) = ZERO
- 10 CONTINUE
- DO 20 I = IHI + 1, N
- WR( I ) = H( I, I )
- WI( I ) = ZERO
- 20 CONTINUE
-*
-* ==== Initialize Z, if requested ====
-*
- IF( INITZ )
- $ CALL DLASET( 'A', N, N, ZERO, ONE, Z, LDZ )
-*
-* ==== Quick return if possible ====
-*
- IF( ILO.EQ.IHI ) THEN
- WR( ILO ) = H( ILO, ILO )
- WI( ILO ) = ZERO
- RETURN
- END IF
-*
-* ==== DLAHQR/DLAQR0 crossover point ====
-*
- NMIN = ILAENV( 12, 'DHSEQR', JOB( : 1 ) // COMPZ( : 1 ), N,
- $ ILO, IHI, LWORK )
- NMIN = MAX( NTINY, NMIN )
-*
-* ==== DLAQR0 for big matrices; DLAHQR for small ones ====
-*
- IF( N.GT.NMIN ) THEN
- CALL DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO,
- $ IHI, Z, LDZ, WORK, LWORK, INFO )
- ELSE
-*
-* ==== Small matrix ====
-*
- CALL DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO,
- $ IHI, Z, LDZ, INFO )
-*
- IF( INFO.GT.0 ) THEN
-*
-* ==== A rare DLAHQR failure! DLAQR0 sometimes succeeds
-* . when DLAHQR fails. ====
-*
- KBOT = INFO
-*
- IF( N.GE.NL ) THEN
-*
-* ==== Larger matrices have enough subdiagonal scratch
-* . space to call DLAQR0 directly. ====
-*
- CALL DLAQR0( WANTT, WANTZ, N, ILO, KBOT, H, LDH, WR,
- $ WI, ILO, IHI, Z, LDZ, WORK, LWORK, INFO )
-*
- ELSE
-*
-* ==== Tiny matrices don't have enough subdiagonal
-* . scratch space to benefit from DLAQR0. Hence,
-* . tiny matrices must be copied into a larger
-* . array before calling DLAQR0. ====
-*
- CALL DLACPY( 'A', N, N, H, LDH, HL, NL )
- HL( N+1, N ) = ZERO
- CALL DLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1, N+1 ),
- $ NL )
- CALL DLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL, WR,
- $ WI, ILO, IHI, Z, LDZ, WORKL, NL, INFO )
- IF( WANTT .OR. INFO.NE.0 )
- $ CALL DLACPY( 'A', N, N, HL, NL, H, LDH )
- END IF
- END IF
- END IF
-*
-* ==== Clear out the trash, if necessary. ====
-*
- IF( ( WANTT .OR. INFO.NE.0 ) .AND. N.GT.2 )
- $ CALL DLASET( 'L', N-2, N-2, ZERO, ZERO, H( 3, 1 ), LDH )
-*
-* ==== Ensure reported workspace size is backward-compatible with
-* . previous LAPACK versions. ====
-*
- WORK( 1 ) = MAX( DBLE( MAX( 1, N ) ), WORK( 1 ) )
- END IF
-*
-* ==== End of DHSEQR ====
-*
- END
diff --git a/mtx/lapack_src/disnan.f b/mtx/lapack_src/disnan.f
deleted file mode 100644
index f6a02bf1f..000000000
--- a/mtx/lapack_src/disnan.f
+++ /dev/null
@@ -1,80 +0,0 @@
-*> \brief \b DISNAN
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DISNAN + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* LOGICAL FUNCTION DISNAN( DIN )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION DIN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DISNAN returns .TRUE. if its argument is NaN, and .FALSE.
-*> otherwise. To be replaced by the Fortran 2003 intrinsic in the
-*> future.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] DIN
-*> \verbatim
-*> DIN is DOUBLE PRECISION
-*> Input to test for NaN.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- LOGICAL FUNCTION DISNAN( DIN )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION DIN
-* ..
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL DLAISNAN
- EXTERNAL DLAISNAN
-* ..
-* .. Executable Statements ..
- DISNAN = DLAISNAN(DIN,DIN)
- RETURN
- END
diff --git a/mtx/lapack_src/dlabad.f b/mtx/lapack_src/dlabad.f
deleted file mode 100644
index 9eda3c91d..000000000
--- a/mtx/lapack_src/dlabad.f
+++ /dev/null
@@ -1,105 +0,0 @@
-*> \brief \b DLABAD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLABAD + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLABAD( SMALL, LARGE )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION LARGE, SMALL
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in,out] SMALL
-*> \verbatim
-*> SMALL is DOUBLE PRECISION
-*> On entry, the underflow threshold as computed by DLAMCH.
-*> On exit, if LOG10(LARGE) is sufficiently large, the square
-*> root of SMALL, otherwise unchanged.
-*> \endverbatim
-*>
-*> \param[in,out] LARGE
-*> \verbatim
-*> LARGE is DOUBLE PRECISION
-*> On entry, the overflow threshold as computed by DLAMCH.
-*> On exit, if LOG10(LARGE) is sufficiently large, the square
-*> root of LARGE, otherwise unchanged.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLABAD( SMALL, LARGE )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION LARGE, SMALL
-* ..
-*
-* =====================================================================
-*
-* .. Intrinsic Functions ..
- INTRINSIC LOG10, SQRT
-* ..
-* .. Executable Statements ..
-*
-* If it looks like we're on a Cray, take the square root of
-* SMALL and LARGE to avoid overflow and underflow problems.
-*
- IF( LOG10( LARGE ).GT.2000.D0 ) THEN
- SMALL = SQRT( SMALL )
- LARGE = SQRT( LARGE )
- END IF
-*
- RETURN
-*
-* End of DLABAD
-*
- END
diff --git a/mtx/lapack_src/dlabrd.f b/mtx/lapack_src/dlabrd.f
deleted file mode 100644
index 4e56f1e37..000000000
--- a/mtx/lapack_src/dlabrd.f
+++ /dev/null
@@ -1,381 +0,0 @@
-*> \brief \b DLABRD
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLABRD + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
-* LDY )
-*
-* .. Scalar Arguments ..
-* INTEGER LDA, LDX, LDY, M, N, NB
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ),
-* $ TAUQ( * ), X( LDX, * ), Y( LDY, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows in the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns in the matrix A.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The number of leading rows and columns of A to be reduced.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the m by n general matrix to be reduced.
-*> On exit, the first NB rows and columns of the matrix are
-*> overwritten; the rest of the array is unchanged.
-*> If m >= n, elements on and below the diagonal in the first NB
-*> columns, with the array TAUQ, represent the orthogonal
-*> matrix Q as a product of elementary reflectors; and
-*> elements above the diagonal in the first NB rows, with the
-*> array TAUP, represent the orthogonal matrix P as a product
-*> of elementary reflectors.
-*> If m < n, elements below the diagonal in the first NB
-*> columns, with the array TAUQ, represent the orthogonal
-*> matrix Q as a product of elementary reflectors, and
-*> elements on and above the diagonal in the first NB rows,
-*> with the array TAUP, represent the orthogonal matrix P as
-*> a product of elementary reflectors.
-*> See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (NB)
-*> The diagonal elements of the first NB rows and columns of
-*> the reduced matrix. D(i) = A(i,i).
-*> \endverbatim
-*>
-*> \param[out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (NB)
-*> The off-diagonal elements of the first NB rows and columns of
-*> the reduced matrix.
-*> \endverbatim
-*>
-*> \param[out] TAUQ
-*> \verbatim
-*> TAUQ is DOUBLE PRECISION array dimension (NB)
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix Q. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] TAUP
-*> \verbatim
-*> TAUP is DOUBLE PRECISION array, dimension (NB)
-*> The scalar factors of the elementary reflectors which
-*> represent the orthogonal matrix P. See Further Details.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NB)
-*> The m-by-nb matrix X required to update the unreduced part
-*> of A.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array, dimension (LDY,NB)
-*> The n-by-nb matrix Y required to update the unreduced part
-*> of A.
-*> \endverbatim
-*>
-*> \param[in] LDY
-*> \verbatim
-*> LDY is INTEGER
-*> The leading dimension of the array Y. LDY >= max(1,N).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrices Q and P are represented as products of elementary
-*> reflectors:
-*>
-*> Q = H(1) H(2) . . . H(nb) and P = G(1) G(2) . . . G(nb)
-*>
-*> Each H(i) and G(i) has the form:
-*>
-*> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
-*>
-*> where tauq and taup are real scalars, and v and u are real vectors.
-*>
-*> If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in
-*> A(i:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+1:n) is stored on exit in
-*> A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> If m < n, v(1:i) = 0, v(i+1) = 1, and v(i+1:m) is stored on exit in
-*> A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i:n) is stored on exit in
-*> A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
-*>
-*> The elements of the vectors v and u together form the m-by-nb matrix
-*> V and the nb-by-n matrix U**T which are needed, with X and Y, to apply
-*> the transformation to the unreduced part of the matrix, using a block
-*> update of the form: A := A - V*Y**T - X*U**T.
-*>
-*> The contents of A on exit are illustrated by the following examples
-*> with nb = 2:
-*>
-*> m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
-*>
-*> ( 1 1 u1 u1 u1 ) ( 1 u1 u1 u1 u1 u1 )
-*> ( v1 1 1 u2 u2 ) ( 1 1 u2 u2 u2 u2 )
-*> ( v1 v2 a a a ) ( v1 1 a a a a )
-*> ( v1 v2 a a a ) ( v1 v2 a a a a )
-*> ( v1 v2 a a a ) ( v1 v2 a a a a )
-*> ( v1 v2 a a a )
-*>
-*> where a denotes an element of the original matrix which is unchanged,
-*> vi denotes an element of the vector defining H(i), and ui an element
-*> of the vector defining G(i).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
- $ LDY )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER LDA, LDX, LDY, M, N, NB
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ),
- $ TAUQ( * ), X( LDX, * ), Y( LDY, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DLARFG, DSCAL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 )
- $ RETURN
-*
- IF( M.GE.N ) THEN
-*
-* Reduce to upper bidiagonal form
-*
- DO 10 I = 1, NB
-*
-* Update A(i:m,i)
-*
- CALL DGEMV( 'No transpose', M-I+1, I-1, -ONE, A( I, 1 ),
- $ LDA, Y( I, 1 ), LDY, ONE, A( I, I ), 1 )
- CALL DGEMV( 'No transpose', M-I+1, I-1, -ONE, X( I, 1 ),
- $ LDX, A( 1, I ), 1, ONE, A( I, I ), 1 )
-*
-* Generate reflection Q(i) to annihilate A(i+1:m,i)
-*
- CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
- $ TAUQ( I ) )
- D( I ) = A( I, I )
- IF( I.LT.N ) THEN
- A( I, I ) = ONE
-*
-* Compute Y(i+1:n,i)
-*
- CALL DGEMV( 'Transpose', M-I+1, N-I, ONE, A( I, I+1 ),
- $ LDA, A( I, I ), 1, ZERO, Y( I+1, I ), 1 )
- CALL DGEMV( 'Transpose', M-I+1, I-1, ONE, A( I, 1 ), LDA,
- $ A( I, I ), 1, ZERO, Y( 1, I ), 1 )
- CALL DGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ),
- $ LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
- CALL DGEMV( 'Transpose', M-I+1, I-1, ONE, X( I, 1 ), LDX,
- $ A( I, I ), 1, ZERO, Y( 1, I ), 1 )
- CALL DGEMV( 'Transpose', I-1, N-I, -ONE, A( 1, I+1 ),
- $ LDA, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
- CALL DSCAL( N-I, TAUQ( I ), Y( I+1, I ), 1 )
-*
-* Update A(i,i+1:n)
-*
- CALL DGEMV( 'No transpose', N-I, I, -ONE, Y( I+1, 1 ),
- $ LDY, A( I, 1 ), LDA, ONE, A( I, I+1 ), LDA )
- CALL DGEMV( 'Transpose', I-1, N-I, -ONE, A( 1, I+1 ),
- $ LDA, X( I, 1 ), LDX, ONE, A( I, I+1 ), LDA )
-*
-* Generate reflection P(i) to annihilate A(i,i+2:n)
-*
- CALL DLARFG( N-I, A( I, I+1 ), A( I, MIN( I+2, N ) ),
- $ LDA, TAUP( I ) )
- E( I ) = A( I, I+1 )
- A( I, I+1 ) = ONE
-*
-* Compute X(i+1:m,i)
-*
- CALL DGEMV( 'No transpose', M-I, N-I, ONE, A( I+1, I+1 ),
- $ LDA, A( I, I+1 ), LDA, ZERO, X( I+1, I ), 1 )
- CALL DGEMV( 'Transpose', N-I, I, ONE, Y( I+1, 1 ), LDY,
- $ A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 )
- CALL DGEMV( 'No transpose', M-I, I, -ONE, A( I+1, 1 ),
- $ LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
- CALL DGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ),
- $ LDA, A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 )
- CALL DGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ),
- $ LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
- CALL DSCAL( M-I, TAUP( I ), X( I+1, I ), 1 )
- END IF
- 10 CONTINUE
- ELSE
-*
-* Reduce to lower bidiagonal form
-*
- DO 20 I = 1, NB
-*
-* Update A(i,i:n)
-*
- CALL DGEMV( 'No transpose', N-I+1, I-1, -ONE, Y( I, 1 ),
- $ LDY, A( I, 1 ), LDA, ONE, A( I, I ), LDA )
- CALL DGEMV( 'Transpose', I-1, N-I+1, -ONE, A( 1, I ), LDA,
- $ X( I, 1 ), LDX, ONE, A( I, I ), LDA )
-*
-* Generate reflection P(i) to annihilate A(i,i+1:n)
-*
- CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
- $ TAUP( I ) )
- D( I ) = A( I, I )
- IF( I.LT.M ) THEN
- A( I, I ) = ONE
-*
-* Compute X(i+1:m,i)
-*
- CALL DGEMV( 'No transpose', M-I, N-I+1, ONE, A( I+1, I ),
- $ LDA, A( I, I ), LDA, ZERO, X( I+1, I ), 1 )
- CALL DGEMV( 'Transpose', N-I+1, I-1, ONE, Y( I, 1 ), LDY,
- $ A( I, I ), LDA, ZERO, X( 1, I ), 1 )
- CALL DGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ),
- $ LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
- CALL DGEMV( 'No transpose', I-1, N-I+1, ONE, A( 1, I ),
- $ LDA, A( I, I ), LDA, ZERO, X( 1, I ), 1 )
- CALL DGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ),
- $ LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
- CALL DSCAL( M-I, TAUP( I ), X( I+1, I ), 1 )
-*
-* Update A(i+1:m,i)
-*
- CALL DGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ),
- $ LDA, Y( I, 1 ), LDY, ONE, A( I+1, I ), 1 )
- CALL DGEMV( 'No transpose', M-I, I, -ONE, X( I+1, 1 ),
- $ LDX, A( 1, I ), 1, ONE, A( I+1, I ), 1 )
-*
-* Generate reflection Q(i) to annihilate A(i+2:m,i)
-*
- CALL DLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1,
- $ TAUQ( I ) )
- E( I ) = A( I+1, I )
- A( I+1, I ) = ONE
-*
-* Compute Y(i+1:n,i)
-*
- CALL DGEMV( 'Transpose', M-I, N-I, ONE, A( I+1, I+1 ),
- $ LDA, A( I+1, I ), 1, ZERO, Y( I+1, I ), 1 )
- CALL DGEMV( 'Transpose', M-I, I-1, ONE, A( I+1, 1 ), LDA,
- $ A( I+1, I ), 1, ZERO, Y( 1, I ), 1 )
- CALL DGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ),
- $ LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
- CALL DGEMV( 'Transpose', M-I, I, ONE, X( I+1, 1 ), LDX,
- $ A( I+1, I ), 1, ZERO, Y( 1, I ), 1 )
- CALL DGEMV( 'Transpose', I, N-I, -ONE, A( 1, I+1 ), LDA,
- $ Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
- CALL DSCAL( N-I, TAUQ( I ), Y( I+1, I ), 1 )
- END IF
- 20 CONTINUE
- END IF
- RETURN
-*
-* End of DLABRD
-*
- END
diff --git a/mtx/lapack_src/dlacn2.f b/mtx/lapack_src/dlacn2.f
deleted file mode 100644
index 60959c6e1..000000000
--- a/mtx/lapack_src/dlacn2.f
+++ /dev/null
@@ -1,294 +0,0 @@
-*> \brief \b DLACN2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLACN2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
-*
-* .. Scalar Arguments ..
-* INTEGER KASE, N
-* DOUBLE PRECISION EST
-* ..
-* .. Array Arguments ..
-* INTEGER ISGN( * ), ISAVE( 3 )
-* DOUBLE PRECISION V( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLACN2 estimates the 1-norm of a square, real matrix A.
-*> Reverse communication is used for evaluating matrix-vector products.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix. N >= 1.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (N)
-*> On the final return, V = A*W, where EST = norm(V)/norm(W)
-*> (W is not returned).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (N)
-*> On an intermediate return, X should be overwritten by
-*> A * X, if KASE=1,
-*> A**T * X, if KASE=2,
-*> and DLACN2 must be re-called with all the other parameters
-*> unchanged.
-*> \endverbatim
-*>
-*> \param[out] ISGN
-*> \verbatim
-*> ISGN is INTEGER array, dimension (N)
-*> \endverbatim
-*>
-*> \param[in,out] EST
-*> \verbatim
-*> EST is DOUBLE PRECISION
-*> On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be
-*> unchanged from the previous call to DLACN2.
-*> On exit, EST is an estimate (a lower bound) for norm(A).
-*> \endverbatim
-*>
-*> \param[in,out] KASE
-*> \verbatim
-*> KASE is INTEGER
-*> On the initial call to DLACN2, KASE should be 0.
-*> On an intermediate return, KASE will be 1 or 2, indicating
-*> whether X should be overwritten by A * X or A**T * X.
-*> On the final return from DLACN2, KASE will again be 0.
-*> \endverbatim
-*>
-*> \param[in,out] ISAVE
-*> \verbatim
-*> ISAVE is INTEGER array, dimension (3)
-*> ISAVE is used to save variables between calls to DLACN2
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Originally named SONEST, dated March 16, 1988.
-*>
-*> This is a thread safe version of DLACON, which uses the array ISAVE
-*> in place of a SAVE statement, as follows:
-*>
-*> DLACON DLACN2
-*> JUMP ISAVE(1)
-*> J ISAVE(2)
-*> ITER ISAVE(3)
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Nick Higham, University of Manchester
-*
-*> \par References:
-* ================
-*>
-*> N.J. Higham, "FORTRAN codes for estimating the one-norm of
-*> a real or complex matrix, with applications to condition estimation",
-*> ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
-*>
-* =====================================================================
- SUBROUTINE DLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER KASE, N
- DOUBLE PRECISION EST
-* ..
-* .. Array Arguments ..
- INTEGER ISGN( * ), ISAVE( 3 )
- DOUBLE PRECISION V( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 5 )
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, JLAST
- DOUBLE PRECISION ALTSGN, ESTOLD, TEMP
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DASUM
- EXTERNAL IDAMAX, DASUM
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, NINT, SIGN
-* ..
-* .. Executable Statements ..
-*
- IF( KASE.EQ.0 ) THEN
- DO 10 I = 1, N
- X( I ) = ONE / DBLE( N )
- 10 CONTINUE
- KASE = 1
- ISAVE( 1 ) = 1
- RETURN
- END IF
-*
- GO TO ( 20, 40, 70, 110, 140 )ISAVE( 1 )
-*
-* ................ ENTRY (ISAVE( 1 ) = 1)
-* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X.
-*
- 20 CONTINUE
- IF( N.EQ.1 ) THEN
- V( 1 ) = X( 1 )
- EST = ABS( V( 1 ) )
-* ... QUIT
- GO TO 150
- END IF
- EST = DASUM( N, X, 1 )
-*
- DO 30 I = 1, N
- X( I ) = SIGN( ONE, X( I ) )
- ISGN( I ) = NINT( X( I ) )
- 30 CONTINUE
- KASE = 2
- ISAVE( 1 ) = 2
- RETURN
-*
-* ................ ENTRY (ISAVE( 1 ) = 2)
-* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
-*
- 40 CONTINUE
- ISAVE( 2 ) = IDAMAX( N, X, 1 )
- ISAVE( 3 ) = 2
-*
-* MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
-*
- 50 CONTINUE
- DO 60 I = 1, N
- X( I ) = ZERO
- 60 CONTINUE
- X( ISAVE( 2 ) ) = ONE
- KASE = 1
- ISAVE( 1 ) = 3
- RETURN
-*
-* ................ ENTRY (ISAVE( 1 ) = 3)
-* X HAS BEEN OVERWRITTEN BY A*X.
-*
- 70 CONTINUE
- CALL DCOPY( N, X, 1, V, 1 )
- ESTOLD = EST
- EST = DASUM( N, V, 1 )
- DO 80 I = 1, N
- IF( NINT( SIGN( ONE, X( I ) ) ).NE.ISGN( I ) )
- $ GO TO 90
- 80 CONTINUE
-* REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
- GO TO 120
-*
- 90 CONTINUE
-* TEST FOR CYCLING.
- IF( EST.LE.ESTOLD )
- $ GO TO 120
-*
- DO 100 I = 1, N
- X( I ) = SIGN( ONE, X( I ) )
- ISGN( I ) = NINT( X( I ) )
- 100 CONTINUE
- KASE = 2
- ISAVE( 1 ) = 4
- RETURN
-*
-* ................ ENTRY (ISAVE( 1 ) = 4)
-* X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
-*
- 110 CONTINUE
- JLAST = ISAVE( 2 )
- ISAVE( 2 ) = IDAMAX( N, X, 1 )
- IF( ( X( JLAST ).NE.ABS( X( ISAVE( 2 ) ) ) ) .AND.
- $ ( ISAVE( 3 ).LT.ITMAX ) ) THEN
- ISAVE( 3 ) = ISAVE( 3 ) + 1
- GO TO 50
- END IF
-*
-* ITERATION COMPLETE. FINAL STAGE.
-*
- 120 CONTINUE
- ALTSGN = ONE
- DO 130 I = 1, N
- X( I ) = ALTSGN*( ONE+DBLE( I-1 ) / DBLE( N-1 ) )
- ALTSGN = -ALTSGN
- 130 CONTINUE
- KASE = 1
- ISAVE( 1 ) = 5
- RETURN
-*
-* ................ ENTRY (ISAVE( 1 ) = 5)
-* X HAS BEEN OVERWRITTEN BY A*X.
-*
- 140 CONTINUE
- TEMP = TWO*( DASUM( N, X, 1 ) / DBLE( 3*N ) )
- IF( TEMP.GT.EST ) THEN
- CALL DCOPY( N, X, 1, V, 1 )
- EST = TEMP
- END IF
-*
- 150 CONTINUE
- KASE = 0
- RETURN
-*
-* End of DLACN2
-*
- END
diff --git a/mtx/lapack_src/dlacpy.f b/mtx/lapack_src/dlacpy.f
deleted file mode 100644
index f9c7a7597..000000000
--- a/mtx/lapack_src/dlacpy.f
+++ /dev/null
@@ -1,156 +0,0 @@
-*> \brief \b DLACPY
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLACPY + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER LDA, LDB, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLACPY copies all or part of a two-dimensional matrix A to another
-*> matrix B.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies the part of the matrix A to be copied to B.
-*> = 'U': Upper triangular part
-*> = 'L': Lower triangular part
-*> Otherwise: All of the matrix A
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The m by n matrix A. If UPLO = 'U', only the upper triangle
-*> or trapezoid is accessed; if UPLO = 'L', only the lower
-*> triangle or trapezoid is accessed.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,N)
-*> On exit, B = A in the locations specified by UPLO.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER LDA, LDB, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 20 J = 1, N
- DO 10 I = 1, MIN( J, M )
- B( I, J ) = A( I, J )
- 10 CONTINUE
- 20 CONTINUE
- ELSE IF( LSAME( UPLO, 'L' ) ) THEN
- DO 40 J = 1, N
- DO 30 I = J, M
- B( I, J ) = A( I, J )
- 30 CONTINUE
- 40 CONTINUE
- ELSE
- DO 60 J = 1, N
- DO 50 I = 1, M
- B( I, J ) = A( I, J )
- 50 CONTINUE
- 60 CONTINUE
- END IF
- RETURN
-*
-* End of DLACPY
-*
- END
diff --git a/mtx/lapack_src/dladiv.f b/mtx/lapack_src/dladiv.f
deleted file mode 100644
index 090a90654..000000000
--- a/mtx/lapack_src/dladiv.f
+++ /dev/null
@@ -1,128 +0,0 @@
-*> \brief \b DLADIV
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLADIV + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLADIV( A, B, C, D, P, Q )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION A, B, C, D, P, Q
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLADIV performs complex division in real arithmetic
-*>
-*> a + i*b
-*> p + i*q = ---------
-*> c + i*d
-*>
-*> The algorithm is due to Robert L. Smith and can be found
-*> in D. Knuth, The art of Computer Programming, Vol.2, p.195
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION
-*> The scalars a, b, c, and d in the above expression.
-*> \endverbatim
-*>
-*> \param[out] P
-*> \verbatim
-*> P is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION
-*> The scalars p and q in the above expression.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLADIV( A, B, C, D, P, Q )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION A, B, C, D, P, Q
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION E, F
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- IF( ABS( D ).LT.ABS( C ) ) THEN
- E = D / C
- F = C + D*E
- P = ( A+B*E ) / F
- Q = ( B-A*E ) / F
- ELSE
- E = C / D
- F = D + C*E
- P = ( B+A*E ) / F
- Q = ( -A+B*E ) / F
- END IF
-*
- RETURN
-*
-* End of DLADIV
-*
- END
diff --git a/mtx/lapack_src/dlaexc.f b/mtx/lapack_src/dlaexc.f
deleted file mode 100644
index b12e10597..000000000
--- a/mtx/lapack_src/dlaexc.f
+++ /dev/null
@@ -1,436 +0,0 @@
-*> \brief \b DLAEXC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAEXC + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL WANTQ
-* INTEGER INFO, J1, LDQ, LDT, N, N1, N2
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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 elemnts equal and its off-diagonal elements of
-*> opposite sign.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTQ
-*> \verbatim
-*> WANTQ is LOGICAL
-*> = .TRUE. : accumulate the transformation in the matrix Q;
-*> = .FALSE.: do not accumulate the transformation.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,N)
-*> On entry, the upper quasi-triangular matrix T, in Schur
-*> canonical form.
-*> On exit, the updated matrix T, again in Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> On entry, if WANTQ is .TRUE., the orthogonal matrix Q.
-*> On exit, if WANTQ is .TRUE., the updated matrix Q.
-*> If WANTQ is .FALSE., Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q.
-*> LDQ >= 1; and if WANTQ is .TRUE., LDQ >= N.
-*> \endverbatim
-*>
-*> \param[in] J1
-*> \verbatim
-*> J1 is INTEGER
-*> The index of the first row of the first block T11.
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> The order of the first block T11. N1 = 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[in] N2
-*> \verbatim
-*> N2 is INTEGER
-*> The order of the second block T22. N2 = 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> = 1: the transformed matrix T would be too far from Schur
-*> form; the blocks are not swapped and T and Q are
-*> unchanged.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK,
- $ INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- LOGICAL WANTQ
- INTEGER INFO, J1, LDQ, LDT, N, N1, N2
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
- DOUBLE PRECISION TEN
- PARAMETER ( TEN = 1.0D+1 )
- INTEGER LDD, LDX
- PARAMETER ( LDD = 4, LDX = 2 )
-* ..
-* .. Local Scalars ..
- INTEGER IERR, J2, J3, J4, K, ND
- DOUBLE PRECISION CS, DNORM, EPS, SCALE, SMLNUM, SN, T11, T22,
- $ T33, TAU, TAU1, TAU2, TEMP, THRESH, WI1, WI2,
- $ WR1, WR2, XNORM
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION D( LDD, 4 ), U( 3 ), U1( 3 ), U2( 3 ),
- $ X( LDX, 2 )
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL DLAMCH, DLANGE
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACPY, DLANV2, DLARFG, DLARFX, DLARTG, DLASY2,
- $ DROT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. N1.EQ.0 .OR. N2.EQ.0 )
- $ RETURN
- IF( J1+N1.GT.N )
- $ RETURN
-*
- J2 = J1 + 1
- J3 = J1 + 2
- J4 = J1 + 3
-*
- IF( N1.EQ.1 .AND. N2.EQ.1 ) THEN
-*
-* Swap two 1-by-1 blocks.
-*
- T11 = T( J1, J1 )
- T22 = T( J2, J2 )
-*
-* Determine the transformation to perform the interchange.
-*
- CALL DLARTG( T( J1, J2 ), T22-T11, CS, SN, TEMP )
-*
-* Apply transformation to the matrix T.
-*
- IF( J3.LE.N )
- $ CALL DROT( N-J1-1, T( J1, J3 ), LDT, T( J2, J3 ), LDT, CS,
- $ SN )
- CALL DROT( J1-1, T( 1, J1 ), 1, T( 1, J2 ), 1, CS, SN )
-*
- T( J1, J1 ) = T22
- T( J2, J2 ) = T11
-*
- IF( WANTQ ) THEN
-*
-* Accumulate transformation in the matrix Q.
-*
- CALL DROT( N, Q( 1, J1 ), 1, Q( 1, J2 ), 1, CS, SN )
- END IF
-*
- ELSE
-*
-* Swapping involves at least one 2-by-2 block.
-*
-* Copy the diagonal block of order N1+N2 to the local array D
-* and compute its norm.
-*
- ND = N1 + N2
- CALL DLACPY( 'Full', ND, ND, T( J1, J1 ), LDT, D, LDD )
- DNORM = DLANGE( 'Max', ND, ND, D, LDD, WORK )
-*
-* Compute machine-dependent threshold for test for accepting
-* swap.
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' ) / EPS
- THRESH = MAX( TEN*EPS*DNORM, SMLNUM )
-*
-* Solve T11*X - X*T22 = scale*T12 for X.
-*
- CALL DLASY2( .FALSE., .FALSE., -1, N1, N2, D, LDD,
- $ D( N1+1, N1+1 ), LDD, D( 1, N1+1 ), LDD, SCALE, X,
- $ LDX, XNORM, IERR )
-*
-* Swap the adjacent diagonal blocks.
-*
- K = N1 + N1 + N2 - 3
- GO TO ( 10, 20, 30 )K
-*
- 10 CONTINUE
-*
-* N1 = 1, N2 = 2: generate elementary reflector H so that:
-*
-* ( scale, X11, X12 ) H = ( 0, 0, * )
-*
- U( 1 ) = SCALE
- U( 2 ) = X( 1, 1 )
- U( 3 ) = X( 1, 2 )
- CALL DLARFG( 3, U( 3 ), U, 1, TAU )
- U( 3 ) = ONE
- T11 = T( J1, J1 )
-*
-* Perform swap provisionally on diagonal block in D.
-*
- CALL DLARFX( 'L', 3, 3, U, TAU, D, LDD, WORK )
- CALL DLARFX( 'R', 3, 3, U, TAU, D, LDD, WORK )
-*
-* Test whether to reject swap.
-*
- IF( MAX( ABS( D( 3, 1 ) ), ABS( D( 3, 2 ) ), ABS( D( 3,
- $ 3 )-T11 ) ).GT.THRESH )GO TO 50
-*
-* Accept swap: apply transformation to the entire matrix T.
-*
- CALL DLARFX( 'L', 3, N-J1+1, U, TAU, T( J1, J1 ), LDT, WORK )
- CALL DLARFX( 'R', J2, 3, U, TAU, T( 1, J1 ), LDT, WORK )
-*
- T( J3, J1 ) = ZERO
- T( J3, J2 ) = ZERO
- T( J3, J3 ) = T11
-*
- IF( WANTQ ) THEN
-*
-* Accumulate transformation in the matrix Q.
-*
- CALL DLARFX( 'R', N, 3, U, TAU, Q( 1, J1 ), LDQ, WORK )
- END IF
- GO TO 40
-*
- 20 CONTINUE
-*
-* N1 = 2, N2 = 1: generate elementary reflector H so that:
-*
-* H ( -X11 ) = ( * )
-* ( -X21 ) = ( 0 )
-* ( scale ) = ( 0 )
-*
- U( 1 ) = -X( 1, 1 )
- U( 2 ) = -X( 2, 1 )
- U( 3 ) = SCALE
- CALL DLARFG( 3, U( 1 ), U( 2 ), 1, TAU )
- U( 1 ) = ONE
- T33 = T( J3, J3 )
-*
-* Perform swap provisionally on diagonal block in D.
-*
- CALL DLARFX( 'L', 3, 3, U, TAU, D, LDD, WORK )
- CALL DLARFX( 'R', 3, 3, U, TAU, D, LDD, WORK )
-*
-* Test whether to reject swap.
-*
- IF( MAX( ABS( D( 2, 1 ) ), ABS( D( 3, 1 ) ), ABS( D( 1,
- $ 1 )-T33 ) ).GT.THRESH )GO TO 50
-*
-* Accept swap: apply transformation to the entire matrix T.
-*
- CALL DLARFX( 'R', J3, 3, U, TAU, T( 1, J1 ), LDT, WORK )
- CALL DLARFX( 'L', 3, N-J1, U, TAU, T( J1, J2 ), LDT, WORK )
-*
- T( J1, J1 ) = T33
- T( J2, J1 ) = ZERO
- T( J3, J1 ) = ZERO
-*
- IF( WANTQ ) THEN
-*
-* Accumulate transformation in the matrix Q.
-*
- CALL DLARFX( 'R', N, 3, U, TAU, Q( 1, J1 ), LDQ, WORK )
- END IF
- GO TO 40
-*
- 30 CONTINUE
-*
-* N1 = 2, N2 = 2: generate elementary reflectors H(1) and H(2) so
-* that:
-*
-* H(2) H(1) ( -X11 -X12 ) = ( * * )
-* ( -X21 -X22 ) ( 0 * )
-* ( scale 0 ) ( 0 0 )
-* ( 0 scale ) ( 0 0 )
-*
- U1( 1 ) = -X( 1, 1 )
- U1( 2 ) = -X( 2, 1 )
- U1( 3 ) = SCALE
- CALL DLARFG( 3, U1( 1 ), U1( 2 ), 1, TAU1 )
- U1( 1 ) = ONE
-*
- TEMP = -TAU1*( X( 1, 2 )+U1( 2 )*X( 2, 2 ) )
- U2( 1 ) = -TEMP*U1( 2 ) - X( 2, 2 )
- U2( 2 ) = -TEMP*U1( 3 )
- U2( 3 ) = SCALE
- CALL DLARFG( 3, U2( 1 ), U2( 2 ), 1, TAU2 )
- U2( 1 ) = ONE
-*
-* Perform swap provisionally on diagonal block in D.
-*
- CALL DLARFX( 'L', 3, 4, U1, TAU1, D, LDD, WORK )
- CALL DLARFX( 'R', 4, 3, U1, TAU1, D, LDD, WORK )
- CALL DLARFX( 'L', 3, 4, U2, TAU2, D( 2, 1 ), LDD, WORK )
- CALL DLARFX( 'R', 4, 3, U2, TAU2, D( 1, 2 ), LDD, WORK )
-*
-* Test whether to reject swap.
-*
- IF( MAX( ABS( D( 3, 1 ) ), ABS( D( 3, 2 ) ), ABS( D( 4, 1 ) ),
- $ ABS( D( 4, 2 ) ) ).GT.THRESH )GO TO 50
-*
-* Accept swap: apply transformation to the entire matrix T.
-*
- CALL DLARFX( 'L', 3, N-J1+1, U1, TAU1, T( J1, J1 ), LDT, WORK )
- CALL DLARFX( 'R', J4, 3, U1, TAU1, T( 1, J1 ), LDT, WORK )
- CALL DLARFX( 'L', 3, N-J1+1, U2, TAU2, T( J2, J1 ), LDT, WORK )
- CALL DLARFX( 'R', J4, 3, U2, TAU2, T( 1, J2 ), LDT, WORK )
-*
- T( J3, J1 ) = ZERO
- T( J3, J2 ) = ZERO
- T( J4, J1 ) = ZERO
- T( J4, J2 ) = ZERO
-*
- IF( WANTQ ) THEN
-*
-* Accumulate transformation in the matrix Q.
-*
- CALL DLARFX( 'R', N, 3, U1, TAU1, Q( 1, J1 ), LDQ, WORK )
- CALL DLARFX( 'R', N, 3, U2, TAU2, Q( 1, J2 ), LDQ, WORK )
- END IF
-*
- 40 CONTINUE
-*
- IF( N2.EQ.2 ) THEN
-*
-* Standardize new 2-by-2 block T11
-*
- CALL DLANV2( T( J1, J1 ), T( J1, J2 ), T( J2, J1 ),
- $ T( J2, J2 ), WR1, WI1, WR2, WI2, CS, SN )
- CALL DROT( N-J1-1, T( J1, J1+2 ), LDT, T( J2, J1+2 ), LDT,
- $ CS, SN )
- CALL DROT( J1-1, T( 1, J1 ), 1, T( 1, J2 ), 1, CS, SN )
- IF( WANTQ )
- $ CALL DROT( N, Q( 1, J1 ), 1, Q( 1, J2 ), 1, CS, SN )
- END IF
-*
- IF( N1.EQ.2 ) THEN
-*
-* Standardize new 2-by-2 block T22
-*
- J3 = J1 + N2
- J4 = J3 + 1
- CALL DLANV2( T( J3, J3 ), T( J3, J4 ), T( J4, J3 ),
- $ T( J4, J4 ), WR1, WI1, WR2, WI2, CS, SN )
- IF( J3+2.LE.N )
- $ CALL DROT( N-J3-1, T( J3, J3+2 ), LDT, T( J4, J3+2 ),
- $ LDT, CS, SN )
- CALL DROT( J3-1, T( 1, J3 ), 1, T( 1, J4 ), 1, CS, SN )
- IF( WANTQ )
- $ CALL DROT( N, Q( 1, J3 ), 1, Q( 1, J4 ), 1, CS, SN )
- END IF
-*
- END IF
- RETURN
-*
-* Exit with INFO = 1 if swap was rejected.
-*
- 50 CONTINUE
- INFO = 1
- RETURN
-*
-* End of DLAEXC
-*
- END
diff --git a/mtx/lapack_src/dlagtm.f b/mtx/lapack_src/dlagtm.f
deleted file mode 100644
index 937caf129..000000000
--- a/mtx/lapack_src/dlagtm.f
+++ /dev/null
@@ -1,278 +0,0 @@
-*> \brief \b DLAGTM
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAGTM + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
-* B, LDB )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER LDB, LDX, N, NRHS
-* DOUBLE PRECISION ALPHA, BETA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the operation applied to A.
-*> = 'N': No transpose, B := alpha * A * X + beta * B
-*> = 'T': Transpose, B := alpha * A'* X + beta * B
-*> = 'C': Conjugate transpose = Transpose
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrices X and B.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> The scalar alpha. ALPHA must be 0., 1., or -1.; otherwise,
-*> it is assumed to be 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) sub-diagonal elements of T.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The diagonal elements of T.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) super-diagonal elements of T.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
-*> The N by NRHS matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the array X. LDX >= max(N,1).
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION
-*> The scalar beta. BETA must be 0., 1., or -1.; otherwise,
-*> it is assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the N by NRHS matrix B.
-*> On exit, B is overwritten by the matrix expression
-*> B := alpha * A * X + beta * B.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(N,1).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
- $ B, LDB )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER LDB, LDX, N, NRHS
- DOUBLE PRECISION ALPHA, BETA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Multiply B by BETA if BETA.NE.1.
-*
- IF( BETA.EQ.ZERO ) THEN
- DO 20 J = 1, NRHS
- DO 10 I = 1, N
- B( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE IF( BETA.EQ.-ONE ) THEN
- DO 40 J = 1, NRHS
- DO 30 I = 1, N
- B( I, J ) = -B( I, J )
- 30 CONTINUE
- 40 CONTINUE
- END IF
-*
- IF( ALPHA.EQ.ONE ) THEN
- IF( LSAME( TRANS, 'N' ) ) THEN
-*
-* Compute B := B + A*X
-*
- DO 60 J = 1, NRHS
- IF( N.EQ.1 ) THEN
- B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
- ELSE
- B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
- $ DU( 1 )*X( 2, J )
- B( N, J ) = B( N, J ) + DL( N-1 )*X( N-1, J ) +
- $ D( N )*X( N, J )
- DO 50 I = 2, N - 1
- B( I, J ) = B( I, J ) + DL( I-1 )*X( I-1, J ) +
- $ D( I )*X( I, J ) + DU( I )*X( I+1, J )
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE
-*
-* Compute B := B + A**T*X
-*
- DO 80 J = 1, NRHS
- IF( N.EQ.1 ) THEN
- B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
- ELSE
- B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
- $ DL( 1 )*X( 2, J )
- B( N, J ) = B( N, J ) + DU( N-1 )*X( N-1, J ) +
- $ D( N )*X( N, J )
- DO 70 I = 2, N - 1
- B( I, J ) = B( I, J ) + DU( I-1 )*X( I-1, J ) +
- $ D( I )*X( I, J ) + DL( I )*X( I+1, J )
- 70 CONTINUE
- END IF
- 80 CONTINUE
- END IF
- ELSE IF( ALPHA.EQ.-ONE ) THEN
- IF( LSAME( TRANS, 'N' ) ) THEN
-*
-* Compute B := B - A*X
-*
- DO 100 J = 1, NRHS
- IF( N.EQ.1 ) THEN
- B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
- ELSE
- B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
- $ DU( 1 )*X( 2, J )
- B( N, J ) = B( N, J ) - DL( N-1 )*X( N-1, J ) -
- $ D( N )*X( N, J )
- DO 90 I = 2, N - 1
- B( I, J ) = B( I, J ) - DL( I-1 )*X( I-1, J ) -
- $ D( I )*X( I, J ) - DU( I )*X( I+1, J )
- 90 CONTINUE
- END IF
- 100 CONTINUE
- ELSE
-*
-* Compute B := B - A**T*X
-*
- DO 120 J = 1, NRHS
- IF( N.EQ.1 ) THEN
- B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
- ELSE
- B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
- $ DL( 1 )*X( 2, J )
- B( N, J ) = B( N, J ) - DU( N-1 )*X( N-1, J ) -
- $ D( N )*X( N, J )
- DO 110 I = 2, N - 1
- B( I, J ) = B( I, J ) - DU( I-1 )*X( I-1, J ) -
- $ D( I )*X( I, J ) - DL( I )*X( I+1, J )
- 110 CONTINUE
- END IF
- 120 CONTINUE
- END IF
- END IF
- RETURN
-*
-* End of DLAGTM
-*
- END
diff --git a/mtx/lapack_src/dlahqr.f b/mtx/lapack_src/dlahqr.f
deleted file mode 100644
index 8cbf03082..000000000
--- a/mtx/lapack_src/dlahqr.f
+++ /dev/null
@@ -1,611 +0,0 @@
-*> \brief \b DLAHQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAHQR + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
-* ILOZ, IHIZ, Z, LDZ, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), WI( * ), WR( * ), Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is LOGICAL
-*> = .TRUE. : the full Schur form T is required;
-*> = .FALSE.: only eigenvalues are required.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> = .TRUE. : the matrix of Schur vectors Z is required;
-*> = .FALSE.: Schur vectors are not required.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> It is assumed that H is already upper quasi-triangular in
-*> rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless
-*> ILO = 1). DLAHQR works primarily with the Hessenberg
-*> submatrix in rows and columns ILO to IHI, but applies
-*> transformations to all of H if WANTT is .TRUE..
-*> 1 <= ILO <= max(1,IHI); IHI <= N.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is DOUBLE PRECISION array, dimension (LDH,N)
-*> On entry, the upper Hessenberg matrix H.
-*> On exit, if INFO is zero and if WANTT is .TRUE., H is upper
-*> quasi-triangular in rows and columns ILO:IHI, with any
-*> 2-by-2 diagonal blocks in standard form. If INFO is zero
-*> and WANTT is .FALSE., the contents of H are unspecified on
-*> exit. The output state of H if INFO is nonzero is given
-*> below under the description of INFO.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION array, dimension (N)
-*> The real and imaginary parts, respectively, of the computed
-*> eigenvalues ILO to IHI are stored in the corresponding
-*> elements of WR and WI. If two eigenvalues are computed as a
-*> complex conjugate pair, they are stored in consecutive
-*> elements of WR and WI, say the i-th and (i+1)th, with
-*> WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the
-*> eigenvalues are stored in the same order as on the diagonal
-*> of the Schur form returned in H, with WR(i) = H(i,i), and, if
-*> H(i:i+1,i:i+1) is a 2-by-2 diagonal block,
-*> WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i).
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE..
-*> 1 <= ILOZ <= ILO; IHI <= IHIZ <= N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,N)
-*> If WANTZ is .TRUE., on entry Z must contain the current
-*> matrix Z of transformations accumulated by DHSEQR, and on
-*> exit Z has been updated; transformations are applied only to
-*> the submatrix Z(ILOZ:IHIZ,ILO:IHI).
-*> If WANTZ is .FALSE., Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. LDZ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> .GT. 0: If INFO = i, DLAHQR failed to compute all the
-*> eigenvalues ILO to IHI in a total of 30 iterations
-*> per eigenvalue; elements i+1:ihi of WR and WI
-*> contain those eigenvalues which have been
-*> successfully computed.
-*>
-*> If INFO .GT. 0 and WANTT is .FALSE., then on exit,
-*> the remaining unconverged eigenvalues are the
-*> eigenvalues of the upper Hessenberg matrix rows
-*> and columns ILO thorugh INFO of the final, output
-*> value of H.
-*>
-*> If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*> (*) (initial value of H)*U = U*(final value of H)
-*> where U is an orthognal matrix. The final
-*> value of H is upper Hessenberg and triangular in
-*> rows and columns INFO+1 through IHI.
-*>
-*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*> (final value of Z) = (initial value of Z)*U
-*> where U is the orthogonal matrix in (*)
-*> (regardless of the value of WANTT.)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> 02-96 Based on modifications by
-*> David Day, Sandia National Laboratory, USA
-*>
-*> 12-04 Further modifications by
-*> Ralph Byers, University of Kansas, USA
-*> This is a modified version of DLAHQR from LAPACK version 3.0.
-*> It is (1) more robust against overflow and underflow and
-*> (2) adopts the more conservative Ahues & Tisseur stopping
-*> criterion (LAWN 122, 1997).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
- $ ILOZ, IHIZ, Z, LDZ, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), WI( * ), WR( * ), Z( LDZ, * )
-* ..
-*
-* =========================================================
-*
-* .. Parameters ..
- INTEGER ITMAX
- PARAMETER ( ITMAX = 30 )
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0, TWO = 2.0d0 )
- DOUBLE PRECISION DAT1, DAT2
- PARAMETER ( DAT1 = 3.0d0 / 4.0d0, DAT2 = -0.4375d0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AA, AB, BA, BB, CS, DET, H11, H12, H21, H21S,
- $ H22, RT1I, RT1R, RT2I, RT2R, RTDISC, S, SAFMAX,
- $ SAFMIN, SMLNUM, SN, SUM, T1, T2, T3, TR, TST,
- $ ULP, V2, V3
- INTEGER I, I1, I2, ITS, J, K, L, M, NH, NR, NZ
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION V( 3 )
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLABAD, DLANV2, DLARFG, DROT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
- IF( ILO.EQ.IHI ) THEN
- WR( ILO ) = H( ILO, ILO )
- WI( ILO ) = ZERO
- RETURN
- END IF
-*
-* ==== clear out the trash ====
- DO 10 J = ILO, IHI - 3
- H( J+2, J ) = ZERO
- H( J+3, J ) = ZERO
- 10 CONTINUE
- IF( ILO.LE.IHI-2 )
- $ H( IHI, IHI-2 ) = ZERO
-*
- NH = IHI - ILO + 1
- NZ = IHIZ - ILOZ + 1
-*
-* Set machine-dependent constants for the stopping criterion.
-*
- SAFMIN = DLAMCH( 'SAFE MINIMUM' )
- SAFMAX = ONE / SAFMIN
- CALL DLABAD( SAFMIN, SAFMAX )
- ULP = DLAMCH( 'PRECISION' )
- SMLNUM = SAFMIN*( DBLE( NH ) / ULP )
-*
-* I1 and I2 are the indices of the first row and last column of H
-* to which transformations must be applied. If eigenvalues only are
-* being computed, I1 and I2 are set inside the main loop.
-*
- IF( WANTT ) THEN
- I1 = 1
- I2 = N
- END IF
-*
-* The main loop begins here. I is the loop index and decreases from
-* IHI to ILO in steps of 1 or 2. Each iteration of the loop works
-* with the active submatrix in rows and columns L to I.
-* Eigenvalues I+1 to IHI have already converged. Either L = ILO or
-* H(L,L-1) is negligible so that the matrix splits.
-*
- I = IHI
- 20 CONTINUE
- L = ILO
- IF( I.LT.ILO )
- $ GO TO 160
-*
-* Perform QR iterations on rows and columns ILO to I until a
-* submatrix of order 1 or 2 splits off at the bottom because a
-* subdiagonal element has become negligible.
-*
- DO 140 ITS = 0, ITMAX
-*
-* Look for a single small subdiagonal element.
-*
- DO 30 K = I, L + 1, -1
- IF( ABS( H( K, K-1 ) ).LE.SMLNUM )
- $ GO TO 40
- TST = ABS( H( K-1, K-1 ) ) + ABS( H( K, K ) )
- IF( TST.EQ.ZERO ) THEN
- IF( K-2.GE.ILO )
- $ TST = TST + ABS( H( K-1, K-2 ) )
- IF( K+1.LE.IHI )
- $ TST = TST + ABS( H( K+1, K ) )
- END IF
-* ==== The following is a conservative small subdiagonal
-* . deflation criterion due to Ahues & Tisseur (LAWN 122,
-* . 1997). It has better mathematical foundation and
-* . improves accuracy in some cases. ====
- IF( ABS( H( K, K-1 ) ).LE.ULP*TST ) THEN
- AB = MAX( ABS( H( K, K-1 ) ), ABS( H( K-1, K ) ) )
- BA = MIN( ABS( H( K, K-1 ) ), ABS( H( K-1, K ) ) )
- AA = MAX( ABS( H( K, K ) ),
- $ ABS( H( K-1, K-1 )-H( K, K ) ) )
- BB = MIN( ABS( H( K, K ) ),
- $ ABS( H( K-1, K-1 )-H( K, K ) ) )
- S = AA + AB
- IF( BA*( AB / S ).LE.MAX( SMLNUM,
- $ ULP*( BB*( AA / S ) ) ) )GO TO 40
- END IF
- 30 CONTINUE
- 40 CONTINUE
- L = K
- IF( L.GT.ILO ) THEN
-*
-* H(L,L-1) is negligible
-*
- H( L, L-1 ) = ZERO
- END IF
-*
-* Exit from loop if a submatrix of order 1 or 2 has split off.
-*
- IF( L.GE.I-1 )
- $ GO TO 150
-*
-* Now the active submatrix is in rows and columns L to I. If
-* eigenvalues only are being computed, only the active submatrix
-* need be transformed.
-*
- IF( .NOT.WANTT ) THEN
- I1 = L
- I2 = I
- END IF
-*
- IF( ITS.EQ.10 ) THEN
-*
-* Exceptional shift.
-*
- S = ABS( H( L+1, L ) ) + ABS( H( L+2, L+1 ) )
- H11 = DAT1*S + H( L, L )
- H12 = DAT2*S
- H21 = S
- H22 = H11
- ELSE IF( ITS.EQ.20 ) THEN
-*
-* Exceptional shift.
-*
- S = ABS( H( I, I-1 ) ) + ABS( H( I-1, I-2 ) )
- H11 = DAT1*S + H( I, I )
- H12 = DAT2*S
- H21 = S
- H22 = H11
- ELSE
-*
-* Prepare to use Francis' double shift
-* (i.e. 2nd degree generalized Rayleigh quotient)
-*
- H11 = H( I-1, I-1 )
- H21 = H( I, I-1 )
- H12 = H( I-1, I )
- H22 = H( I, I )
- END IF
- S = ABS( H11 ) + ABS( H12 ) + ABS( H21 ) + ABS( H22 )
- IF( S.EQ.ZERO ) THEN
- RT1R = ZERO
- RT1I = ZERO
- RT2R = ZERO
- RT2I = ZERO
- ELSE
- H11 = H11 / S
- H21 = H21 / S
- H12 = H12 / S
- H22 = H22 / S
- TR = ( H11+H22 ) / TWO
- DET = ( H11-TR )*( H22-TR ) - H12*H21
- RTDISC = SQRT( ABS( DET ) )
- IF( DET.GE.ZERO ) THEN
-*
-* ==== complex conjugate shifts ====
-*
- RT1R = TR*S
- RT2R = RT1R
- RT1I = RTDISC*S
- RT2I = -RT1I
- ELSE
-*
-* ==== real shifts (use only one of them) ====
-*
- RT1R = TR + RTDISC
- RT2R = TR - RTDISC
- IF( ABS( RT1R-H22 ).LE.ABS( RT2R-H22 ) ) THEN
- RT1R = RT1R*S
- RT2R = RT1R
- ELSE
- RT2R = RT2R*S
- RT1R = RT2R
- END IF
- RT1I = ZERO
- RT2I = ZERO
- END IF
- END IF
-*
-* Look for two consecutive small subdiagonal elements.
-*
- DO 50 M = I - 2, L, -1
-* Determine the effect of starting the double-shift QR
-* iteration at row M, and see if this would make H(M,M-1)
-* negligible. (The following uses scaling to avoid
-* overflows and most underflows.)
-*
- H21S = H( M+1, M )
- S = ABS( H( M, M )-RT2R ) + ABS( RT2I ) + ABS( H21S )
- H21S = H( M+1, M ) / S
- V( 1 ) = H21S*H( M, M+1 ) + ( H( M, M )-RT1R )*
- $ ( ( H( M, M )-RT2R ) / S ) - RT1I*( RT2I / S )
- V( 2 ) = H21S*( H( M, M )+H( M+1, M+1 )-RT1R-RT2R )
- V( 3 ) = H21S*H( M+2, M+1 )
- S = ABS( V( 1 ) ) + ABS( V( 2 ) ) + ABS( V( 3 ) )
- V( 1 ) = V( 1 ) / S
- V( 2 ) = V( 2 ) / S
- V( 3 ) = V( 3 ) / S
- IF( M.EQ.L )
- $ GO TO 60
- IF( ABS( H( M, M-1 ) )*( ABS( V( 2 ) )+ABS( V( 3 ) ) ).LE.
- $ ULP*ABS( V( 1 ) )*( ABS( H( M-1, M-1 ) )+ABS( H( M,
- $ M ) )+ABS( H( M+1, M+1 ) ) ) )GO TO 60
- 50 CONTINUE
- 60 CONTINUE
-*
-* Double-shift QR step
-*
- DO 130 K = M, I - 1
-*
-* The first iteration of this loop determines a reflection G
-* from the vector V and applies it from left and right to H,
-* thus creating a nonzero bulge below the subdiagonal.
-*
-* Each subsequent iteration determines a reflection G to
-* restore the Hessenberg form in the (K-1)th column, and thus
-* chases the bulge one step toward the bottom of the active
-* submatrix. NR is the order of G.
-*
- NR = MIN( 3, I-K+1 )
- IF( K.GT.M )
- $ CALL DCOPY( NR, H( K, K-1 ), 1, V, 1 )
- CALL DLARFG( NR, V( 1 ), V( 2 ), 1, T1 )
- IF( K.GT.M ) THEN
- H( K, K-1 ) = V( 1 )
- H( K+1, K-1 ) = ZERO
- IF( K.LT.I-1 )
- $ H( K+2, K-1 ) = ZERO
- ELSE IF( M.GT.L ) THEN
-* ==== Use the following instead of
-* . H( K, K-1 ) = -H( K, K-1 ) to
-* . avoid a bug when v(2) and v(3)
-* . underflow. ====
- H( K, K-1 ) = H( K, K-1 )*( ONE-T1 )
- END IF
- V2 = V( 2 )
- T2 = T1*V2
- IF( NR.EQ.3 ) THEN
- V3 = V( 3 )
- T3 = T1*V3
-*
-* Apply G from the left to transform the rows of the matrix
-* in columns K to I2.
-*
- DO 70 J = K, I2
- SUM = H( K, J ) + V2*H( K+1, J ) + V3*H( K+2, J )
- H( K, J ) = H( K, J ) - SUM*T1
- H( K+1, J ) = H( K+1, J ) - SUM*T2
- H( K+2, J ) = H( K+2, J ) - SUM*T3
- 70 CONTINUE
-*
-* Apply G from the right to transform the columns of the
-* matrix in rows I1 to min(K+3,I).
-*
- DO 80 J = I1, MIN( K+3, I )
- SUM = H( J, K ) + V2*H( J, K+1 ) + V3*H( J, K+2 )
- H( J, K ) = H( J, K ) - SUM*T1
- H( J, K+1 ) = H( J, K+1 ) - SUM*T2
- H( J, K+2 ) = H( J, K+2 ) - SUM*T3
- 80 CONTINUE
-*
- IF( WANTZ ) THEN
-*
-* Accumulate transformations in the matrix Z
-*
- DO 90 J = ILOZ, IHIZ
- SUM = Z( J, K ) + V2*Z( J, K+1 ) + V3*Z( J, K+2 )
- Z( J, K ) = Z( J, K ) - SUM*T1
- Z( J, K+1 ) = Z( J, K+1 ) - SUM*T2
- Z( J, K+2 ) = Z( J, K+2 ) - SUM*T3
- 90 CONTINUE
- END IF
- ELSE IF( NR.EQ.2 ) THEN
-*
-* Apply G from the left to transform the rows of the matrix
-* in columns K to I2.
-*
- DO 100 J = K, I2
- SUM = H( K, J ) + V2*H( K+1, J )
- H( K, J ) = H( K, J ) - SUM*T1
- H( K+1, J ) = H( K+1, J ) - SUM*T2
- 100 CONTINUE
-*
-* Apply G from the right to transform the columns of the
-* matrix in rows I1 to min(K+3,I).
-*
- DO 110 J = I1, I
- SUM = H( J, K ) + V2*H( J, K+1 )
- H( J, K ) = H( J, K ) - SUM*T1
- H( J, K+1 ) = H( J, K+1 ) - SUM*T2
- 110 CONTINUE
-*
- IF( WANTZ ) THEN
-*
-* Accumulate transformations in the matrix Z
-*
- DO 120 J = ILOZ, IHIZ
- SUM = Z( J, K ) + V2*Z( J, K+1 )
- Z( J, K ) = Z( J, K ) - SUM*T1
- Z( J, K+1 ) = Z( J, K+1 ) - SUM*T2
- 120 CONTINUE
- END IF
- END IF
- 130 CONTINUE
-*
- 140 CONTINUE
-*
-* Failure to converge in remaining number of iterations
-*
- INFO = I
- RETURN
-*
- 150 CONTINUE
-*
- IF( L.EQ.I ) THEN
-*
-* H(I,I-1) is negligible: one eigenvalue has converged.
-*
- WR( I ) = H( I, I )
- WI( I ) = ZERO
- ELSE IF( L.EQ.I-1 ) THEN
-*
-* H(I-1,I-2) is negligible: a pair of eigenvalues have converged.
-*
-* Transform the 2-by-2 submatrix to standard Schur form,
-* and compute and store the eigenvalues.
-*
- CALL DLANV2( H( I-1, I-1 ), H( I-1, I ), H( I, I-1 ),
- $ H( I, I ), WR( I-1 ), WI( I-1 ), WR( I ), WI( I ),
- $ CS, SN )
-*
- IF( WANTT ) THEN
-*
-* Apply the transformation to the rest of H.
-*
- IF( I2.GT.I )
- $ CALL DROT( I2-I, H( I-1, I+1 ), LDH, H( I, I+1 ), LDH,
- $ CS, SN )
- CALL DROT( I-I1-1, H( I1, I-1 ), 1, H( I1, I ), 1, CS, SN )
- END IF
- IF( WANTZ ) THEN
-*
-* Apply the transformation to Z.
-*
- CALL DROT( NZ, Z( ILOZ, I-1 ), 1, Z( ILOZ, I ), 1, CS, SN )
- END IF
- END IF
-*
-* return to start of the main loop with new value of I.
-*
- I = L - 1
- GO TO 20
-*
- 160 CONTINUE
- RETURN
-*
-* End of DLAHQR
-*
- END
diff --git a/mtx/lapack_src/dlahr2.f b/mtx/lapack_src/dlahr2.f
deleted file mode 100644
index 31ea1bb0e..000000000
--- a/mtx/lapack_src/dlahr2.f
+++ /dev/null
@@ -1,326 +0,0 @@
-*> \brief \b DLAHR2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAHR2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
-*
-* .. Scalar Arguments ..
-* INTEGER K, LDA, LDT, LDY, N, NB
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), T( LDT, NB ), TAU( NB ),
-* $ Y( LDY, NB )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The offset for the reduction. Elements below the k-th
-*> subdiagonal in the first NB columns are reduced to zero.
-*> K < N.
-*> \endverbatim
-*>
-*> \param[in] NB
-*> \verbatim
-*> NB is INTEGER
-*> The number of columns to be reduced.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N-K+1)
-*> On entry, the n-by-(n-k+1) general matrix A.
-*> On exit, the elements on and above the k-th subdiagonal in
-*> the first NB columns are overwritten with the corresponding
-*> elements of the reduced matrix; the elements below the k-th
-*> subdiagonal, with the array TAU, represent the matrix Q as a
-*> product of elementary reflectors. The other columns of A are
-*> unchanged. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (NB)
-*> The scalar factors of the elementary reflectors. See Further
-*> Details.
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,NB)
-*> The upper triangular matrix T.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= NB.
-*> \endverbatim
-*>
-*> \param[out] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION array, dimension (LDY,NB)
-*> The n-by-nb matrix Y.
-*> \endverbatim
-*>
-*> \param[in] LDY
-*> \verbatim
-*> LDY is INTEGER
-*> The leading dimension of the array Y. LDY >= N.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The matrix Q is represented as a product of nb elementary reflectors
-*>
-*> Q = H(1) H(2) . . . H(nb).
-*>
-*> Each H(i) has the form
-*>
-*> H(i) = I - tau * v * v**T
-*>
-*> where tau is a real scalar, and v is a real vector with
-*> v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
-*> A(i+k+1:n,i), and tau in TAU(i).
-*>
-*> The elements of the vectors v together form the (n-k+1)-by-nb matrix
-*> V which is needed, with T and Y, to apply the transformation to the
-*> unreduced part of the matrix, using an update of the form:
-*> A := (I - V*T*V**T) * (A - Y*V**T).
-*>
-*> The contents of A on exit are illustrated by the following example
-*> with n = 7, k = 3 and nb = 2:
-*>
-*> ( a a a a a )
-*> ( a a a a a )
-*> ( a a a a a )
-*> ( h h a a a )
-*> ( v1 h a a a )
-*> ( v1 v2 a a a )
-*> ( v1 v2 a a a )
-*>
-*> where a denotes an element of the original matrix A, h denotes a
-*> modified element of the upper Hessenberg matrix H, and vi denotes an
-*> element of the vector defining H(i).
-*>
-*> This subroutine is a slight modification of LAPACK-3.0's DLAHRD
-*> incorporating improvements proposed by Quintana-Orti and Van de
-*> Gejin. Note that the entries of A(1:K,2:NB) differ from those
-*> returned by the original LAPACK-3.0's DLAHRD routine. (This
-*> subroutine is not backward compatible with LAPACK-3.0's DLAHRD.)
-*> \endverbatim
-*
-*> \par References:
-* ================
-*>
-*> Gregorio Quintana-Orti and Robert van de Geijn, "Improving the
-*> performance of reduction to Hessenberg form," ACM Transactions on
-*> Mathematical Software, 32(2):180-194, June 2006.
-*>
-* =====================================================================
- SUBROUTINE DLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER K, LDA, LDT, LDY, N, NB
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), T( LDT, NB ), TAU( NB ),
- $ Y( LDY, NB )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0,
- $ ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION EI
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGEMM, DGEMV, DLACPY,
- $ DLARFG, DSCAL, DTRMM, DTRMV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.1 )
- $ RETURN
-*
- DO 10 I = 1, NB
- IF( I.GT.1 ) THEN
-*
-* Update A(K+1:N,I)
-*
-* Update I-th column of A - Y * V**T
-*
- CALL DGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1), LDY,
- $ A( K+I-1, 1 ), LDA, ONE, A( K+1, I ), 1 )
-*
-* Apply I - V * T**T * V**T to this column (call it b) from the
-* left, using the last column of T as workspace
-*
-* Let V = ( V1 ) and b = ( b1 ) (first I-1 rows)
-* ( V2 ) ( b2 )
-*
-* where V1 is unit lower triangular
-*
-* w := V1**T * b1
-*
- CALL DCOPY( I-1, A( K+1, I ), 1, T( 1, NB ), 1 )
- CALL DTRMV( 'Lower', 'Transpose', 'UNIT',
- $ I-1, A( K+1, 1 ),
- $ LDA, T( 1, NB ), 1 )
-*
-* w := w + V2**T * b2
-*
- CALL DGEMV( 'Transpose', N-K-I+1, I-1,
- $ ONE, A( K+I, 1 ),
- $ LDA, A( K+I, I ), 1, ONE, T( 1, NB ), 1 )
-*
-* w := T**T * w
-*
- CALL DTRMV( 'Upper', 'Transpose', 'NON-UNIT',
- $ I-1, T, LDT,
- $ T( 1, NB ), 1 )
-*
-* b2 := b2 - V2*w
-*
- CALL DGEMV( 'NO TRANSPOSE', N-K-I+1, I-1, -ONE,
- $ A( K+I, 1 ),
- $ LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 )
-*
-* b1 := b1 - V1*w
-*
- CALL DTRMV( 'Lower', 'NO TRANSPOSE',
- $ 'UNIT', I-1,
- $ A( K+1, 1 ), LDA, T( 1, NB ), 1 )
- CALL DAXPY( I-1, -ONE, T( 1, NB ), 1, A( K+1, I ), 1 )
-*
- A( K+I-1, I-1 ) = EI
- END IF
-*
-* Generate the elementary reflector H(I) to annihilate
-* A(K+I+1:N,I)
-*
- CALL DLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), 1,
- $ TAU( I ) )
- EI = A( K+I, I )
- A( K+I, I ) = ONE
-*
-* Compute Y(K+1:N,I)
-*
- CALL DGEMV( 'NO TRANSPOSE', N-K, N-K-I+1,
- $ ONE, A( K+1, I+1 ),
- $ LDA, A( K+I, I ), 1, ZERO, Y( K+1, I ), 1 )
- CALL DGEMV( 'Transpose', N-K-I+1, I-1,
- $ ONE, A( K+I, 1 ), LDA,
- $ A( K+I, I ), 1, ZERO, T( 1, I ), 1 )
- CALL DGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE,
- $ Y( K+1, 1 ), LDY,
- $ T( 1, I ), 1, ONE, Y( K+1, I ), 1 )
- CALL DSCAL( N-K, TAU( I ), Y( K+1, I ), 1 )
-*
-* Compute T(1:I,I)
-*
- CALL DSCAL( I-1, -TAU( I ), T( 1, I ), 1 )
- CALL DTRMV( 'Upper', 'No Transpose', 'NON-UNIT',
- $ I-1, T, LDT,
- $ T( 1, I ), 1 )
- T( I, I ) = TAU( I )
-*
- 10 CONTINUE
- A( K+NB, NB ) = EI
-*
-* Compute Y(1:K,1:NB)
-*
- CALL DLACPY( 'ALL', K, NB, A( 1, 2 ), LDA, Y, LDY )
- CALL DTRMM( 'RIGHT', 'Lower', 'NO TRANSPOSE',
- $ 'UNIT', K, NB,
- $ ONE, A( K+1, 1 ), LDA, Y, LDY )
- IF( N.GT.K+NB )
- $ CALL DGEMM( 'NO TRANSPOSE', 'NO TRANSPOSE', K,
- $ NB, N-K-NB, ONE,
- $ A( 1, 2+NB ), LDA, A( K+1+NB, 1 ), LDA, ONE, Y,
- $ LDY )
- CALL DTRMM( 'RIGHT', 'Upper', 'NO TRANSPOSE',
- $ 'NON-UNIT', K, NB,
- $ ONE, T, LDT, Y, LDY )
-*
- RETURN
-*
-* End of DLAHR2
-*
- END
diff --git a/mtx/lapack_src/dlaisnan.f b/mtx/lapack_src/dlaisnan.f
deleted file mode 100644
index c3cd27803..000000000
--- a/mtx/lapack_src/dlaisnan.f
+++ /dev/null
@@ -1,91 +0,0 @@
-*> \brief \b DLAISNAN
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAISNAN + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* LOGICAL FUNCTION DLAISNAN( DIN1, DIN2 )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION DIN1, DIN2
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] DIN1
-*> \verbatim
-*> DIN1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] DIN2
-*> \verbatim
-*> DIN2 is DOUBLE PRECISION
-*> Two numbers to compare for inequality.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- LOGICAL FUNCTION DLAISNAN( DIN1, DIN2 )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION DIN1, DIN2
-* ..
-*
-* =====================================================================
-*
-* .. Executable Statements ..
- DLAISNAN = (DIN1.NE.DIN2)
- RETURN
- END
diff --git a/mtx/lapack_src/dlaln2.f b/mtx/lapack_src/dlaln2.f
deleted file mode 100644
index f20624c87..000000000
--- a/mtx/lapack_src/dlaln2.f
+++ /dev/null
@@ -1,611 +0,0 @@
-*> \brief \b DLALN2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLALN2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLALN2( LTRANS, NA, NW, SMIN, CA, A, LDA, D1, D2, B,
-* LDB, WR, WI, X, LDX, SCALE, XNORM, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL LTRANS
-* INTEGER INFO, LDA, LDB, LDX, NA, NW
-* DOUBLE PRECISION CA, D1, D2, SCALE, SMIN, WI, WR, XNORM
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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 (.LE. 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.)
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] LTRANS
-*> \verbatim
-*> LTRANS is LOGICAL
-*> =.TRUE.: A-transpose will be used.
-*> =.FALSE.: A will be used (not transposed.)
-*> \endverbatim
-*>
-*> \param[in] NA
-*> \verbatim
-*> NA is INTEGER
-*> The size of the matrix A. It may (only) be 1 or 2.
-*> \endverbatim
-*>
-*> \param[in] NW
-*> \verbatim
-*> NW is INTEGER
-*> 1 if "w" is real, 2 if "w" is complex. It may only be 1
-*> or 2.
-*> \endverbatim
-*>
-*> \param[in] SMIN
-*> \verbatim
-*> SMIN is DOUBLE PRECISION
-*> The desired lower bound on the singular values of A. This
-*> should be a safe distance away from underflow or overflow,
-*> say, between (underflow/machine precision) and (machine
-*> precision * overflow ). (See BIGNUM and ULP.)
-*> \endverbatim
-*>
-*> \param[in] CA
-*> \verbatim
-*> CA is DOUBLE PRECISION
-*> The coefficient c, which A is multiplied by.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,NA)
-*> The NA x NA matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of A. It must be at least NA.
-*> \endverbatim
-*>
-*> \param[in] D1
-*> \verbatim
-*> D1 is DOUBLE PRECISION
-*> The 1,1 element in the diagonal matrix D.
-*> \endverbatim
-*>
-*> \param[in] D2
-*> \verbatim
-*> D2 is DOUBLE PRECISION
-*> The 2,2 element in the diagonal matrix D. Not used if NW=1.
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NW)
-*> The NA x NW matrix B (right-hand side). If NW=2 ("w" is
-*> complex), column 1 contains the real part of B and column 2
-*> contains the imaginary part.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of B. It must be at least NA.
-*> \endverbatim
-*>
-*> \param[in] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION
-*> The real part of the scalar "w".
-*> \endverbatim
-*>
-*> \param[in] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION
-*> The imaginary part of the scalar "w". Not used if NW=1.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,NW)
-*> The NA x NW matrix X (unknowns), as computed by DLALN2.
-*> If NW=2 ("w" is complex), on exit, column 1 will contain
-*> the real part of X and column 2 will contain the imaginary
-*> part.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of X. It must be at least NA.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> The scale factor that B must be multiplied by to insure
-*> that overflow does not occur when computing X. Thus,
-*> (ca A - w D) X will be SCALE*B, not B (ignoring
-*> perturbations of A.) It will be at most 1.
-*> \endverbatim
-*>
-*> \param[out] XNORM
-*> \verbatim
-*> XNORM is DOUBLE PRECISION
-*> The infinity-norm of X, when X is regarded as an NA x NW
-*> real matrix.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> An error flag. It will be set to zero if no error occurs,
-*> a negative number if an argument is in error, or a positive
-*> number if ca A - w D had to be perturbed.
-*> The possible values are:
-*> = 0: No error occurred, and (ca A - w D) did not have to be
-*> perturbed.
-*> = 1: (ca A - w D) had to be perturbed to make its smallest
-*> (or only) singular value greater than SMIN.
-*> NOTE: In the interests of speed, this routine does not
-*> check the inputs for errors.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLALN2( LTRANS, NA, NW, SMIN, CA, A, LDA, D1, D2, B,
- $ LDB, WR, WI, X, LDX, SCALE, XNORM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- LOGICAL LTRANS
- INTEGER INFO, LDA, LDB, LDX, NA, NW
- DOUBLE PRECISION CA, D1, D2, SCALE, SMIN, WI, WR, XNORM
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER ICMAX, J
- DOUBLE PRECISION BBND, BI1, BI2, BIGNUM, BNORM, BR1, BR2, CI21,
- $ CI22, CMAX, CNORM, CR21, CR22, CSI, CSR, LI21,
- $ LR21, SMINI, SMLNUM, TEMP, U22ABS, UI11, UI11R,
- $ UI12, UI12S, UI22, UR11, UR11R, UR12, UR12S,
- $ UR22, XI1, XI2, XR1, XR2
-* ..
-* .. Local Arrays ..
- LOGICAL RSWAP( 4 ), ZSWAP( 4 )
- INTEGER IPIVOT( 4, 4 )
- DOUBLE PRECISION CI( 2, 2 ), CIV( 4 ), CR( 2, 2 ), CRV( 4 )
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DLADIV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Equivalences ..
- EQUIVALENCE ( CI( 1, 1 ), CIV( 1 ) ),
- $ ( CR( 1, 1 ), CRV( 1 ) )
-* ..
-* .. Data statements ..
- DATA ZSWAP / .FALSE., .FALSE., .TRUE., .TRUE. /
- DATA RSWAP / .FALSE., .TRUE., .FALSE., .TRUE. /
- DATA IPIVOT / 1, 2, 3, 4, 2, 1, 4, 3, 3, 4, 1, 2, 4,
- $ 3, 2, 1 /
-* ..
-* .. Executable Statements ..
-*
-* Compute BIGNUM
-*
- SMLNUM = TWO*DLAMCH( 'Safe minimum' )
- BIGNUM = ONE / SMLNUM
- SMINI = MAX( SMIN, SMLNUM )
-*
-* Don't check for input errors
-*
- INFO = 0
-*
-* Standard Initializations
-*
- SCALE = ONE
-*
- IF( NA.EQ.1 ) THEN
-*
-* 1 x 1 (i.e., scalar) system C X = B
-*
- IF( NW.EQ.1 ) THEN
-*
-* Real 1x1 system.
-*
-* C = ca A - w D
-*
- CSR = CA*A( 1, 1 ) - WR*D1
- CNORM = ABS( CSR )
-*
-* If | C | < SMINI, use C = SMINI
-*
- IF( CNORM.LT.SMINI ) THEN
- CSR = SMINI
- CNORM = SMINI
- INFO = 1
- END IF
-*
-* Check scaling for X = B / C
-*
- BNORM = ABS( B( 1, 1 ) )
- IF( CNORM.LT.ONE .AND. BNORM.GT.ONE ) THEN
- IF( BNORM.GT.BIGNUM*CNORM )
- $ SCALE = ONE / BNORM
- END IF
-*
-* Compute X
-*
- X( 1, 1 ) = ( B( 1, 1 )*SCALE ) / CSR
- XNORM = ABS( X( 1, 1 ) )
- ELSE
-*
-* Complex 1x1 system (w is complex)
-*
-* C = ca A - w D
-*
- CSR = CA*A( 1, 1 ) - WR*D1
- CSI = -WI*D1
- CNORM = ABS( CSR ) + ABS( CSI )
-*
-* If | C | < SMINI, use C = SMINI
-*
- IF( CNORM.LT.SMINI ) THEN
- CSR = SMINI
- CSI = ZERO
- CNORM = SMINI
- INFO = 1
- END IF
-*
-* Check scaling for X = B / C
-*
- BNORM = ABS( B( 1, 1 ) ) + ABS( B( 1, 2 ) )
- IF( CNORM.LT.ONE .AND. BNORM.GT.ONE ) THEN
- IF( BNORM.GT.BIGNUM*CNORM )
- $ SCALE = ONE / BNORM
- END IF
-*
-* Compute X
-*
- CALL DLADIV( SCALE*B( 1, 1 ), SCALE*B( 1, 2 ), CSR, CSI,
- $ X( 1, 1 ), X( 1, 2 ) )
- XNORM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) )
- END IF
-*
- ELSE
-*
-* 2x2 System
-*
-* Compute the real part of C = ca A - w D (or ca A**T - w D )
-*
- CR( 1, 1 ) = CA*A( 1, 1 ) - WR*D1
- CR( 2, 2 ) = CA*A( 2, 2 ) - WR*D2
- IF( LTRANS ) THEN
- CR( 1, 2 ) = CA*A( 2, 1 )
- CR( 2, 1 ) = CA*A( 1, 2 )
- ELSE
- CR( 2, 1 ) = CA*A( 2, 1 )
- CR( 1, 2 ) = CA*A( 1, 2 )
- END IF
-*
- IF( NW.EQ.1 ) THEN
-*
-* Real 2x2 system (w is real)
-*
-* Find the largest element in C
-*
- CMAX = ZERO
- ICMAX = 0
-*
- DO 10 J = 1, 4
- IF( ABS( CRV( J ) ).GT.CMAX ) THEN
- CMAX = ABS( CRV( J ) )
- ICMAX = J
- END IF
- 10 CONTINUE
-*
-* If norm(C) < SMINI, use SMINI*identity.
-*
- IF( CMAX.LT.SMINI ) THEN
- BNORM = MAX( ABS( B( 1, 1 ) ), ABS( B( 2, 1 ) ) )
- IF( SMINI.LT.ONE .AND. BNORM.GT.ONE ) THEN
- IF( BNORM.GT.BIGNUM*SMINI )
- $ SCALE = ONE / BNORM
- END IF
- TEMP = SCALE / SMINI
- X( 1, 1 ) = TEMP*B( 1, 1 )
- X( 2, 1 ) = TEMP*B( 2, 1 )
- XNORM = TEMP*BNORM
- INFO = 1
- RETURN
- END IF
-*
-* Gaussian elimination with complete pivoting.
-*
- UR11 = CRV( ICMAX )
- CR21 = CRV( IPIVOT( 2, ICMAX ) )
- UR12 = CRV( IPIVOT( 3, ICMAX ) )
- CR22 = CRV( IPIVOT( 4, ICMAX ) )
- UR11R = ONE / UR11
- LR21 = UR11R*CR21
- UR22 = CR22 - UR12*LR21
-*
-* If smaller pivot < SMINI, use SMINI
-*
- IF( ABS( UR22 ).LT.SMINI ) THEN
- UR22 = SMINI
- INFO = 1
- END IF
- IF( RSWAP( ICMAX ) ) THEN
- BR1 = B( 2, 1 )
- BR2 = B( 1, 1 )
- ELSE
- BR1 = B( 1, 1 )
- BR2 = B( 2, 1 )
- END IF
- BR2 = BR2 - LR21*BR1
- BBND = MAX( ABS( BR1*( UR22*UR11R ) ), ABS( BR2 ) )
- IF( BBND.GT.ONE .AND. ABS( UR22 ).LT.ONE ) THEN
- IF( BBND.GE.BIGNUM*ABS( UR22 ) )
- $ SCALE = ONE / BBND
- END IF
-*
- XR2 = ( BR2*SCALE ) / UR22
- XR1 = ( SCALE*BR1 )*UR11R - XR2*( UR11R*UR12 )
- IF( ZSWAP( ICMAX ) ) THEN
- X( 1, 1 ) = XR2
- X( 2, 1 ) = XR1
- ELSE
- X( 1, 1 ) = XR1
- X( 2, 1 ) = XR2
- END IF
- XNORM = MAX( ABS( XR1 ), ABS( XR2 ) )
-*
-* Further scaling if norm(A) norm(X) > overflow
-*
- IF( XNORM.GT.ONE .AND. CMAX.GT.ONE ) THEN
- IF( XNORM.GT.BIGNUM / CMAX ) THEN
- TEMP = CMAX / BIGNUM
- X( 1, 1 ) = TEMP*X( 1, 1 )
- X( 2, 1 ) = TEMP*X( 2, 1 )
- XNORM = TEMP*XNORM
- SCALE = TEMP*SCALE
- END IF
- END IF
- ELSE
-*
-* Complex 2x2 system (w is complex)
-*
-* Find the largest element in C
-*
- CI( 1, 1 ) = -WI*D1
- CI( 2, 1 ) = ZERO
- CI( 1, 2 ) = ZERO
- CI( 2, 2 ) = -WI*D2
- CMAX = ZERO
- ICMAX = 0
-*
- DO 20 J = 1, 4
- IF( ABS( CRV( J ) )+ABS( CIV( J ) ).GT.CMAX ) THEN
- CMAX = ABS( CRV( J ) ) + ABS( CIV( J ) )
- ICMAX = J
- END IF
- 20 CONTINUE
-*
-* If norm(C) < SMINI, use SMINI*identity.
-*
- IF( CMAX.LT.SMINI ) THEN
- BNORM = MAX( ABS( B( 1, 1 ) )+ABS( B( 1, 2 ) ),
- $ ABS( B( 2, 1 ) )+ABS( B( 2, 2 ) ) )
- IF( SMINI.LT.ONE .AND. BNORM.GT.ONE ) THEN
- IF( BNORM.GT.BIGNUM*SMINI )
- $ SCALE = ONE / BNORM
- END IF
- TEMP = SCALE / SMINI
- X( 1, 1 ) = TEMP*B( 1, 1 )
- X( 2, 1 ) = TEMP*B( 2, 1 )
- X( 1, 2 ) = TEMP*B( 1, 2 )
- X( 2, 2 ) = TEMP*B( 2, 2 )
- XNORM = TEMP*BNORM
- INFO = 1
- RETURN
- END IF
-*
-* Gaussian elimination with complete pivoting.
-*
- UR11 = CRV( ICMAX )
- UI11 = CIV( ICMAX )
- CR21 = CRV( IPIVOT( 2, ICMAX ) )
- CI21 = CIV( IPIVOT( 2, ICMAX ) )
- UR12 = CRV( IPIVOT( 3, ICMAX ) )
- UI12 = CIV( IPIVOT( 3, ICMAX ) )
- CR22 = CRV( IPIVOT( 4, ICMAX ) )
- CI22 = CIV( IPIVOT( 4, ICMAX ) )
- IF( ICMAX.EQ.1 .OR. ICMAX.EQ.4 ) THEN
-*
-* Code when off-diagonals of pivoted C are real
-*
- IF( ABS( UR11 ).GT.ABS( UI11 ) ) THEN
- TEMP = UI11 / UR11
- UR11R = ONE / ( UR11*( ONE+TEMP**2 ) )
- UI11R = -TEMP*UR11R
- ELSE
- TEMP = UR11 / UI11
- UI11R = -ONE / ( UI11*( ONE+TEMP**2 ) )
- UR11R = -TEMP*UI11R
- END IF
- LR21 = CR21*UR11R
- LI21 = CR21*UI11R
- UR12S = UR12*UR11R
- UI12S = UR12*UI11R
- UR22 = CR22 - UR12*LR21
- UI22 = CI22 - UR12*LI21
- ELSE
-*
-* Code when diagonals of pivoted C are real
-*
- UR11R = ONE / UR11
- UI11R = ZERO
- LR21 = CR21*UR11R
- LI21 = CI21*UR11R
- UR12S = UR12*UR11R
- UI12S = UI12*UR11R
- UR22 = CR22 - UR12*LR21 + UI12*LI21
- UI22 = -UR12*LI21 - UI12*LR21
- END IF
- U22ABS = ABS( UR22 ) + ABS( UI22 )
-*
-* If smaller pivot < SMINI, use SMINI
-*
- IF( U22ABS.LT.SMINI ) THEN
- UR22 = SMINI
- UI22 = ZERO
- INFO = 1
- END IF
- IF( RSWAP( ICMAX ) ) THEN
- BR2 = B( 1, 1 )
- BR1 = B( 2, 1 )
- BI2 = B( 1, 2 )
- BI1 = B( 2, 2 )
- ELSE
- BR1 = B( 1, 1 )
- BR2 = B( 2, 1 )
- BI1 = B( 1, 2 )
- BI2 = B( 2, 2 )
- END IF
- BR2 = BR2 - LR21*BR1 + LI21*BI1
- BI2 = BI2 - LI21*BR1 - LR21*BI1
- BBND = MAX( ( ABS( BR1 )+ABS( BI1 ) )*
- $ ( U22ABS*( ABS( UR11R )+ABS( UI11R ) ) ),
- $ ABS( BR2 )+ABS( BI2 ) )
- IF( BBND.GT.ONE .AND. U22ABS.LT.ONE ) THEN
- IF( BBND.GE.BIGNUM*U22ABS ) THEN
- SCALE = ONE / BBND
- BR1 = SCALE*BR1
- BI1 = SCALE*BI1
- BR2 = SCALE*BR2
- BI2 = SCALE*BI2
- END IF
- END IF
-*
- CALL DLADIV( BR2, BI2, UR22, UI22, XR2, XI2 )
- XR1 = UR11R*BR1 - UI11R*BI1 - UR12S*XR2 + UI12S*XI2
- XI1 = UI11R*BR1 + UR11R*BI1 - UI12S*XR2 - UR12S*XI2
- IF( ZSWAP( ICMAX ) ) THEN
- X( 1, 1 ) = XR2
- X( 2, 1 ) = XR1
- X( 1, 2 ) = XI2
- X( 2, 2 ) = XI1
- ELSE
- X( 1, 1 ) = XR1
- X( 2, 1 ) = XR2
- X( 1, 2 ) = XI1
- X( 2, 2 ) = XI2
- END IF
- XNORM = MAX( ABS( XR1 )+ABS( XI1 ), ABS( XR2 )+ABS( XI2 ) )
-*
-* Further scaling if norm(A) norm(X) > overflow
-*
- IF( XNORM.GT.ONE .AND. CMAX.GT.ONE ) THEN
- IF( XNORM.GT.BIGNUM / CMAX ) THEN
- TEMP = CMAX / BIGNUM
- X( 1, 1 ) = TEMP*X( 1, 1 )
- X( 2, 1 ) = TEMP*X( 2, 1 )
- X( 1, 2 ) = TEMP*X( 1, 2 )
- X( 2, 2 ) = TEMP*X( 2, 2 )
- XNORM = TEMP*XNORM
- SCALE = TEMP*SCALE
- END IF
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DLALN2
-*
- END
diff --git a/mtx/lapack_src/dlangb.f b/mtx/lapack_src/dlangb.f
deleted file mode 100644
index abf7c2bae..000000000
--- a/mtx/lapack_src/dlangb.f
+++ /dev/null
@@ -1,223 +0,0 @@
-*> \brief \b DLANGB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANGB + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANGB( NORM, N, KL, KU, AB, LDAB,
-* WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER KL, KU, LDAB, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*>
-*> \return DLANGB
-*> \verbatim
-*>
-*> DLANGB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANGB as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, DLANGB is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of sub-diagonals of the matrix A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of super-diagonals of the matrix A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The band matrix A, stored in rows 1 to KL+KU+1. The j-th
-*> column of A is stored in the j-th column of the array AB as
-*> follows:
-*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANGB( NORM, N, KL, KU, AB, LDAB,
- $ WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER KL, KU, LDAB, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, K, L
- DOUBLE PRECISION SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- VALUE = ZERO
- DO 20 J = 1, N
- DO 10 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 )
- VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
- 10 CONTINUE
- 20 CONTINUE
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- DO 40 J = 1, N
- SUM = ZERO
- DO 30 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 )
- SUM = SUM + ABS( AB( I, J ) )
- 30 CONTINUE
- VALUE = MAX( VALUE, SUM )
- 40 CONTINUE
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- DO 50 I = 1, N
- WORK( I ) = ZERO
- 50 CONTINUE
- DO 70 J = 1, N
- K = KU + 1 - J
- DO 60 I = MAX( 1, J-KU ), MIN( N, J+KL )
- WORK( I ) = WORK( I ) + ABS( AB( K+I, J ) )
- 60 CONTINUE
- 70 CONTINUE
- VALUE = ZERO
- DO 80 I = 1, N
- VALUE = MAX( VALUE, WORK( I ) )
- 80 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- DO 90 J = 1, N
- L = MAX( 1, J-KU )
- K = KU + 1 - J + L
- CALL DLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM )
- 90 CONTINUE
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- DLANGB = VALUE
- RETURN
-*
-* End of DLANGB
-*
- END
diff --git a/mtx/lapack_src/dlange.f b/mtx/lapack_src/dlange.f
deleted file mode 100644
index 47200c16b..000000000
--- a/mtx/lapack_src/dlange.f
+++ /dev/null
@@ -1,209 +0,0 @@
-*> \brief \b DLANGE
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANGE + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANGE( NORM, M, N, A, LDA, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*>
-*> \return DLANGE
-*> \verbatim
-*>
-*> DLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANGE as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0. When M = 0,
-*> DLANGE is set to zero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0. When N = 0,
-*> DLANGE is set to zero.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(M,1).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*> where LWORK >= M when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANGE( NORM, M, N, A, LDA, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( MIN( M, N ).EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- VALUE = ZERO
- DO 20 J = 1, N
- DO 10 I = 1, M
- VALUE = MAX( VALUE, ABS( A( I, J ) ) )
- 10 CONTINUE
- 20 CONTINUE
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- DO 40 J = 1, N
- SUM = ZERO
- DO 30 I = 1, M
- SUM = SUM + ABS( A( I, J ) )
- 30 CONTINUE
- VALUE = MAX( VALUE, SUM )
- 40 CONTINUE
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- DO 50 I = 1, M
- WORK( I ) = ZERO
- 50 CONTINUE
- DO 70 J = 1, N
- DO 60 I = 1, M
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 60 CONTINUE
- 70 CONTINUE
- VALUE = ZERO
- DO 80 I = 1, M
- VALUE = MAX( VALUE, WORK( I ) )
- 80 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- DO 90 J = 1, N
- CALL DLASSQ( M, A( 1, J ), 1, SCALE, SUM )
- 90 CONTINUE
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- DLANGE = VALUE
- RETURN
-*
-* End of DLANGE
-*
- END
diff --git a/mtx/lapack_src/dlangt.f b/mtx/lapack_src/dlangt.f
deleted file mode 100644
index aa562ab67..000000000
--- a/mtx/lapack_src/dlangt.f
+++ /dev/null
@@ -1,203 +0,0 @@
-*> \brief \b DLANGT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANGT + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANGT( NORM, N, DL, D, DU )
-*
-* .. Scalar Arguments ..
-* CHARACTER NORM
-* INTEGER N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), DL( * ), DU( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*>
-*> \return DLANGT
-*> \verbatim
-*>
-*> DLANGT = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANGT as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, DLANGT is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) sub-diagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> The diagonal elements of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is DOUBLE PRECISION array, dimension (N-1)
-*> The (n-1) super-diagonal elements of A.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANGT( NORM, N, DL, D, DU )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER NORM
- INTEGER N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), DL( * ), DU( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- DOUBLE PRECISION ANORM, SCALE, SUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.LE.0 ) THEN
- ANORM = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- ANORM = ABS( D( N ) )
- DO 10 I = 1, N - 1
- ANORM = MAX( ANORM, ABS( DL( I ) ) )
- ANORM = MAX( ANORM, ABS( D( I ) ) )
- ANORM = MAX( ANORM, ABS( DU( I ) ) )
- 10 CONTINUE
- ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN
-*
-* Find norm1(A).
-*
- IF( N.EQ.1 ) THEN
- ANORM = ABS( D( 1 ) )
- ELSE
- ANORM = MAX( ABS( D( 1 ) )+ABS( DL( 1 ) ),
- $ ABS( D( N ) )+ABS( DU( N-1 ) ) )
- DO 20 I = 2, N - 1
- ANORM = MAX( ANORM, ABS( D( I ) )+ABS( DL( I ) )+
- $ ABS( DU( I-1 ) ) )
- 20 CONTINUE
- END IF
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- IF( N.EQ.1 ) THEN
- ANORM = ABS( D( 1 ) )
- ELSE
- ANORM = MAX( ABS( D( 1 ) )+ABS( DU( 1 ) ),
- $ ABS( D( N ) )+ABS( DL( N-1 ) ) )
- DO 30 I = 2, N - 1
- ANORM = MAX( ANORM, ABS( D( I ) )+ABS( DU( I ) )+
- $ ABS( DL( I-1 ) ) )
- 30 CONTINUE
- END IF
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- SCALE = ZERO
- SUM = ONE
- CALL DLASSQ( N, D, 1, SCALE, SUM )
- IF( N.GT.1 ) THEN
- CALL DLASSQ( N-1, DL, 1, SCALE, SUM )
- CALL DLASSQ( N-1, DU, 1, SCALE, SUM )
- END IF
- ANORM = SCALE*SQRT( SUM )
- END IF
-*
- DLANGT = ANORM
- RETURN
-*
-* End of DLANGT
-*
- END
diff --git a/mtx/lapack_src/dlantb.f b/mtx/lapack_src/dlantb.f
deleted file mode 100644
index 08e72b0ff..000000000
--- a/mtx/lapack_src/dlantb.f
+++ /dev/null
@@ -1,356 +0,0 @@
-*> \brief \b DLANTB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANTB + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANTB( NORM, UPLO, DIAG, N, K, AB,
-* LDAB, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORM, UPLO
-* INTEGER K, LDAB, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*>
-*> \return DLANTB
-*> \verbatim
-*>
-*> DLANTB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANTB as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0. When N = 0, DLANTB is
-*> set to zero.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of super-diagonals of the matrix A if UPLO = 'U',
-*> or the number of sub-diagonals of the matrix A if UPLO = 'L'.
-*> K >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The upper or lower triangular band matrix A, stored in the
-*> first k+1 rows of AB. The j-th column of A is stored
-*> in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k).
-*> Note that when DIAG = 'U', the elements of the array AB
-*> corresponding to the diagonal elements of the matrix A are
-*> not referenced, but are assumed to be one.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= K+1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*> where LWORK >= N when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANTB( NORM, UPLO, DIAG, N, K, AB,
- $ LDAB, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORM, UPLO
- INTEGER K, LDAB, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UDIAG
- INTEGER I, J, L
- DOUBLE PRECISION SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( N.EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- IF( LSAME( DIAG, 'U' ) ) THEN
- VALUE = ONE
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 20 J = 1, N
- DO 10 I = MAX( K+2-J, 1 ), K
- VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1, N
- DO 30 I = 2, MIN( N+1-J, K+1 )
- VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 60 J = 1, N
- DO 50 I = MAX( K+2-J, 1 ), K + 1
- VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- DO 80 J = 1, N
- DO 70 I = 1, MIN( N+1-J, K+1 )
- VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
- 70 CONTINUE
- 80 CONTINUE
- END IF
- END IF
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- UDIAG = LSAME( DIAG, 'U' )
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 110 J = 1, N
- IF( UDIAG ) THEN
- SUM = ONE
- DO 90 I = MAX( K+2-J, 1 ), K
- SUM = SUM + ABS( AB( I, J ) )
- 90 CONTINUE
- ELSE
- SUM = ZERO
- DO 100 I = MAX( K+2-J, 1 ), K + 1
- SUM = SUM + ABS( AB( I, J ) )
- 100 CONTINUE
- END IF
- VALUE = MAX( VALUE, SUM )
- 110 CONTINUE
- ELSE
- DO 140 J = 1, N
- IF( UDIAG ) THEN
- SUM = ONE
- DO 120 I = 2, MIN( N+1-J, K+1 )
- SUM = SUM + ABS( AB( I, J ) )
- 120 CONTINUE
- ELSE
- SUM = ZERO
- DO 130 I = 1, MIN( N+1-J, K+1 )
- SUM = SUM + ABS( AB( I, J ) )
- 130 CONTINUE
- END IF
- VALUE = MAX( VALUE, SUM )
- 140 CONTINUE
- END IF
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 150 I = 1, N
- WORK( I ) = ONE
- 150 CONTINUE
- DO 170 J = 1, N
- L = K + 1 - J
- DO 160 I = MAX( 1, J-K ), J - 1
- WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
- 160 CONTINUE
- 170 CONTINUE
- ELSE
- DO 180 I = 1, N
- WORK( I ) = ZERO
- 180 CONTINUE
- DO 200 J = 1, N
- L = K + 1 - J
- DO 190 I = MAX( 1, J-K ), J
- WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
- 190 CONTINUE
- 200 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 210 I = 1, N
- WORK( I ) = ONE
- 210 CONTINUE
- DO 230 J = 1, N
- L = 1 - J
- DO 220 I = J + 1, MIN( N, J+K )
- WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
- 220 CONTINUE
- 230 CONTINUE
- ELSE
- DO 240 I = 1, N
- WORK( I ) = ZERO
- 240 CONTINUE
- DO 260 J = 1, N
- L = 1 - J
- DO 250 I = J, MIN( N, J+K )
- WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
- 250 CONTINUE
- 260 CONTINUE
- END IF
- END IF
- DO 270 I = 1, N
- VALUE = MAX( VALUE, WORK( I ) )
- 270 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = N
- IF( K.GT.0 ) THEN
- DO 280 J = 2, N
- CALL DLASSQ( MIN( J-1, K ),
- $ AB( MAX( K+2-J, 1 ), J ), 1, SCALE,
- $ SUM )
- 280 CONTINUE
- END IF
- ELSE
- SCALE = ZERO
- SUM = ONE
- DO 290 J = 1, N
- CALL DLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ),
- $ 1, SCALE, SUM )
- 290 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = N
- IF( K.GT.0 ) THEN
- DO 300 J = 1, N - 1
- CALL DLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE,
- $ SUM )
- 300 CONTINUE
- END IF
- ELSE
- SCALE = ZERO
- SUM = ONE
- DO 310 J = 1, N
- CALL DLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE,
- $ SUM )
- 310 CONTINUE
- END IF
- END IF
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- DLANTB = VALUE
- RETURN
-*
-* End of DLANTB
-*
- END
diff --git a/mtx/lapack_src/dlantr.f b/mtx/lapack_src/dlantr.f
deleted file mode 100644
index 7d7969b04..000000000
--- a/mtx/lapack_src/dlantr.f
+++ /dev/null
@@ -1,348 +0,0 @@
-*> \brief \b DLANTR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANTR + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
-* WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORM, UPLO
-* INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*>
-*> \return DLANTR
-*> \verbatim
-*>
-*> DLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*> (
-*> ( norm1(A), NORM = '1', 'O' or 'o'
-*> (
-*> ( normI(A), NORM = 'I' or 'i'
-*> (
-*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
-*>
-*> where norm1 denotes the one norm of a matrix (maximum column sum),
-*> normI denotes the infinity norm of a matrix (maximum row sum) and
-*> normF denotes the Frobenius norm of a matrix (square root of sum of
-*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] NORM
-*> \verbatim
-*> NORM is CHARACTER*1
-*> Specifies the value to be returned in DLANTR as described
-*> above.
-*> \endverbatim
-*>
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower trapezoidal.
-*> = 'U': Upper trapezoidal
-*> = 'L': Lower trapezoidal
-*> Note that A is triangular instead of trapezoidal if M = N.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A has unit diagonal.
-*> = 'N': Non-unit diagonal
-*> = 'U': Unit diagonal
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0, and if
-*> UPLO = 'U', M <= N. When M = 0, DLANTR is set to zero.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0, and if
-*> UPLO = 'L', N <= M. When N = 0, DLANTR is set to zero.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The trapezoidal matrix A (A is triangular if M = N).
-*> If UPLO = 'U', the leading m by n upper trapezoidal part of
-*> the array A contains the upper trapezoidal matrix, and the
-*> strictly lower triangular part of A is not referenced.
-*> If UPLO = 'L', the leading m by n lower trapezoidal part of
-*> the array A contains the lower trapezoidal matrix, and the
-*> strictly upper triangular part of A is not referenced. Note
-*> that when DIAG = 'U', the diagonal elements of A are not
-*> referenced and are assumed to be one.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(M,1).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*> where LWORK >= M when NORM = 'I'; otherwise, WORK is not
-*> referenced.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
- $ WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORM, UPLO
- INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL UDIAG
- INTEGER I, J
- DOUBLE PRECISION SCALE, SUM, VALUE
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASSQ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- IF( MIN( M, N ).EQ.0 ) THEN
- VALUE = ZERO
- ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-* Find max(abs(A(i,j))).
-*
- IF( LSAME( DIAG, 'U' ) ) THEN
- VALUE = ONE
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 20 J = 1, N
- DO 10 I = 1, MIN( M, J-1 )
- VALUE = MAX( VALUE, ABS( A( I, J ) ) )
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1, N
- DO 30 I = J + 1, M
- VALUE = MAX( VALUE, ABS( A( I, J ) ) )
- 30 CONTINUE
- 40 CONTINUE
- END IF
- ELSE
- VALUE = ZERO
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 60 J = 1, N
- DO 50 I = 1, MIN( M, J )
- VALUE = MAX( VALUE, ABS( A( I, J ) ) )
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- DO 80 J = 1, N
- DO 70 I = J, M
- VALUE = MAX( VALUE, ABS( A( I, J ) ) )
- 70 CONTINUE
- 80 CONTINUE
- END IF
- END IF
- ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-* Find norm1(A).
-*
- VALUE = ZERO
- UDIAG = LSAME( DIAG, 'U' )
- IF( LSAME( UPLO, 'U' ) ) THEN
- DO 110 J = 1, N
- IF( ( UDIAG ) .AND. ( J.LE.M ) ) THEN
- SUM = ONE
- DO 90 I = 1, J - 1
- SUM = SUM + ABS( A( I, J ) )
- 90 CONTINUE
- ELSE
- SUM = ZERO
- DO 100 I = 1, MIN( M, J )
- SUM = SUM + ABS( A( I, J ) )
- 100 CONTINUE
- END IF
- VALUE = MAX( VALUE, SUM )
- 110 CONTINUE
- ELSE
- DO 140 J = 1, N
- IF( UDIAG ) THEN
- SUM = ONE
- DO 120 I = J + 1, M
- SUM = SUM + ABS( A( I, J ) )
- 120 CONTINUE
- ELSE
- SUM = ZERO
- DO 130 I = J, M
- SUM = SUM + ABS( A( I, J ) )
- 130 CONTINUE
- END IF
- VALUE = MAX( VALUE, SUM )
- 140 CONTINUE
- END IF
- ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-* Find normI(A).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 150 I = 1, M
- WORK( I ) = ONE
- 150 CONTINUE
- DO 170 J = 1, N
- DO 160 I = 1, MIN( M, J-1 )
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 160 CONTINUE
- 170 CONTINUE
- ELSE
- DO 180 I = 1, M
- WORK( I ) = ZERO
- 180 CONTINUE
- DO 200 J = 1, N
- DO 190 I = 1, MIN( M, J )
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 190 CONTINUE
- 200 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- DO 210 I = 1, N
- WORK( I ) = ONE
- 210 CONTINUE
- DO 220 I = N + 1, M
- WORK( I ) = ZERO
- 220 CONTINUE
- DO 240 J = 1, N
- DO 230 I = J + 1, M
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 230 CONTINUE
- 240 CONTINUE
- ELSE
- DO 250 I = 1, M
- WORK( I ) = ZERO
- 250 CONTINUE
- DO 270 J = 1, N
- DO 260 I = J, M
- WORK( I ) = WORK( I ) + ABS( A( I, J ) )
- 260 CONTINUE
- 270 CONTINUE
- END IF
- END IF
- VALUE = ZERO
- DO 280 I = 1, M
- VALUE = MAX( VALUE, WORK( I ) )
- 280 CONTINUE
- ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-* Find normF(A).
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = MIN( M, N )
- DO 290 J = 2, N
- CALL DLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM )
- 290 CONTINUE
- ELSE
- SCALE = ZERO
- SUM = ONE
- DO 300 J = 1, N
- CALL DLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM )
- 300 CONTINUE
- END IF
- ELSE
- IF( LSAME( DIAG, 'U' ) ) THEN
- SCALE = ONE
- SUM = MIN( M, N )
- DO 310 J = 1, N
- CALL DLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
- $ SUM )
- 310 CONTINUE
- ELSE
- SCALE = ZERO
- SUM = ONE
- DO 320 J = 1, N
- CALL DLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
- 320 CONTINUE
- END IF
- END IF
- VALUE = SCALE*SQRT( SUM )
- END IF
-*
- DLANTR = VALUE
- RETURN
-*
-* End of DLANTR
-*
- END
diff --git a/mtx/lapack_src/dlanv2.f b/mtx/lapack_src/dlanv2.f
deleted file mode 100644
index b5a97b2fb..000000000
--- a/mtx/lapack_src/dlanv2.f
+++ /dev/null
@@ -1,289 +0,0 @@
-*> \brief \b DLANV2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLANV2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION
-*> On entry, the elements of the input matrix.
-*> On exit, they are overwritten by the elements of the
-*> standardised Schur form.
-*> \endverbatim
-*>
-*> \param[out] RT1R
-*> \verbatim
-*> RT1R is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] RT1I
-*> \verbatim
-*> RT1I is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] RT2R
-*> \verbatim
-*> RT2R is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] RT2I
-*> \verbatim
-*> RT2I is DOUBLE PRECISION
-*> The real and imaginary parts of the eigenvalues. If the
-*> eigenvalues are a complex conjugate pair, RT1I > 0.
-*> \endverbatim
-*>
-*> \param[out] CS
-*> \verbatim
-*> CS is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] SN
-*> \verbatim
-*> SN is DOUBLE PRECISION
-*> Parameters of the rotation matrix.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Modified by V. Sima, Research Institute for Informatics, Bucharest,
-*> Romania, to reduce the risk of cancellation errors,
-*> when computing real eigenvalues, and to ensure, if possible, that
-*> abs(RT1R) >= abs(RT2R).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
- DOUBLE PRECISION MULTPL
- PARAMETER ( MULTPL = 4.0D+0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AA, BB, BCMAX, BCMIS, CC, CS1, DD, EPS, P, SAB,
- $ SAC, SCALE, SIGMA, SN1, TAU, TEMP, Z
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH, DLAPY2
- EXTERNAL DLAMCH, DLAPY2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SIGN, SQRT
-* ..
-* .. Executable Statements ..
-*
- EPS = DLAMCH( 'P' )
- IF( C.EQ.ZERO ) THEN
- CS = ONE
- SN = ZERO
- GO TO 10
-*
- ELSE IF( B.EQ.ZERO ) THEN
-*
-* Swap rows and columns
-*
- CS = ZERO
- SN = ONE
- TEMP = D
- D = A
- A = TEMP
- B = -C
- C = ZERO
- GO TO 10
- ELSE IF( ( A-D ).EQ.ZERO .AND. SIGN( ONE, B ).NE.SIGN( ONE, C ) )
- $ THEN
- CS = ONE
- SN = ZERO
- GO TO 10
- ELSE
-*
- TEMP = A - D
- P = HALF*TEMP
- BCMAX = MAX( ABS( B ), ABS( C ) )
- BCMIS = MIN( ABS( B ), ABS( C ) )*SIGN( ONE, B )*SIGN( ONE, C )
- SCALE = MAX( ABS( P ), BCMAX )
- Z = ( P / SCALE )*P + ( BCMAX / SCALE )*BCMIS
-*
-* If Z is of the order of the machine accuracy, postpone the
-* decision on the nature of eigenvalues
-*
- IF( Z.GE.MULTPL*EPS ) THEN
-*
-* Real eigenvalues. Compute A and D.
-*
- Z = P + SIGN( SQRT( SCALE )*SQRT( Z ), P )
- A = D + Z
- D = D - ( BCMAX / Z )*BCMIS
-*
-* Compute B and the rotation matrix
-*
- TAU = DLAPY2( C, Z )
- CS = Z / TAU
- SN = C / TAU
- B = B - C
- C = ZERO
- ELSE
-*
-* Complex eigenvalues, or real (almost) equal eigenvalues.
-* Make diagonal elements equal.
-*
- SIGMA = B + C
- TAU = DLAPY2( SIGMA, TEMP )
- CS = SQRT( HALF*( ONE+ABS( SIGMA ) / TAU ) )
- SN = -( P / ( TAU*CS ) )*SIGN( ONE, SIGMA )
-*
-* Compute [ AA BB ] = [ A B ] [ CS -SN ]
-* [ CC DD ] [ C D ] [ SN CS ]
-*
- AA = A*CS + B*SN
- BB = -A*SN + B*CS
- CC = C*CS + D*SN
- DD = -C*SN + D*CS
-*
-* Compute [ A B ] = [ CS SN ] [ AA BB ]
-* [ C D ] [-SN CS ] [ CC DD ]
-*
- A = AA*CS + CC*SN
- B = BB*CS + DD*SN
- C = -AA*SN + CC*CS
- D = -BB*SN + DD*CS
-*
- TEMP = HALF*( A+D )
- A = TEMP
- D = TEMP
-*
- IF( C.NE.ZERO ) THEN
- IF( B.NE.ZERO ) THEN
- IF( SIGN( ONE, B ).EQ.SIGN( ONE, C ) ) THEN
-*
-* Real eigenvalues: reduce to upper triangular form
-*
- SAB = SQRT( ABS( B ) )
- SAC = SQRT( ABS( C ) )
- P = SIGN( SAB*SAC, C )
- TAU = ONE / SQRT( ABS( B+C ) )
- A = TEMP + P
- D = TEMP - P
- B = B - C
- C = ZERO
- CS1 = SAB*TAU
- SN1 = SAC*TAU
- TEMP = CS*CS1 - SN*SN1
- SN = CS*SN1 + SN*CS1
- CS = TEMP
- END IF
- ELSE
- B = -C
- C = ZERO
- TEMP = CS
- CS = -SN
- SN = TEMP
- END IF
- END IF
- END IF
-*
- END IF
-*
- 10 CONTINUE
-*
-* Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I).
-*
- RT1R = A
- RT2R = D
- IF( C.EQ.ZERO ) THEN
- RT1I = ZERO
- RT2I = ZERO
- ELSE
- RT1I = SQRT( ABS( B ) )*SQRT( ABS( C ) )
- RT2I = -RT1I
- END IF
- RETURN
-*
-* End of DLANV2
-*
- END
diff --git a/mtx/lapack_src/dlapy2.f b/mtx/lapack_src/dlapy2.f
deleted file mode 100644
index e6a62bf4a..000000000
--- a/mtx/lapack_src/dlapy2.f
+++ /dev/null
@@ -1,104 +0,0 @@
-*> \brief \b DLAPY2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAPY2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION X, Y
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
-*> overflow.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] Y
-*> \verbatim
-*> Y is DOUBLE PRECISION
-*> X and Y specify the values x and y.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION X, Y
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION W, XABS, YABS, Z
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- XABS = ABS( X )
- YABS = ABS( Y )
- W = MAX( XABS, YABS )
- Z = MIN( XABS, YABS )
- IF( Z.EQ.ZERO ) THEN
- DLAPY2 = W
- ELSE
- DLAPY2 = W*SQRT( ONE+( Z / W )**2 )
- END IF
- RETURN
-*
-* End of DLAPY2
-*
- END
diff --git a/mtx/lapack_src/dlaqgb.f b/mtx/lapack_src/dlaqgb.f
deleted file mode 100644
index da2a08a03..000000000
--- a/mtx/lapack_src/dlaqgb.f
+++ /dev/null
@@ -1,256 +0,0 @@
-*> \brief \b DLAQGB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQGB + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
-* AMAX, EQUED )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED
-* INTEGER KL, KU, LDAB, M, N
-* DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
-*>
-*> On exit, the equilibrated matrix, in the same storage format
-*> as A. See EQUED for the form of the equilibrated matrix.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDA >= KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] R
-*> \verbatim
-*> R is DOUBLE PRECISION array, dimension (M)
-*> The row scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> The column scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] ROWCND
-*> \verbatim
-*> ROWCND is DOUBLE PRECISION
-*> Ratio of the smallest R(i) to the largest R(i).
-*> \endverbatim
-*>
-*> \param[in] COLCND
-*> \verbatim
-*> COLCND is DOUBLE PRECISION
-*> Ratio of the smallest C(i) to the largest C(i).
-*> \endverbatim
-*>
-*> \param[in] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix entry.
-*> \endverbatim
-*>
-*> \param[out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration
-*> = 'R': Row equilibration, i.e., A has been premultiplied by
-*> diag(R).
-*> = 'C': Column equilibration, i.e., A has been postmultiplied
-*> by diag(C).
-*> = 'B': Both row and column equilibration, i.e., A has been
-*> replaced by diag(R) * A * diag(C).
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> THRESH is a threshold value used to decide if row or column scaling
-*> should be done based on the ratio of the row or column scaling
-*> factors. If ROWCND < THRESH, row scaling is done, and if
-*> COLCND < THRESH, column scaling is done.
-*>
-*> LARGE and SMALL are threshold values used to decide if row scaling
-*> should be done based on the absolute size of the largest matrix
-*> element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGBauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
- $ AMAX, EQUED )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED
- INTEGER KL, KU, LDAB, M, N
- DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, THRESH
- PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION CJ, LARGE, SMALL
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 ) THEN
- EQUED = 'N'
- RETURN
- END IF
-*
-* Initialize LARGE and SMALL.
-*
- SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
- LARGE = ONE / SMALL
-*
- IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
- $ THEN
-*
-* No row scaling
-*
- IF( COLCND.GE.THRESH ) THEN
-*
-* No column scaling
-*
- EQUED = 'N'
- ELSE
-*
-* Column scaling
-*
- DO 20 J = 1, N
- CJ = C( J )
- DO 10 I = MAX( 1, J-KU ), MIN( M, J+KL )
- AB( KU+1+I-J, J ) = CJ*AB( KU+1+I-J, J )
- 10 CONTINUE
- 20 CONTINUE
- EQUED = 'C'
- END IF
- ELSE IF( COLCND.GE.THRESH ) THEN
-*
-* Row scaling, no column scaling
-*
- DO 40 J = 1, N
- DO 30 I = MAX( 1, J-KU ), MIN( M, J+KL )
- AB( KU+1+I-J, J ) = R( I )*AB( KU+1+I-J, J )
- 30 CONTINUE
- 40 CONTINUE
- EQUED = 'R'
- ELSE
-*
-* Row and column scaling
-*
- DO 60 J = 1, N
- CJ = C( J )
- DO 50 I = MAX( 1, J-KU ), MIN( M, J+KL )
- AB( KU+1+I-J, J ) = CJ*R( I )*AB( KU+1+I-J, J )
- 50 CONTINUE
- 60 CONTINUE
- EQUED = 'B'
- END IF
-*
- RETURN
-*
-* End of DLAQGB
-*
- END
diff --git a/mtx/lapack_src/dlaqge.f b/mtx/lapack_src/dlaqge.f
deleted file mode 100644
index 568cc5ae8..000000000
--- a/mtx/lapack_src/dlaqge.f
+++ /dev/null
@@ -1,236 +0,0 @@
-*> \brief \b DLAQGE
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQGE + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
-* EQUED )
-*
-* .. Scalar Arguments ..
-* CHARACTER EQUED
-* INTEGER LDA, M, N
-* DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( * ), R( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAQGE equilibrates a general M by N matrix A using the row and
-*> column scaling factors in the vectors R and C.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the M by N matrix A.
-*> On exit, the equilibrated matrix. See EQUED for the form of
-*> the equilibrated matrix.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(M,1).
-*> \endverbatim
-*>
-*> \param[in] R
-*> \verbatim
-*> R is DOUBLE PRECISION array, dimension (M)
-*> The row scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (N)
-*> The column scale factors for A.
-*> \endverbatim
-*>
-*> \param[in] ROWCND
-*> \verbatim
-*> ROWCND is DOUBLE PRECISION
-*> Ratio of the smallest R(i) to the largest R(i).
-*> \endverbatim
-*>
-*> \param[in] COLCND
-*> \verbatim
-*> COLCND is DOUBLE PRECISION
-*> Ratio of the smallest C(i) to the largest C(i).
-*> \endverbatim
-*>
-*> \param[in] AMAX
-*> \verbatim
-*> AMAX is DOUBLE PRECISION
-*> Absolute value of largest matrix entry.
-*> \endverbatim
-*>
-*> \param[out] EQUED
-*> \verbatim
-*> EQUED is CHARACTER*1
-*> Specifies the form of equilibration that was done.
-*> = 'N': No equilibration
-*> = 'R': Row equilibration, i.e., A has been premultiplied by
-*> diag(R).
-*> = 'C': Column equilibration, i.e., A has been postmultiplied
-*> by diag(C).
-*> = 'B': Both row and column equilibration, i.e., A has been
-*> replaced by diag(R) * A * diag(C).
-*> \endverbatim
-*
-*> \par Internal Parameters:
-* =========================
-*>
-*> \verbatim
-*> THRESH is a threshold value used to decide if row or column scaling
-*> should be done based on the ratio of the row or column scaling
-*> factors. If ROWCND < THRESH, row scaling is done, and if
-*> COLCND < THRESH, column scaling is done.
-*>
-*> LARGE and SMALL are threshold values used to decide if row scaling
-*> should be done based on the absolute size of the largest matrix
-*> element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleGEauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
- $ EQUED )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER EQUED
- INTEGER LDA, M, N
- DOUBLE PRECISION AMAX, COLCND, ROWCND
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( * ), R( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, THRESH
- PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION CJ, LARGE, SMALL
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 ) THEN
- EQUED = 'N'
- RETURN
- END IF
-*
-* Initialize LARGE and SMALL.
-*
- SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
- LARGE = ONE / SMALL
-*
- IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
- $ THEN
-*
-* No row scaling
-*
- IF( COLCND.GE.THRESH ) THEN
-*
-* No column scaling
-*
- EQUED = 'N'
- ELSE
-*
-* Column scaling
-*
- DO 20 J = 1, N
- CJ = C( J )
- DO 10 I = 1, M
- A( I, J ) = CJ*A( I, J )
- 10 CONTINUE
- 20 CONTINUE
- EQUED = 'C'
- END IF
- ELSE IF( COLCND.GE.THRESH ) THEN
-*
-* Row scaling, no column scaling
-*
- DO 40 J = 1, N
- DO 30 I = 1, M
- A( I, J ) = R( I )*A( I, J )
- 30 CONTINUE
- 40 CONTINUE
- EQUED = 'R'
- ELSE
-*
-* Row and column scaling
-*
- DO 60 J = 1, N
- CJ = C( J )
- DO 50 I = 1, M
- A( I, J ) = CJ*R( I )*A( I, J )
- 50 CONTINUE
- 60 CONTINUE
- EQUED = 'B'
- END IF
-*
- RETURN
-*
-* End of DLAQGE
-*
- END
diff --git a/mtx/lapack_src/dlaqr0.f b/mtx/lapack_src/dlaqr0.f
deleted file mode 100644
index b1affb331..000000000
--- a/mtx/lapack_src/dlaqr0.f
+++ /dev/null
@@ -1,740 +0,0 @@
-*> \brief \b DLAQR0
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQR0 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
-* ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is LOGICAL
-*> = .TRUE. : the full Schur form T is required;
-*> = .FALSE.: only eigenvalues are required.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> = .TRUE. : the matrix of Schur vectors Z is required;
-*> = .FALSE.: Schur vectors are not required.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N .GE. 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> It is assumed that H is already upper triangular in rows
-*> and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
-*> H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
-*> previous call to DGEBAL, and then passed to DGEHRD when the
-*> matrix output by DGEBAL is reduced to Hessenberg form.
-*> Otherwise, ILO and IHI should be set to 1 and N,
-*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
-*> If N = 0, then ILO = 1 and IHI = 0.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is DOUBLE PRECISION array, dimension (LDH,N)
-*> On entry, the upper Hessenberg matrix H.
-*> On exit, if INFO = 0 and WANTT is .TRUE., then H contains
-*> the upper quasi-triangular matrix T from the Schur
-*> decomposition (the Schur form); 2-by-2 diagonal blocks
-*> (corresponding to complex conjugate pairs of eigenvalues)
-*> are returned in standard form, with H(i,i) = H(i+1,i+1)
-*> and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
-*> .FALSE., then the contents of H are unspecified on exit.
-*> (The output value of H when INFO.GT.0 is given under the
-*> description of INFO below.)
-*>
-*> This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
-*> j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH .GE. max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION array, dimension (IHI)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION array, dimension (IHI)
-*> The real and imaginary parts, respectively, of the computed
-*> eigenvalues of H(ILO:IHI,ILO:IHI) are stored in WR(ILO:IHI)
-*> and WI(ILO:IHI). If two eigenvalues are computed as a
-*> complex conjugate pair, they are stored in consecutive
-*> elements of WR and WI, say the i-th and (i+1)th, with
-*> WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
-*> the eigenvalues are stored in the same order as on the
-*> diagonal of the Schur form returned in H, with
-*> WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
-*> block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
-*> WI(i+1) = -WI(i).
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE..
-*> 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,IHI)
-*> If WANTZ is .FALSE., then Z is not referenced.
-*> If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
-*> replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
-*> orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
-*> (The output value of Z when INFO.GT.0 is given under
-*> the description of INFO below.)
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. if WANTZ is .TRUE.
-*> then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension LWORK
-*> On exit, if LWORK = -1, WORK(1) returns an estimate of
-*> the optimal value for LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK .GE. max(1,N)
-*> is sufficient, but LWORK typically as large as 6*N may
-*> be required for optimal performance. A workspace query
-*> to determine the optimal workspace size is recommended.
-*>
-*> If LWORK = -1, then DLAQR0 does a workspace query.
-*> In this case, DLAQR0 checks the input parameters and
-*> estimates the optimal workspace size for the given
-*> values of N, ILO and IHI. The estimate is returned
-*> in WORK(1). No error message related to LWORK is
-*> issued by XERBLA. Neither H nor Z are accessed.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> .GT. 0: if INFO = i, DLAQR0 failed to compute all of
-*> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
-*> and WI contain those eigenvalues which have been
-*> successfully computed. (Failures are rare.)
-*>
-*> If INFO .GT. 0 and WANT is .FALSE., then on exit,
-*> the remaining unconverged eigenvalues are the eigen-
-*> values of the upper Hessenberg matrix rows and
-*> columns ILO through INFO of the final, output
-*> value of H.
-*>
-*> If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*>
-*> (*) (initial value of H)*U = U*(final value of H)
-*>
-*> where U is an orthogonal matrix. The final
-*> value of H is upper Hessenberg and quasi-triangular
-*> in rows and columns INFO+1 through IHI.
-*>
-*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*>
-*> (final value of Z(ILO:IHI,ILOZ:IHIZ)
-*> = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
-*>
-*> where U is the orthogonal matrix in (*) (regard-
-*> less of the value of WANTT.)
-*>
-*> If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
-*> accessed.
-*> \endverbatim
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*
-*> \par References:
-* ================
-*>
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*> Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*> 929--947, 2002.
-*> \n
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part II: Aggressive Early Deflation, SIAM Journal
-*> of Matrix Analysis, volume 23, pages 948--973, 2002.
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
- $ ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ),
- $ Z( LDZ, * )
-* ..
-*
-* ================================================================
-*
-* .. Parameters ..
-*
-* ==== Matrices of order NTINY or smaller must be processed by
-* . DLAHQR because of insufficient subdiagonal scratch space.
-* . (This is a hard limit.) ====
- INTEGER NTINY
- PARAMETER ( NTINY = 11 )
-*
-* ==== Exceptional deflation windows: try to cure rare
-* . slow convergence by varying the size of the
-* . deflation window after KEXNW iterations. ====
- INTEGER KEXNW
- PARAMETER ( KEXNW = 5 )
-*
-* ==== Exceptional shifts: try to cure rare slow convergence
-* . with ad-hoc exceptional shifts every KEXSH iterations.
-* . ====
- INTEGER KEXSH
- PARAMETER ( KEXSH = 6 )
-*
-* ==== The constants WILK1 and WILK2 are used to form the
-* . exceptional shifts. ====
- DOUBLE PRECISION WILK1, WILK2
- PARAMETER ( WILK1 = 0.75d0, WILK2 = -0.4375d0 )
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AA, BB, CC, CS, DD, SN, SS, SWAP
- INTEGER I, INF, IT, ITMAX, K, KACC22, KBOT, KDU, KS,
- $ KT, KTOP, KU, KV, KWH, KWTOP, KWV, LD, LS,
- $ LWKOPT, NDEC, NDFL, NH, NHO, NIBBLE, NMIN, NS,
- $ NSMAX, NSR, NVE, NW, NWMAX, NWR, NWUPBD
- LOGICAL SORTED
- CHARACTER JBCMPZ*2
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION ZDUM( 1, 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACPY, DLAHQR, DLANV2, DLAQR3, DLAQR4, DLAQR5
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, INT, MAX, MIN, MOD
-* ..
-* .. Executable Statements ..
- INFO = 0
-*
-* ==== Quick return for N = 0: nothing to do. ====
-*
- IF( N.EQ.0 ) THEN
- WORK( 1 ) = ONE
- RETURN
- END IF
-*
- IF( N.LE.NTINY ) THEN
-*
-* ==== Tiny matrices must use DLAHQR. ====
-*
- LWKOPT = 1
- IF( LWORK.NE.-1 )
- $ CALL DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
- $ ILOZ, IHIZ, Z, LDZ, INFO )
- ELSE
-*
-* ==== Use small bulge multi-shift QR with aggressive early
-* . deflation on larger-than-tiny matrices. ====
-*
-* ==== Hope for the best. ====
-*
- INFO = 0
-*
-* ==== Set up job flags for ILAENV. ====
-*
- IF( WANTT ) THEN
- JBCMPZ( 1: 1 ) = 'S'
- ELSE
- JBCMPZ( 1: 1 ) = 'E'
- END IF
- IF( WANTZ ) THEN
- JBCMPZ( 2: 2 ) = 'V'
- ELSE
- JBCMPZ( 2: 2 ) = 'N'
- END IF
-*
-* ==== NWR = recommended deflation window size. At this
-* . point, N .GT. NTINY = 11, so there is enough
-* . subdiagonal workspace for NWR.GE.2 as required.
-* . (In fact, there is enough subdiagonal space for
-* . NWR.GE.3.) ====
-*
- NWR = ILAENV( 13, 'DLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
- NWR = MAX( 2, NWR )
- NWR = MIN( IHI-ILO+1, ( N-1 ) / 3, NWR )
-*
-* ==== NSR = recommended number of simultaneous shifts.
-* . At this point N .GT. NTINY = 11, so there is at
-* . enough subdiagonal workspace for NSR to be even
-* . and greater than or equal to two as required. ====
-*
- NSR = ILAENV( 15, 'DLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
- NSR = MIN( NSR, ( N+6 ) / 9, IHI-ILO )
- NSR = MAX( 2, NSR-MOD( NSR, 2 ) )
-*
-* ==== Estimate optimal workspace ====
-*
-* ==== Workspace query call to DLAQR3 ====
-*
- CALL DLAQR3( WANTT, WANTZ, N, ILO, IHI, NWR+1, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, LS, LD, WR, WI, H, LDH, N, H, LDH,
- $ N, H, LDH, WORK, -1 )
-*
-* ==== Optimal workspace = MAX(DLAQR5, DLAQR3) ====
-*
- LWKOPT = MAX( 3*NSR / 2, INT( WORK( 1 ) ) )
-*
-* ==== Quick return in case of workspace query. ====
-*
- IF( LWORK.EQ.-1 ) THEN
- WORK( 1 ) = DBLE( LWKOPT )
- RETURN
- END IF
-*
-* ==== DLAHQR/DLAQR0 crossover point ====
-*
- NMIN = ILAENV( 12, 'DLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
- NMIN = MAX( NTINY, NMIN )
-*
-* ==== Nibble crossover point ====
-*
- NIBBLE = ILAENV( 14, 'DLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
- NIBBLE = MAX( 0, NIBBLE )
-*
-* ==== Accumulate reflections during ttswp? Use block
-* . 2-by-2 structure during matrix-matrix multiply? ====
-*
- KACC22 = ILAENV( 16, 'DLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
- KACC22 = MAX( 0, KACC22 )
- KACC22 = MIN( 2, KACC22 )
-*
-* ==== NWMAX = the largest possible deflation window for
-* . which there is sufficient workspace. ====
-*
- NWMAX = MIN( ( N-1 ) / 3, LWORK / 2 )
- NW = NWMAX
-*
-* ==== NSMAX = the Largest number of simultaneous shifts
-* . for which there is sufficient workspace. ====
-*
- NSMAX = MIN( ( N+6 ) / 9, 2*LWORK / 3 )
- NSMAX = NSMAX - MOD( NSMAX, 2 )
-*
-* ==== NDFL: an iteration count restarted at deflation. ====
-*
- NDFL = 1
-*
-* ==== ITMAX = iteration limit ====
-*
- ITMAX = MAX( 30, 2*KEXSH )*MAX( 10, ( IHI-ILO+1 ) )
-*
-* ==== Last row and column in the active block ====
-*
- KBOT = IHI
-*
-* ==== Main Loop ====
-*
- DO 80 IT = 1, ITMAX
-*
-* ==== Done when KBOT falls below ILO ====
-*
- IF( KBOT.LT.ILO )
- $ GO TO 90
-*
-* ==== Locate active block ====
-*
- DO 10 K = KBOT, ILO + 1, -1
- IF( H( K, K-1 ).EQ.ZERO )
- $ GO TO 20
- 10 CONTINUE
- K = ILO
- 20 CONTINUE
- KTOP = K
-*
-* ==== Select deflation window size:
-* . Typical Case:
-* . If possible and advisable, nibble the entire
-* . active block. If not, use size MIN(NWR,NWMAX)
-* . or MIN(NWR+1,NWMAX) depending upon which has
-* . the smaller corresponding subdiagonal entry
-* . (a heuristic).
-* .
-* . Exceptional Case:
-* . If there have been no deflations in KEXNW or
-* . more iterations, then vary the deflation window
-* . size. At first, because, larger windows are,
-* . in general, more powerful than smaller ones,
-* . rapidly increase the window to the maximum possible.
-* . Then, gradually reduce the window size. ====
-*
- NH = KBOT - KTOP + 1
- NWUPBD = MIN( NH, NWMAX )
- IF( NDFL.LT.KEXNW ) THEN
- NW = MIN( NWUPBD, NWR )
- ELSE
- NW = MIN( NWUPBD, 2*NW )
- END IF
- IF( NW.LT.NWMAX ) THEN
- IF( NW.GE.NH-1 ) THEN
- NW = NH
- ELSE
- KWTOP = KBOT - NW + 1
- IF( ABS( H( KWTOP, KWTOP-1 ) ).GT.
- $ ABS( H( KWTOP-1, KWTOP-2 ) ) )NW = NW + 1
- END IF
- END IF
- IF( NDFL.LT.KEXNW ) THEN
- NDEC = -1
- ELSE IF( NDEC.GE.0 .OR. NW.GE.NWUPBD ) THEN
- NDEC = NDEC + 1
- IF( NW-NDEC.LT.2 )
- $ NDEC = 0
- NW = NW - NDEC
- END IF
-*
-* ==== Aggressive early deflation:
-* . split workspace under the subdiagonal into
-* . - an nw-by-nw work array V in the lower
-* . left-hand-corner,
-* . - an NW-by-at-least-NW-but-more-is-better
-* . (NW-by-NHO) horizontal work array along
-* . the bottom edge,
-* . - an at-least-NW-but-more-is-better (NHV-by-NW)
-* . vertical work array along the left-hand-edge.
-* . ====
-*
- KV = N - NW + 1
- KT = NW + 1
- NHO = ( N-NW-1 ) - KT + 1
- KWV = NW + 2
- NVE = ( N-NW ) - KWV + 1
-*
-* ==== Aggressive early deflation ====
-*
- CALL DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, LS, LD, WR, WI, H( KV, 1 ), LDH,
- $ NHO, H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH,
- $ WORK, LWORK )
-*
-* ==== Adjust KBOT accounting for new deflations. ====
-*
- KBOT = KBOT - LD
-*
-* ==== KS points to the shifts. ====
-*
- KS = KBOT - LS + 1
-*
-* ==== Skip an expensive QR sweep if there is a (partly
-* . heuristic) reason to expect that many eigenvalues
-* . will deflate without it. Here, the QR sweep is
-* . skipped if many eigenvalues have just been deflated
-* . or if the remaining active block is small.
-*
- IF( ( LD.EQ.0 ) .OR. ( ( 100*LD.LE.NW*NIBBLE ) .AND. ( KBOT-
- $ KTOP+1.GT.MIN( NMIN, NWMAX ) ) ) ) THEN
-*
-* ==== NS = nominal number of simultaneous shifts.
-* . This may be lowered (slightly) if DLAQR3
-* . did not provide that many shifts. ====
-*
- NS = MIN( NSMAX, NSR, MAX( 2, KBOT-KTOP ) )
- NS = NS - MOD( NS, 2 )
-*
-* ==== If there have been no deflations
-* . in a multiple of KEXSH iterations,
-* . then try exceptional shifts.
-* . Otherwise use shifts provided by
-* . DLAQR3 above or from the eigenvalues
-* . of a trailing principal submatrix. ====
-*
- IF( MOD( NDFL, KEXSH ).EQ.0 ) THEN
- KS = KBOT - NS + 1
- DO 30 I = KBOT, MAX( KS+1, KTOP+2 ), -2
- SS = ABS( H( I, I-1 ) ) + ABS( H( I-1, I-2 ) )
- AA = WILK1*SS + H( I, I )
- BB = SS
- CC = WILK2*SS
- DD = AA
- CALL DLANV2( AA, BB, CC, DD, WR( I-1 ), WI( I-1 ),
- $ WR( I ), WI( I ), CS, SN )
- 30 CONTINUE
- IF( KS.EQ.KTOP ) THEN
- WR( KS+1 ) = H( KS+1, KS+1 )
- WI( KS+1 ) = ZERO
- WR( KS ) = WR( KS+1 )
- WI( KS ) = WI( KS+1 )
- END IF
- ELSE
-*
-* ==== Got NS/2 or fewer shifts? Use DLAQR4 or
-* . DLAHQR on a trailing principal submatrix to
-* . get more. (Since NS.LE.NSMAX.LE.(N+6)/9,
-* . there is enough space below the subdiagonal
-* . to fit an NS-by-NS scratch array.) ====
-*
- IF( KBOT-KS+1.LE.NS / 2 ) THEN
- KS = KBOT - NS + 1
- KT = N - NS + 1
- CALL DLACPY( 'A', NS, NS, H( KS, KS ), LDH,
- $ H( KT, 1 ), LDH )
- IF( NS.GT.NMIN ) THEN
- CALL DLAQR4( .false., .false., NS, 1, NS,
- $ H( KT, 1 ), LDH, WR( KS ),
- $ WI( KS ), 1, 1, ZDUM, 1, WORK,
- $ LWORK, INF )
- ELSE
- CALL DLAHQR( .false., .false., NS, 1, NS,
- $ H( KT, 1 ), LDH, WR( KS ),
- $ WI( KS ), 1, 1, ZDUM, 1, INF )
- END IF
- KS = KS + INF
-*
-* ==== In case of a rare QR failure use
-* . eigenvalues of the trailing 2-by-2
-* . principal submatrix. ====
-*
- IF( KS.GE.KBOT ) THEN
- AA = H( KBOT-1, KBOT-1 )
- CC = H( KBOT, KBOT-1 )
- BB = H( KBOT-1, KBOT )
- DD = H( KBOT, KBOT )
- CALL DLANV2( AA, BB, CC, DD, WR( KBOT-1 ),
- $ WI( KBOT-1 ), WR( KBOT ),
- $ WI( KBOT ), CS, SN )
- KS = KBOT - 1
- END IF
- END IF
-*
- IF( KBOT-KS+1.GT.NS ) THEN
-*
-* ==== Sort the shifts (Helps a little)
-* . Bubble sort keeps complex conjugate
-* . pairs together. ====
-*
- SORTED = .false.
- DO 50 K = KBOT, KS + 1, -1
- IF( SORTED )
- $ GO TO 60
- SORTED = .true.
- DO 40 I = KS, K - 1
- IF( ABS( WR( I ) )+ABS( WI( I ) ).LT.
- $ ABS( WR( I+1 ) )+ABS( WI( I+1 ) ) ) THEN
- SORTED = .false.
-*
- SWAP = WR( I )
- WR( I ) = WR( I+1 )
- WR( I+1 ) = SWAP
-*
- SWAP = WI( I )
- WI( I ) = WI( I+1 )
- WI( I+1 ) = SWAP
- END IF
- 40 CONTINUE
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
-* ==== Shuffle shifts into pairs of real shifts
-* . and pairs of complex conjugate shifts
-* . assuming complex conjugate shifts are
-* . already adjacent to one another. (Yes,
-* . they are.) ====
-*
- DO 70 I = KBOT, KS + 2, -2
- IF( WI( I ).NE.-WI( I-1 ) ) THEN
-*
- SWAP = WR( I )
- WR( I ) = WR( I-1 )
- WR( I-1 ) = WR( I-2 )
- WR( I-2 ) = SWAP
-*
- SWAP = WI( I )
- WI( I ) = WI( I-1 )
- WI( I-1 ) = WI( I-2 )
- WI( I-2 ) = SWAP
- END IF
- 70 CONTINUE
- END IF
-*
-* ==== If there are only two shifts and both are
-* . real, then use only one. ====
-*
- IF( KBOT-KS+1.EQ.2 ) THEN
- IF( WI( KBOT ).EQ.ZERO ) THEN
- IF( ABS( WR( KBOT )-H( KBOT, KBOT ) ).LT.
- $ ABS( WR( KBOT-1 )-H( KBOT, KBOT ) ) ) THEN
- WR( KBOT-1 ) = WR( KBOT )
- ELSE
- WR( KBOT ) = WR( KBOT-1 )
- END IF
- END IF
- END IF
-*
-* ==== Use up to NS of the the smallest magnatiude
-* . shifts. If there aren't NS shifts available,
-* . then use them all, possibly dropping one to
-* . make the number of shifts even. ====
-*
- NS = MIN( NS, KBOT-KS+1 )
- NS = NS - MOD( NS, 2 )
- KS = KBOT - NS + 1
-*
-* ==== Small-bulge multi-shift QR sweep:
-* . split workspace under the subdiagonal into
-* . - a KDU-by-KDU work array U in the lower
-* . left-hand-corner,
-* . - a KDU-by-at-least-KDU-but-more-is-better
-* . (KDU-by-NHo) horizontal work array WH along
-* . the bottom edge,
-* . - and an at-least-KDU-but-more-is-better-by-KDU
-* . (NVE-by-KDU) vertical work WV arrow along
-* . the left-hand-edge. ====
-*
- KDU = 3*NS - 3
- KU = N - KDU + 1
- KWH = KDU + 1
- NHO = ( N-KDU+1-4 ) - ( KDU+1 ) + 1
- KWV = KDU + 4
- NVE = N - KDU - KWV + 1
-*
-* ==== Small-bulge multi-shift QR sweep ====
-*
- CALL DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NS,
- $ WR( KS ), WI( KS ), H, LDH, ILOZ, IHIZ, Z,
- $ LDZ, WORK, 3, H( KU, 1 ), LDH, NVE,
- $ H( KWV, 1 ), LDH, NHO, H( KU, KWH ), LDH )
- END IF
-*
-* ==== Note progress (or the lack of it). ====
-*
- IF( LD.GT.0 ) THEN
- NDFL = 1
- ELSE
- NDFL = NDFL + 1
- END IF
-*
-* ==== End of main loop ====
- 80 CONTINUE
-*
-* ==== Iteration limit exceeded. Set INFO to show where
-* . the problem occurred and exit. ====
-*
- INFO = KBOT
- 90 CONTINUE
- END IF
-*
-* ==== Return the optimal value of LWORK. ====
-*
- WORK( 1 ) = DBLE( LWKOPT )
-*
-* ==== End of DLAQR0 ====
-*
- END
diff --git a/mtx/lapack_src/dlaqr1.f b/mtx/lapack_src/dlaqr1.f
deleted file mode 100644
index 8263202e4..000000000
--- a/mtx/lapack_src/dlaqr1.f
+++ /dev/null
@@ -1,179 +0,0 @@
-*> \brief \b DLAQR1
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQR1 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION SI1, SI2, SR1, SR2
-* INTEGER LDH, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), V( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is integer
-*> Order of the matrix H. N must be either 2 or 3.
-*> \endverbatim
-*>
-*> \param[in] H
-*> \verbatim
-*> H is DOUBLE PRECISION array of dimension (LDH,N)
-*> The 2-by-2 or 3-by-3 matrix H in (*).
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is integer
-*> The leading dimension of H as declared in
-*> the calling procedure. LDH.GE.N
-*> \endverbatim
-*>
-*> \param[in] SR1
-*> \verbatim
-*> SR1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] SI1
-*> \verbatim
-*> SI1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] SR2
-*> \verbatim
-*> SR2 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] SI2
-*> \verbatim
-*> SI2 is DOUBLE PRECISION
-*> The shifts in (*).
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array of dimension N
-*> A scalar multiple of the first column of the
-*> matrix K in (*).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*>
-* =====================================================================
- SUBROUTINE DLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION SI1, SI2, SR1, SR2
- INTEGER LDH, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), V( * )
-* ..
-*
-* ================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0d0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION H21S, H31S, S
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
- IF( N.EQ.2 ) THEN
- S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) )
- IF( S.EQ.ZERO ) THEN
- V( 1 ) = ZERO
- V( 2 ) = ZERO
- ELSE
- H21S = H( 2, 1 ) / S
- V( 1 ) = H21S*H( 1, 2 ) + ( H( 1, 1 )-SR1 )*
- $ ( ( H( 1, 1 )-SR2 ) / S ) - SI1*( SI2 / S )
- V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 )
- END IF
- ELSE
- S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) ) +
- $ ABS( H( 3, 1 ) )
- IF( S.EQ.ZERO ) THEN
- V( 1 ) = ZERO
- V( 2 ) = ZERO
- V( 3 ) = ZERO
- ELSE
- H21S = H( 2, 1 ) / S
- H31S = H( 3, 1 ) / S
- V( 1 ) = ( H( 1, 1 )-SR1 )*( ( H( 1, 1 )-SR2 ) / S ) -
- $ SI1*( SI2 / S ) + H( 1, 2 )*H21S + H( 1, 3 )*H31S
- V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 ) +
- $ H( 2, 3 )*H31S
- V( 3 ) = H31S*( H( 1, 1 )+H( 3, 3 )-SR1-SR2 ) +
- $ H21S*H( 3, 2 )
- END IF
- END IF
- END
diff --git a/mtx/lapack_src/dlaqr2.f b/mtx/lapack_src/dlaqr2.f
deleted file mode 100644
index b5de50273..000000000
--- a/mtx/lapack_src/dlaqr2.f
+++ /dev/null
@@ -1,684 +0,0 @@
-*> \brief \b DLAQR2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQR2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
-* IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
-* LDT, NV, WV, LDWV, WORK, LWORK )
-*
-* .. Scalar Arguments ..
-* INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
-* $ LDZ, LWORK, N, ND, NH, NS, NV, NW
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
-* $ V( LDV, * ), WORK( * ), WV( LDWV, * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is LOGICAL
-*> If .TRUE., then the Hessenberg matrix H is fully updated
-*> so that the quasi-triangular Schur factor may be
-*> computed (in cooperation with the calling subroutine).
-*> If .FALSE., then only enough of H is updated to preserve
-*> the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> If .TRUE., then the orthogonal matrix Z is updated so
-*> so that the orthogonal Schur factor may be computed
-*> (in cooperation with the calling subroutine).
-*> If .FALSE., then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H and (if WANTZ is .TRUE.) the
-*> order of the orthogonal matrix Z.
-*> \endverbatim
-*>
-*> \param[in] KTOP
-*> \verbatim
-*> KTOP is INTEGER
-*> It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
-*> KBOT and KTOP together determine an isolated block
-*> along the diagonal of the Hessenberg matrix.
-*> \endverbatim
-*>
-*> \param[in] KBOT
-*> \verbatim
-*> KBOT is INTEGER
-*> It is assumed without a check that either
-*> KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together
-*> determine an isolated block along the diagonal of the
-*> Hessenberg matrix.
-*> \endverbatim
-*>
-*> \param[in] NW
-*> \verbatim
-*> NW is INTEGER
-*> Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1).
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is DOUBLE PRECISION array, dimension (LDH,N)
-*> On input the initial N-by-N section of H stores the
-*> Hessenberg matrix undergoing aggressive early deflation.
-*> On output H has been transformed by an orthogonal
-*> similarity transformation, perturbed, and the returned
-*> to Hessenberg form that (it is to be hoped) has some
-*> zero subdiagonal entries.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is integer
-*> Leading dimension of H just as declared in the calling
-*> subroutine. N .LE. LDH
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,N)
-*> IF WANTZ is .TRUE., then on output, the orthogonal
-*> similarity transformation mentioned above has been
-*> accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
-*> If WANTZ is .FALSE., then Z is unreferenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is integer
-*> The leading dimension of Z just as declared in the
-*> calling subroutine. 1 .LE. LDZ.
-*> \endverbatim
-*>
-*> \param[out] NS
-*> \verbatim
-*> NS is integer
-*> The number of unconverged (ie approximate) eigenvalues
-*> returned in SR and SI that may be used as shifts by the
-*> calling subroutine.
-*> \endverbatim
-*>
-*> \param[out] ND
-*> \verbatim
-*> ND is integer
-*> The number of converged eigenvalues uncovered by this
-*> subroutine.
-*> \endverbatim
-*>
-*> \param[out] SR
-*> \verbatim
-*> SR is DOUBLE PRECISION array, dimension (KBOT)
-*> \endverbatim
-*>
-*> \param[out] SI
-*> \verbatim
-*> SI is DOUBLE PRECISION array, dimension (KBOT)
-*> On output, the real and imaginary parts of approximate
-*> eigenvalues that may be used for shifts are stored in
-*> SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
-*> SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
-*> The real and imaginary parts of converged eigenvalues
-*> are stored in SR(KBOT-ND+1) through SR(KBOT) and
-*> SI(KBOT-ND+1) through SI(KBOT), respectively.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,NW)
-*> An NW-by-NW work array.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is integer scalar
-*> The leading dimension of V just as declared in the
-*> calling subroutine. NW .LE. LDV
-*> \endverbatim
-*>
-*> \param[in] NH
-*> \verbatim
-*> NH is integer scalar
-*> The number of columns of T. NH.GE.NW.
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,NW)
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is integer
-*> The leading dimension of T just as declared in the
-*> calling subroutine. NW .LE. LDT
-*> \endverbatim
-*>
-*> \param[in] NV
-*> \verbatim
-*> NV is integer
-*> The number of rows of work array WV available for
-*> workspace. NV.GE.NW.
-*> \endverbatim
-*>
-*> \param[out] WV
-*> \verbatim
-*> WV is DOUBLE PRECISION array, dimension (LDWV,NW)
-*> \endverbatim
-*>
-*> \param[in] LDWV
-*> \verbatim
-*> LDWV is integer
-*> The leading dimension of W just as declared in the
-*> calling subroutine. NW .LE. LDV
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LWORK)
-*> On exit, WORK(1) is set to an estimate of the optimal value
-*> of LWORK for the given values of N, NW, KTOP and KBOT.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is integer
-*> The dimension of the work array WORK. LWORK = 2*NW
-*> suffices, but greater efficiency may result from larger
-*> values of LWORK.
-*>
-*> If LWORK = -1, then a workspace query is assumed; DLAQR2
-*> only estimates the optimal workspace size for the given
-*> values of N, NW, KTOP and KBOT. The estimate is returned
-*> in WORK(1). No error message related to LWORK is issued
-*> by XERBLA. Neither H nor Z are accessed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*>
-* =====================================================================
- SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
- $ LDT, NV, WV, LDWV, WORK, LWORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
- $ LDZ, LWORK, N, ND, NH, NS, NV, NW
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
- $ V( LDV, * ), WORK( * ), WV( LDWV, * ),
- $ Z( LDZ, * )
-* ..
-*
-* ================================================================
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AA, BB, BETA, CC, CS, DD, EVI, EVK, FOO, S,
- $ SAFMAX, SAFMIN, SMLNUM, SN, TAU, ULP
- INTEGER I, IFST, ILST, INFO, INFQR, J, JW, K, KCOL,
- $ KEND, KLN, KROW, KWTOP, LTOP, LWK1, LWK2,
- $ LWKOPT
- LOGICAL BULGE, SORTED
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEHRD, DGEMM, DLABAD, DLACPY, DLAHQR,
- $ DLANV2, DLARF, DLARFG, DLASET, DORMHR, DTREXC
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, INT, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* ==== Estimate optimal workspace. ====
-*
- JW = MIN( NW, KBOT-KTOP+1 )
- IF( JW.LE.2 ) THEN
- LWKOPT = 1
- ELSE
-*
-* ==== Workspace query call to DGEHRD ====
-*
- CALL DGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
- LWK1 = INT( WORK( 1 ) )
-*
-* ==== Workspace query call to DORMHR ====
-*
- CALL DORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV,
- $ WORK, -1, INFO )
- LWK2 = INT( WORK( 1 ) )
-*
-* ==== Optimal workspace ====
-*
- LWKOPT = JW + MAX( LWK1, LWK2 )
- END IF
-*
-* ==== Quick return in case of workspace query. ====
-*
- IF( LWORK.EQ.-1 ) THEN
- WORK( 1 ) = DBLE( LWKOPT )
- RETURN
- END IF
-*
-* ==== Nothing to do ...
-* ... for an empty active block ... ====
- NS = 0
- ND = 0
- WORK( 1 ) = ONE
- IF( KTOP.GT.KBOT )
- $ RETURN
-* ... nor for an empty deflation window. ====
- IF( NW.LT.1 )
- $ RETURN
-*
-* ==== Machine constants ====
-*
- SAFMIN = DLAMCH( 'SAFE MINIMUM' )
- SAFMAX = ONE / SAFMIN
- CALL DLABAD( SAFMIN, SAFMAX )
- ULP = DLAMCH( 'PRECISION' )
- SMLNUM = SAFMIN*( DBLE( N ) / ULP )
-*
-* ==== Setup deflation window ====
-*
- JW = MIN( NW, KBOT-KTOP+1 )
- KWTOP = KBOT - JW + 1
- IF( KWTOP.EQ.KTOP ) THEN
- S = ZERO
- ELSE
- S = H( KWTOP, KWTOP-1 )
- END IF
-*
- IF( KBOT.EQ.KWTOP ) THEN
-*
-* ==== 1-by-1 deflation window: not much to do ====
-*
- SR( KWTOP ) = H( KWTOP, KWTOP )
- SI( KWTOP ) = ZERO
- NS = 1
- ND = 0
- IF( ABS( S ).LE.MAX( SMLNUM, ULP*ABS( H( KWTOP, KWTOP ) ) ) )
- $ THEN
- NS = 0
- ND = 1
- IF( KWTOP.GT.KTOP )
- $ H( KWTOP, KWTOP-1 ) = ZERO
- END IF
- WORK( 1 ) = ONE
- RETURN
- END IF
-*
-* ==== Convert to spike-triangular form. (In case of a
-* . rare QR failure, this routine continues to do
-* . aggressive early deflation using that part of
-* . the deflation window that converged using INFQR
-* . here and there to keep track.) ====
-*
- CALL DLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )
- CALL DCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 )
-*
- CALL DLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
- CALL DLAHQR( .true., .true., JW, 1, JW, T, LDT, SR( KWTOP ),
- $ SI( KWTOP ), 1, JW, V, LDV, INFQR )
-*
-* ==== DTREXC needs a clean margin near the diagonal ====
-*
- DO 10 J = 1, JW - 3
- T( J+2, J ) = ZERO
- T( J+3, J ) = ZERO
- 10 CONTINUE
- IF( JW.GT.2 )
- $ T( JW, JW-2 ) = ZERO
-*
-* ==== Deflation detection loop ====
-*
- NS = JW
- ILST = INFQR + 1
- 20 CONTINUE
- IF( ILST.LE.NS ) THEN
- IF( NS.EQ.1 ) THEN
- BULGE = .FALSE.
- ELSE
- BULGE = T( NS, NS-1 ).NE.ZERO
- END IF
-*
-* ==== Small spike tip test for deflation ====
-*
- IF( .NOT.BULGE ) THEN
-*
-* ==== Real eigenvalue ====
-*
- FOO = ABS( T( NS, NS ) )
- IF( FOO.EQ.ZERO )
- $ FOO = ABS( S )
- IF( ABS( S*V( 1, NS ) ).LE.MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-* ==== Deflatable ====
-*
- NS = NS - 1
- ELSE
-*
-* ==== Undeflatable. Move it up out of the way.
-* . (DTREXC can not fail in this case.) ====
-*
- IFST = NS
- CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- ILST = ILST + 1
- END IF
- ELSE
-*
-* ==== Complex conjugate pair ====
-*
- FOO = ABS( T( NS, NS ) ) + SQRT( ABS( T( NS, NS-1 ) ) )*
- $ SQRT( ABS( T( NS-1, NS ) ) )
- IF( FOO.EQ.ZERO )
- $ FOO = ABS( S )
- IF( MAX( ABS( S*V( 1, NS ) ), ABS( S*V( 1, NS-1 ) ) ).LE.
- $ MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-* ==== Deflatable ====
-*
- NS = NS - 2
- ELSE
-*
-* ==== Undeflatable. Move them up out of the way.
-* . Fortunately, DTREXC does the right thing with
-* . ILST in case of a rare exchange failure. ====
-*
- IFST = NS
- CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- ILST = ILST + 2
- END IF
- END IF
-*
-* ==== End deflation detection loop ====
-*
- GO TO 20
- END IF
-*
-* ==== Return to Hessenberg form ====
-*
- IF( NS.EQ.0 )
- $ S = ZERO
-*
- IF( NS.LT.JW ) THEN
-*
-* ==== sorting diagonal blocks of T improves accuracy for
-* . graded matrices. Bubble sort deals well with
-* . exchange failures. ====
-*
- SORTED = .false.
- I = NS + 1
- 30 CONTINUE
- IF( SORTED )
- $ GO TO 50
- SORTED = .true.
-*
- KEND = I - 1
- I = INFQR + 1
- IF( I.EQ.NS ) THEN
- K = I + 1
- ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
- K = I + 1
- ELSE
- K = I + 2
- END IF
- 40 CONTINUE
- IF( K.LE.KEND ) THEN
- IF( K.EQ.I+1 ) THEN
- EVI = ABS( T( I, I ) )
- ELSE
- EVI = ABS( T( I, I ) ) + SQRT( ABS( T( I+1, I ) ) )*
- $ SQRT( ABS( T( I, I+1 ) ) )
- END IF
-*
- IF( K.EQ.KEND ) THEN
- EVK = ABS( T( K, K ) )
- ELSE IF( T( K+1, K ).EQ.ZERO ) THEN
- EVK = ABS( T( K, K ) )
- ELSE
- EVK = ABS( T( K, K ) ) + SQRT( ABS( T( K+1, K ) ) )*
- $ SQRT( ABS( T( K, K+1 ) ) )
- END IF
-*
- IF( EVI.GE.EVK ) THEN
- I = K
- ELSE
- SORTED = .false.
- IFST = I
- ILST = K
- CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- IF( INFO.EQ.0 ) THEN
- I = ILST
- ELSE
- I = K
- END IF
- END IF
- IF( I.EQ.KEND ) THEN
- K = I + 1
- ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
- K = I + 1
- ELSE
- K = I + 2
- END IF
- GO TO 40
- END IF
- GO TO 30
- 50 CONTINUE
- END IF
-*
-* ==== Restore shift/eigenvalue array from T ====
-*
- I = JW
- 60 CONTINUE
- IF( I.GE.INFQR+1 ) THEN
- IF( I.EQ.INFQR+1 ) THEN
- SR( KWTOP+I-1 ) = T( I, I )
- SI( KWTOP+I-1 ) = ZERO
- I = I - 1
- ELSE IF( T( I, I-1 ).EQ.ZERO ) THEN
- SR( KWTOP+I-1 ) = T( I, I )
- SI( KWTOP+I-1 ) = ZERO
- I = I - 1
- ELSE
- AA = T( I-1, I-1 )
- CC = T( I, I-1 )
- BB = T( I-1, I )
- DD = T( I, I )
- CALL DLANV2( AA, BB, CC, DD, SR( KWTOP+I-2 ),
- $ SI( KWTOP+I-2 ), SR( KWTOP+I-1 ),
- $ SI( KWTOP+I-1 ), CS, SN )
- I = I - 2
- END IF
- GO TO 60
- END IF
-*
- IF( NS.LT.JW .OR. S.EQ.ZERO ) THEN
- IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
-*
-* ==== Reflect spike back into lower triangle ====
-*
- CALL DCOPY( NS, V, LDV, WORK, 1 )
- BETA = WORK( 1 )
- CALL DLARFG( NS, BETA, WORK( 2 ), 1, TAU )
- WORK( 1 ) = ONE
-*
- CALL DLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT )
-*
- CALL DLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT,
- $ WORK( JW+1 ) )
- CALL DLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT,
- $ WORK( JW+1 ) )
- CALL DLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV,
- $ WORK( JW+1 ) )
-*
- CALL DGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
- $ LWORK-JW, INFO )
- END IF
-*
-* ==== Copy updated reduced window into place ====
-*
- IF( KWTOP.GT.1 )
- $ H( KWTOP, KWTOP-1 ) = S*V( 1, 1 )
- CALL DLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH )
- CALL DCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP ),
- $ LDH+1 )
-*
-* ==== Accumulate orthogonal matrix in order update
-* . H and Z, if requested. ====
-*
- IF( NS.GT.1 .AND. S.NE.ZERO )
- $ CALL DORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV,
- $ WORK( JW+1 ), LWORK-JW, INFO )
-*
-* ==== Update vertical slab in H ====
-*
- IF( WANTT ) THEN
- LTOP = 1
- ELSE
- LTOP = KTOP
- END IF
- DO 70 KROW = LTOP, KWTOP - 1, NV
- KLN = MIN( NV, KWTOP-KROW )
- CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
- $ LDH, V, LDV, ZERO, WV, LDWV )
- CALL DLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH )
- 70 CONTINUE
-*
-* ==== Update horizontal slab in H ====
-*
- IF( WANTT ) THEN
- DO 80 KCOL = KBOT + 1, N, NH
- KLN = MIN( NH, N-KCOL+1 )
- CALL DGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV,
- $ H( KWTOP, KCOL ), LDH, ZERO, T, LDT )
- CALL DLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ),
- $ LDH )
- 80 CONTINUE
- END IF
-*
-* ==== Update vertical slab in Z ====
-*
- IF( WANTZ ) THEN
- DO 90 KROW = ILOZ, IHIZ, NV
- KLN = MIN( NV, IHIZ-KROW+1 )
- CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
- $ LDZ, V, LDV, ZERO, WV, LDWV )
- CALL DLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ),
- $ LDZ )
- 90 CONTINUE
- END IF
- END IF
-*
-* ==== Return the number of deflations ... ====
-*
- ND = JW - NS
-*
-* ==== ... and the number of shifts. (Subtracting
-* . INFQR from the spike length takes care
-* . of the case of a rare QR failure while
-* . calculating eigenvalues of the deflation
-* . window.) ====
-*
- NS = NS - INFQR
-*
-* ==== Return optimal workspace. ====
-*
- WORK( 1 ) = DBLE( LWKOPT )
-*
-* ==== End of DLAQR2 ====
-*
- END
diff --git a/mtx/lapack_src/dlaqr3.f b/mtx/lapack_src/dlaqr3.f
deleted file mode 100644
index 97890d16e..000000000
--- a/mtx/lapack_src/dlaqr3.f
+++ /dev/null
@@ -1,695 +0,0 @@
-*> \brief \b DLAQR3
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQR3 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
-* IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
-* LDT, NV, WV, LDWV, WORK, LWORK )
-*
-* .. Scalar Arguments ..
-* INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
-* $ LDZ, LWORK, N, ND, NH, NS, NV, NW
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
-* $ V( LDV, * ), WORK( * ), WV( LDWV, * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is LOGICAL
-*> If .TRUE., then the Hessenberg matrix H is fully updated
-*> so that the quasi-triangular Schur factor may be
-*> computed (in cooperation with the calling subroutine).
-*> If .FALSE., then only enough of H is updated to preserve
-*> the eigenvalues.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> If .TRUE., then the orthogonal matrix Z is updated so
-*> so that the orthogonal Schur factor may be computed
-*> (in cooperation with the calling subroutine).
-*> If .FALSE., then Z is not referenced.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H and (if WANTZ is .TRUE.) the
-*> order of the orthogonal matrix Z.
-*> \endverbatim
-*>
-*> \param[in] KTOP
-*> \verbatim
-*> KTOP is INTEGER
-*> It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
-*> KBOT and KTOP together determine an isolated block
-*> along the diagonal of the Hessenberg matrix.
-*> \endverbatim
-*>
-*> \param[in] KBOT
-*> \verbatim
-*> KBOT is INTEGER
-*> It is assumed without a check that either
-*> KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together
-*> determine an isolated block along the diagonal of the
-*> Hessenberg matrix.
-*> \endverbatim
-*>
-*> \param[in] NW
-*> \verbatim
-*> NW is INTEGER
-*> Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1).
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is DOUBLE PRECISION array, dimension (LDH,N)
-*> On input the initial N-by-N section of H stores the
-*> Hessenberg matrix undergoing aggressive early deflation.
-*> On output H has been transformed by an orthogonal
-*> similarity transformation, perturbed, and the returned
-*> to Hessenberg form that (it is to be hoped) has some
-*> zero subdiagonal entries.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is integer
-*> Leading dimension of H just as declared in the calling
-*> subroutine. N .LE. LDH
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,N)
-*> IF WANTZ is .TRUE., then on output, the orthogonal
-*> similarity transformation mentioned above has been
-*> accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
-*> If WANTZ is .FALSE., then Z is unreferenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is integer
-*> The leading dimension of Z just as declared in the
-*> calling subroutine. 1 .LE. LDZ.
-*> \endverbatim
-*>
-*> \param[out] NS
-*> \verbatim
-*> NS is integer
-*> The number of unconverged (ie approximate) eigenvalues
-*> returned in SR and SI that may be used as shifts by the
-*> calling subroutine.
-*> \endverbatim
-*>
-*> \param[out] ND
-*> \verbatim
-*> ND is integer
-*> The number of converged eigenvalues uncovered by this
-*> subroutine.
-*> \endverbatim
-*>
-*> \param[out] SR
-*> \verbatim
-*> SR is DOUBLE PRECISION array, dimension (KBOT)
-*> \endverbatim
-*>
-*> \param[out] SI
-*> \verbatim
-*> SI is DOUBLE PRECISION array, dimension (KBOT)
-*> On output, the real and imaginary parts of approximate
-*> eigenvalues that may be used for shifts are stored in
-*> SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
-*> SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
-*> The real and imaginary parts of converged eigenvalues
-*> are stored in SR(KBOT-ND+1) through SR(KBOT) and
-*> SI(KBOT-ND+1) through SI(KBOT), respectively.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,NW)
-*> An NW-by-NW work array.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is integer scalar
-*> The leading dimension of V just as declared in the
-*> calling subroutine. NW .LE. LDV
-*> \endverbatim
-*>
-*> \param[in] NH
-*> \verbatim
-*> NH is integer scalar
-*> The number of columns of T. NH.GE.NW.
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,NW)
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is integer
-*> The leading dimension of T just as declared in the
-*> calling subroutine. NW .LE. LDT
-*> \endverbatim
-*>
-*> \param[in] NV
-*> \verbatim
-*> NV is integer
-*> The number of rows of work array WV available for
-*> workspace. NV.GE.NW.
-*> \endverbatim
-*>
-*> \param[out] WV
-*> \verbatim
-*> WV is DOUBLE PRECISION array, dimension (LDWV,NW)
-*> \endverbatim
-*>
-*> \param[in] LDWV
-*> \verbatim
-*> LDWV is integer
-*> The leading dimension of W just as declared in the
-*> calling subroutine. NW .LE. LDV
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LWORK)
-*> On exit, WORK(1) is set to an estimate of the optimal value
-*> of LWORK for the given values of N, NW, KTOP and KBOT.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is integer
-*> The dimension of the work array WORK. LWORK = 2*NW
-*> suffices, but greater efficiency may result from larger
-*> values of LWORK.
-*>
-*> If LWORK = -1, then a workspace query is assumed; DLAQR3
-*> only estimates the optimal workspace size for the given
-*> values of N, NW, KTOP and KBOT. The estimate is returned
-*> in WORK(1). No error message related to LWORK is issued
-*> by XERBLA. Neither H nor Z are accessed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*>
-* =====================================================================
- SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
- $ LDT, NV, WV, LDWV, WORK, LWORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
- $ LDZ, LWORK, N, ND, NH, NS, NV, NW
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
- $ V( LDV, * ), WORK( * ), WV( LDWV, * ),
- $ Z( LDZ, * )
-* ..
-*
-* ================================================================
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AA, BB, BETA, CC, CS, DD, EVI, EVK, FOO, S,
- $ SAFMAX, SAFMIN, SMLNUM, SN, TAU, ULP
- INTEGER I, IFST, ILST, INFO, INFQR, J, JW, K, KCOL,
- $ KEND, KLN, KROW, KWTOP, LTOP, LWK1, LWK2, LWK3,
- $ LWKOPT, NMIN
- LOGICAL BULGE, SORTED
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- INTEGER ILAENV
- EXTERNAL DLAMCH, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEHRD, DGEMM, DLABAD, DLACPY, DLAHQR,
- $ DLANV2, DLAQR4, DLARF, DLARFG, DLASET, DORMHR,
- $ DTREXC
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, INT, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* ==== Estimate optimal workspace. ====
-*
- JW = MIN( NW, KBOT-KTOP+1 )
- IF( JW.LE.2 ) THEN
- LWKOPT = 1
- ELSE
-*
-* ==== Workspace query call to DGEHRD ====
-*
- CALL DGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
- LWK1 = INT( WORK( 1 ) )
-*
-* ==== Workspace query call to DORMHR ====
-*
- CALL DORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV,
- $ WORK, -1, INFO )
- LWK2 = INT( WORK( 1 ) )
-*
-* ==== Workspace query call to DLAQR4 ====
-*
- CALL DLAQR4( .true., .true., JW, 1, JW, T, LDT, SR, SI, 1, JW,
- $ V, LDV, WORK, -1, INFQR )
- LWK3 = INT( WORK( 1 ) )
-*
-* ==== Optimal workspace ====
-*
- LWKOPT = MAX( JW+MAX( LWK1, LWK2 ), LWK3 )
- END IF
-*
-* ==== Quick return in case of workspace query. ====
-*
- IF( LWORK.EQ.-1 ) THEN
- WORK( 1 ) = DBLE( LWKOPT )
- RETURN
- END IF
-*
-* ==== Nothing to do ...
-* ... for an empty active block ... ====
- NS = 0
- ND = 0
- WORK( 1 ) = ONE
- IF( KTOP.GT.KBOT )
- $ RETURN
-* ... nor for an empty deflation window. ====
- IF( NW.LT.1 )
- $ RETURN
-*
-* ==== Machine constants ====
-*
- SAFMIN = DLAMCH( 'SAFE MINIMUM' )
- SAFMAX = ONE / SAFMIN
- CALL DLABAD( SAFMIN, SAFMAX )
- ULP = DLAMCH( 'PRECISION' )
- SMLNUM = SAFMIN*( DBLE( N ) / ULP )
-*
-* ==== Setup deflation window ====
-*
- JW = MIN( NW, KBOT-KTOP+1 )
- KWTOP = KBOT - JW + 1
- IF( KWTOP.EQ.KTOP ) THEN
- S = ZERO
- ELSE
- S = H( KWTOP, KWTOP-1 )
- END IF
-*
- IF( KBOT.EQ.KWTOP ) THEN
-*
-* ==== 1-by-1 deflation window: not much to do ====
-*
- SR( KWTOP ) = H( KWTOP, KWTOP )
- SI( KWTOP ) = ZERO
- NS = 1
- ND = 0
- IF( ABS( S ).LE.MAX( SMLNUM, ULP*ABS( H( KWTOP, KWTOP ) ) ) )
- $ THEN
- NS = 0
- ND = 1
- IF( KWTOP.GT.KTOP )
- $ H( KWTOP, KWTOP-1 ) = ZERO
- END IF
- WORK( 1 ) = ONE
- RETURN
- END IF
-*
-* ==== Convert to spike-triangular form. (In case of a
-* . rare QR failure, this routine continues to do
-* . aggressive early deflation using that part of
-* . the deflation window that converged using INFQR
-* . here and there to keep track.) ====
-*
- CALL DLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )
- CALL DCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 )
-*
- CALL DLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
- NMIN = ILAENV( 12, 'DLAQR3', 'SV', JW, 1, JW, LWORK )
- IF( JW.GT.NMIN ) THEN
- CALL DLAQR4( .true., .true., JW, 1, JW, T, LDT, SR( KWTOP ),
- $ SI( KWTOP ), 1, JW, V, LDV, WORK, LWORK, INFQR )
- ELSE
- CALL DLAHQR( .true., .true., JW, 1, JW, T, LDT, SR( KWTOP ),
- $ SI( KWTOP ), 1, JW, V, LDV, INFQR )
- END IF
-*
-* ==== DTREXC needs a clean margin near the diagonal ====
-*
- DO 10 J = 1, JW - 3
- T( J+2, J ) = ZERO
- T( J+3, J ) = ZERO
- 10 CONTINUE
- IF( JW.GT.2 )
- $ T( JW, JW-2 ) = ZERO
-*
-* ==== Deflation detection loop ====
-*
- NS = JW
- ILST = INFQR + 1
- 20 CONTINUE
- IF( ILST.LE.NS ) THEN
- IF( NS.EQ.1 ) THEN
- BULGE = .FALSE.
- ELSE
- BULGE = T( NS, NS-1 ).NE.ZERO
- END IF
-*
-* ==== Small spike tip test for deflation ====
-*
- IF( .NOT. BULGE ) THEN
-*
-* ==== Real eigenvalue ====
-*
- FOO = ABS( T( NS, NS ) )
- IF( FOO.EQ.ZERO )
- $ FOO = ABS( S )
- IF( ABS( S*V( 1, NS ) ).LE.MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-* ==== Deflatable ====
-*
- NS = NS - 1
- ELSE
-*
-* ==== Undeflatable. Move it up out of the way.
-* . (DTREXC can not fail in this case.) ====
-*
- IFST = NS
- CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- ILST = ILST + 1
- END IF
- ELSE
-*
-* ==== Complex conjugate pair ====
-*
- FOO = ABS( T( NS, NS ) ) + SQRT( ABS( T( NS, NS-1 ) ) )*
- $ SQRT( ABS( T( NS-1, NS ) ) )
- IF( FOO.EQ.ZERO )
- $ FOO = ABS( S )
- IF( MAX( ABS( S*V( 1, NS ) ), ABS( S*V( 1, NS-1 ) ) ).LE.
- $ MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-* ==== Deflatable ====
-*
- NS = NS - 2
- ELSE
-*
-* ==== Undeflatable. Move them up out of the way.
-* . Fortunately, DTREXC does the right thing with
-* . ILST in case of a rare exchange failure. ====
-*
- IFST = NS
- CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- ILST = ILST + 2
- END IF
- END IF
-*
-* ==== End deflation detection loop ====
-*
- GO TO 20
- END IF
-*
-* ==== Return to Hessenberg form ====
-*
- IF( NS.EQ.0 )
- $ S = ZERO
-*
- IF( NS.LT.JW ) THEN
-*
-* ==== sorting diagonal blocks of T improves accuracy for
-* . graded matrices. Bubble sort deals well with
-* . exchange failures. ====
-*
- SORTED = .false.
- I = NS + 1
- 30 CONTINUE
- IF( SORTED )
- $ GO TO 50
- SORTED = .true.
-*
- KEND = I - 1
- I = INFQR + 1
- IF( I.EQ.NS ) THEN
- K = I + 1
- ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
- K = I + 1
- ELSE
- K = I + 2
- END IF
- 40 CONTINUE
- IF( K.LE.KEND ) THEN
- IF( K.EQ.I+1 ) THEN
- EVI = ABS( T( I, I ) )
- ELSE
- EVI = ABS( T( I, I ) ) + SQRT( ABS( T( I+1, I ) ) )*
- $ SQRT( ABS( T( I, I+1 ) ) )
- END IF
-*
- IF( K.EQ.KEND ) THEN
- EVK = ABS( T( K, K ) )
- ELSE IF( T( K+1, K ).EQ.ZERO ) THEN
- EVK = ABS( T( K, K ) )
- ELSE
- EVK = ABS( T( K, K ) ) + SQRT( ABS( T( K+1, K ) ) )*
- $ SQRT( ABS( T( K, K+1 ) ) )
- END IF
-*
- IF( EVI.GE.EVK ) THEN
- I = K
- ELSE
- SORTED = .false.
- IFST = I
- ILST = K
- CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
- $ INFO )
- IF( INFO.EQ.0 ) THEN
- I = ILST
- ELSE
- I = K
- END IF
- END IF
- IF( I.EQ.KEND ) THEN
- K = I + 1
- ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
- K = I + 1
- ELSE
- K = I + 2
- END IF
- GO TO 40
- END IF
- GO TO 30
- 50 CONTINUE
- END IF
-*
-* ==== Restore shift/eigenvalue array from T ====
-*
- I = JW
- 60 CONTINUE
- IF( I.GE.INFQR+1 ) THEN
- IF( I.EQ.INFQR+1 ) THEN
- SR( KWTOP+I-1 ) = T( I, I )
- SI( KWTOP+I-1 ) = ZERO
- I = I - 1
- ELSE IF( T( I, I-1 ).EQ.ZERO ) THEN
- SR( KWTOP+I-1 ) = T( I, I )
- SI( KWTOP+I-1 ) = ZERO
- I = I - 1
- ELSE
- AA = T( I-1, I-1 )
- CC = T( I, I-1 )
- BB = T( I-1, I )
- DD = T( I, I )
- CALL DLANV2( AA, BB, CC, DD, SR( KWTOP+I-2 ),
- $ SI( KWTOP+I-2 ), SR( KWTOP+I-1 ),
- $ SI( KWTOP+I-1 ), CS, SN )
- I = I - 2
- END IF
- GO TO 60
- END IF
-*
- IF( NS.LT.JW .OR. S.EQ.ZERO ) THEN
- IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
-*
-* ==== Reflect spike back into lower triangle ====
-*
- CALL DCOPY( NS, V, LDV, WORK, 1 )
- BETA = WORK( 1 )
- CALL DLARFG( NS, BETA, WORK( 2 ), 1, TAU )
- WORK( 1 ) = ONE
-*
- CALL DLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT )
-*
- CALL DLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT,
- $ WORK( JW+1 ) )
- CALL DLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT,
- $ WORK( JW+1 ) )
- CALL DLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV,
- $ WORK( JW+1 ) )
-*
- CALL DGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
- $ LWORK-JW, INFO )
- END IF
-*
-* ==== Copy updated reduced window into place ====
-*
- IF( KWTOP.GT.1 )
- $ H( KWTOP, KWTOP-1 ) = S*V( 1, 1 )
- CALL DLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH )
- CALL DCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP ),
- $ LDH+1 )
-*
-* ==== Accumulate orthogonal matrix in order update
-* . H and Z, if requested. ====
-*
- IF( NS.GT.1 .AND. S.NE.ZERO )
- $ CALL DORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV,
- $ WORK( JW+1 ), LWORK-JW, INFO )
-*
-* ==== Update vertical slab in H ====
-*
- IF( WANTT ) THEN
- LTOP = 1
- ELSE
- LTOP = KTOP
- END IF
- DO 70 KROW = LTOP, KWTOP - 1, NV
- KLN = MIN( NV, KWTOP-KROW )
- CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
- $ LDH, V, LDV, ZERO, WV, LDWV )
- CALL DLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH )
- 70 CONTINUE
-*
-* ==== Update horizontal slab in H ====
-*
- IF( WANTT ) THEN
- DO 80 KCOL = KBOT + 1, N, NH
- KLN = MIN( NH, N-KCOL+1 )
- CALL DGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV,
- $ H( KWTOP, KCOL ), LDH, ZERO, T, LDT )
- CALL DLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ),
- $ LDH )
- 80 CONTINUE
- END IF
-*
-* ==== Update vertical slab in Z ====
-*
- IF( WANTZ ) THEN
- DO 90 KROW = ILOZ, IHIZ, NV
- KLN = MIN( NV, IHIZ-KROW+1 )
- CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
- $ LDZ, V, LDV, ZERO, WV, LDWV )
- CALL DLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ),
- $ LDZ )
- 90 CONTINUE
- END IF
- END IF
-*
-* ==== Return the number of deflations ... ====
-*
- ND = JW - NS
-*
-* ==== ... and the number of shifts. (Subtracting
-* . INFQR from the spike length takes care
-* . of the case of a rare QR failure while
-* . calculating eigenvalues of the deflation
-* . window.) ====
-*
- NS = NS - INFQR
-*
-* ==== Return optimal workspace. ====
-*
- WORK( 1 ) = DBLE( LWKOPT )
-*
-* ==== End of DLAQR3 ====
-*
- END
diff --git a/mtx/lapack_src/dlaqr4.f b/mtx/lapack_src/dlaqr4.f
deleted file mode 100644
index a25c9586c..000000000
--- a/mtx/lapack_src/dlaqr4.f
+++ /dev/null
@@ -1,739 +0,0 @@
-*> \brief \b DLAQR4
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQR4 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
-* ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is LOGICAL
-*> = .TRUE. : the full Schur form T is required;
-*> = .FALSE.: only eigenvalues are required.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is LOGICAL
-*> = .TRUE. : the matrix of Schur vectors Z is required;
-*> = .FALSE.: Schur vectors are not required.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix H. N .GE. 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> It is assumed that H is already upper triangular in rows
-*> and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
-*> H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
-*> previous call to DGEBAL, and then passed to DGEHRD when the
-*> matrix output by DGEBAL is reduced to Hessenberg form.
-*> Otherwise, ILO and IHI should be set to 1 and N,
-*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
-*> If N = 0, then ILO = 1 and IHI = 0.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is DOUBLE PRECISION array, dimension (LDH,N)
-*> On entry, the upper Hessenberg matrix H.
-*> On exit, if INFO = 0 and WANTT is .TRUE., then H contains
-*> the upper quasi-triangular matrix T from the Schur
-*> decomposition (the Schur form); 2-by-2 diagonal blocks
-*> (corresponding to complex conjugate pairs of eigenvalues)
-*> are returned in standard form, with H(i,i) = H(i+1,i+1)
-*> and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
-*> .FALSE., then the contents of H are unspecified on exit.
-*> (The output value of H when INFO.GT.0 is given under the
-*> description of INFO below.)
-*>
-*> This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
-*> j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is INTEGER
-*> The leading dimension of the array H. LDH .GE. max(1,N).
-*> \endverbatim
-*>
-*> \param[out] WR
-*> \verbatim
-*> WR is DOUBLE PRECISION array, dimension (IHI)
-*> \endverbatim
-*>
-*> \param[out] WI
-*> \verbatim
-*> WI is DOUBLE PRECISION array, dimension (IHI)
-*> The real and imaginary parts, respectively, of the computed
-*> eigenvalues of H(ILO:IHI,ILO:IHI) are stored in WR(ILO:IHI)
-*> and WI(ILO:IHI). If two eigenvalues are computed as a
-*> complex conjugate pair, they are stored in consecutive
-*> elements of WR and WI, say the i-th and (i+1)th, with
-*> WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
-*> the eigenvalues are stored in the same order as on the
-*> diagonal of the Schur form returned in H, with
-*> WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
-*> block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
-*> WI(i+1) = -WI(i).
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE..
-*> 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension (LDZ,IHI)
-*> If WANTZ is .FALSE., then Z is not referenced.
-*> If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
-*> replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
-*> orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
-*> (The output value of Z when INFO.GT.0 is given under
-*> the description of INFO below.)
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is INTEGER
-*> The leading dimension of the array Z. if WANTZ is .TRUE.
-*> then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension LWORK
-*> On exit, if LWORK = -1, WORK(1) returns an estimate of
-*> the optimal value for LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK .GE. max(1,N)
-*> is sufficient, but LWORK typically as large as 6*N may
-*> be required for optimal performance. A workspace query
-*> to determine the optimal workspace size is recommended.
-*>
-*> If LWORK = -1, then DLAQR4 does a workspace query.
-*> In this case, DLAQR4 checks the input parameters and
-*> estimates the optimal workspace size for the given
-*> values of N, ILO and IHI. The estimate is returned
-*> in WORK(1). No error message related to LWORK is
-*> issued by XERBLA. Neither H nor Z are accessed.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> .GT. 0: if INFO = i, DLAQR4 failed to compute all of
-*> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
-*> and WI contain those eigenvalues which have been
-*> successfully computed. (Failures are rare.)
-*>
-*> If INFO .GT. 0 and WANT is .FALSE., then on exit,
-*> the remaining unconverged eigenvalues are the eigen-
-*> values of the upper Hessenberg matrix rows and
-*> columns ILO through INFO of the final, output
-*> value of H.
-*>
-*> If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*>
-*> (*) (initial value of H)*U = U*(final value of H)
-*>
-*> where U is a orthogonal matrix. The final
-*> value of H is upper Hessenberg and triangular in
-*> rows and columns INFO+1 through IHI.
-*>
-*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*>
-*> (final value of Z(ILO:IHI,ILOZ:IHIZ)
-*> = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
-*>
-*> where U is the orthogonal matrix in (*) (regard-
-*> less of the value of WANTT.)
-*>
-*> If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
-*> accessed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*
-*> \par References:
-* ================
-*>
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*> Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*> 929--947, 2002.
-*> \n
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part II: Aggressive Early Deflation, SIAM Journal
-*> of Matrix Analysis, volume 23, pages 948--973, 2002.
-*>
-* =====================================================================
- SUBROUTINE DLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
- $ ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ),
- $ Z( LDZ, * )
-* ..
-*
-* ================================================================
-* .. Parameters ..
-*
-* ==== Matrices of order NTINY or smaller must be processed by
-* . DLAHQR because of insufficient subdiagonal scratch space.
-* . (This is a hard limit.) ====
- INTEGER NTINY
- PARAMETER ( NTINY = 11 )
-*
-* ==== Exceptional deflation windows: try to cure rare
-* . slow convergence by varying the size of the
-* . deflation window after KEXNW iterations. ====
- INTEGER KEXNW
- PARAMETER ( KEXNW = 5 )
-*
-* ==== Exceptional shifts: try to cure rare slow convergence
-* . with ad-hoc exceptional shifts every KEXSH iterations.
-* . ====
- INTEGER KEXSH
- PARAMETER ( KEXSH = 6 )
-*
-* ==== The constants WILK1 and WILK2 are used to form the
-* . exceptional shifts. ====
- DOUBLE PRECISION WILK1, WILK2
- PARAMETER ( WILK1 = 0.75d0, WILK2 = -0.4375d0 )
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AA, BB, CC, CS, DD, SN, SS, SWAP
- INTEGER I, INF, IT, ITMAX, K, KACC22, KBOT, KDU, KS,
- $ KT, KTOP, KU, KV, KWH, KWTOP, KWV, LD, LS,
- $ LWKOPT, NDEC, NDFL, NH, NHO, NIBBLE, NMIN, NS,
- $ NSMAX, NSR, NVE, NW, NWMAX, NWR, NWUPBD
- LOGICAL SORTED
- CHARACTER JBCMPZ*2
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION ZDUM( 1, 1 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DLACPY, DLAHQR, DLANV2, DLAQR2, DLAQR5
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, INT, MAX, MIN, MOD
-* ..
-* .. Executable Statements ..
- INFO = 0
-*
-* ==== Quick return for N = 0: nothing to do. ====
-*
- IF( N.EQ.0 ) THEN
- WORK( 1 ) = ONE
- RETURN
- END IF
-*
- IF( N.LE.NTINY ) THEN
-*
-* ==== Tiny matrices must use DLAHQR. ====
-*
- LWKOPT = 1
- IF( LWORK.NE.-1 )
- $ CALL DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
- $ ILOZ, IHIZ, Z, LDZ, INFO )
- ELSE
-*
-* ==== Use small bulge multi-shift QR with aggressive early
-* . deflation on larger-than-tiny matrices. ====
-*
-* ==== Hope for the best. ====
-*
- INFO = 0
-*
-* ==== Set up job flags for ILAENV. ====
-*
- IF( WANTT ) THEN
- JBCMPZ( 1: 1 ) = 'S'
- ELSE
- JBCMPZ( 1: 1 ) = 'E'
- END IF
- IF( WANTZ ) THEN
- JBCMPZ( 2: 2 ) = 'V'
- ELSE
- JBCMPZ( 2: 2 ) = 'N'
- END IF
-*
-* ==== NWR = recommended deflation window size. At this
-* . point, N .GT. NTINY = 11, so there is enough
-* . subdiagonal workspace for NWR.GE.2 as required.
-* . (In fact, there is enough subdiagonal space for
-* . NWR.GE.3.) ====
-*
- NWR = ILAENV( 13, 'DLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
- NWR = MAX( 2, NWR )
- NWR = MIN( IHI-ILO+1, ( N-1 ) / 3, NWR )
-*
-* ==== NSR = recommended number of simultaneous shifts.
-* . At this point N .GT. NTINY = 11, so there is at
-* . enough subdiagonal workspace for NSR to be even
-* . and greater than or equal to two as required. ====
-*
- NSR = ILAENV( 15, 'DLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
- NSR = MIN( NSR, ( N+6 ) / 9, IHI-ILO )
- NSR = MAX( 2, NSR-MOD( NSR, 2 ) )
-*
-* ==== Estimate optimal workspace ====
-*
-* ==== Workspace query call to DLAQR2 ====
-*
- CALL DLAQR2( WANTT, WANTZ, N, ILO, IHI, NWR+1, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, LS, LD, WR, WI, H, LDH, N, H, LDH,
- $ N, H, LDH, WORK, -1 )
-*
-* ==== Optimal workspace = MAX(DLAQR5, DLAQR2) ====
-*
- LWKOPT = MAX( 3*NSR / 2, INT( WORK( 1 ) ) )
-*
-* ==== Quick return in case of workspace query. ====
-*
- IF( LWORK.EQ.-1 ) THEN
- WORK( 1 ) = DBLE( LWKOPT )
- RETURN
- END IF
-*
-* ==== DLAHQR/DLAQR0 crossover point ====
-*
- NMIN = ILAENV( 12, 'DLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
- NMIN = MAX( NTINY, NMIN )
-*
-* ==== Nibble crossover point ====
-*
- NIBBLE = ILAENV( 14, 'DLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
- NIBBLE = MAX( 0, NIBBLE )
-*
-* ==== Accumulate reflections during ttswp? Use block
-* . 2-by-2 structure during matrix-matrix multiply? ====
-*
- KACC22 = ILAENV( 16, 'DLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
- KACC22 = MAX( 0, KACC22 )
- KACC22 = MIN( 2, KACC22 )
-*
-* ==== NWMAX = the largest possible deflation window for
-* . which there is sufficient workspace. ====
-*
- NWMAX = MIN( ( N-1 ) / 3, LWORK / 2 )
- NW = NWMAX
-*
-* ==== NSMAX = the Largest number of simultaneous shifts
-* . for which there is sufficient workspace. ====
-*
- NSMAX = MIN( ( N+6 ) / 9, 2*LWORK / 3 )
- NSMAX = NSMAX - MOD( NSMAX, 2 )
-*
-* ==== NDFL: an iteration count restarted at deflation. ====
-*
- NDFL = 1
-*
-* ==== ITMAX = iteration limit ====
-*
- ITMAX = MAX( 30, 2*KEXSH )*MAX( 10, ( IHI-ILO+1 ) )
-*
-* ==== Last row and column in the active block ====
-*
- KBOT = IHI
-*
-* ==== Main Loop ====
-*
- DO 80 IT = 1, ITMAX
-*
-* ==== Done when KBOT falls below ILO ====
-*
- IF( KBOT.LT.ILO )
- $ GO TO 90
-*
-* ==== Locate active block ====
-*
- DO 10 K = KBOT, ILO + 1, -1
- IF( H( K, K-1 ).EQ.ZERO )
- $ GO TO 20
- 10 CONTINUE
- K = ILO
- 20 CONTINUE
- KTOP = K
-*
-* ==== Select deflation window size:
-* . Typical Case:
-* . If possible and advisable, nibble the entire
-* . active block. If not, use size MIN(NWR,NWMAX)
-* . or MIN(NWR+1,NWMAX) depending upon which has
-* . the smaller corresponding subdiagonal entry
-* . (a heuristic).
-* .
-* . Exceptional Case:
-* . If there have been no deflations in KEXNW or
-* . more iterations, then vary the deflation window
-* . size. At first, because, larger windows are,
-* . in general, more powerful than smaller ones,
-* . rapidly increase the window to the maximum possible.
-* . Then, gradually reduce the window size. ====
-*
- NH = KBOT - KTOP + 1
- NWUPBD = MIN( NH, NWMAX )
- IF( NDFL.LT.KEXNW ) THEN
- NW = MIN( NWUPBD, NWR )
- ELSE
- NW = MIN( NWUPBD, 2*NW )
- END IF
- IF( NW.LT.NWMAX ) THEN
- IF( NW.GE.NH-1 ) THEN
- NW = NH
- ELSE
- KWTOP = KBOT - NW + 1
- IF( ABS( H( KWTOP, KWTOP-1 ) ).GT.
- $ ABS( H( KWTOP-1, KWTOP-2 ) ) )NW = NW + 1
- END IF
- END IF
- IF( NDFL.LT.KEXNW ) THEN
- NDEC = -1
- ELSE IF( NDEC.GE.0 .OR. NW.GE.NWUPBD ) THEN
- NDEC = NDEC + 1
- IF( NW-NDEC.LT.2 )
- $ NDEC = 0
- NW = NW - NDEC
- END IF
-*
-* ==== Aggressive early deflation:
-* . split workspace under the subdiagonal into
-* . - an nw-by-nw work array V in the lower
-* . left-hand-corner,
-* . - an NW-by-at-least-NW-but-more-is-better
-* . (NW-by-NHO) horizontal work array along
-* . the bottom edge,
-* . - an at-least-NW-but-more-is-better (NHV-by-NW)
-* . vertical work array along the left-hand-edge.
-* . ====
-*
- KV = N - NW + 1
- KT = NW + 1
- NHO = ( N-NW-1 ) - KT + 1
- KWV = NW + 2
- NVE = ( N-NW ) - KWV + 1
-*
-* ==== Aggressive early deflation ====
-*
- CALL DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
- $ IHIZ, Z, LDZ, LS, LD, WR, WI, H( KV, 1 ), LDH,
- $ NHO, H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH,
- $ WORK, LWORK )
-*
-* ==== Adjust KBOT accounting for new deflations. ====
-*
- KBOT = KBOT - LD
-*
-* ==== KS points to the shifts. ====
-*
- KS = KBOT - LS + 1
-*
-* ==== Skip an expensive QR sweep if there is a (partly
-* . heuristic) reason to expect that many eigenvalues
-* . will deflate without it. Here, the QR sweep is
-* . skipped if many eigenvalues have just been deflated
-* . or if the remaining active block is small.
-*
- IF( ( LD.EQ.0 ) .OR. ( ( 100*LD.LE.NW*NIBBLE ) .AND. ( KBOT-
- $ KTOP+1.GT.MIN( NMIN, NWMAX ) ) ) ) THEN
-*
-* ==== NS = nominal number of simultaneous shifts.
-* . This may be lowered (slightly) if DLAQR2
-* . did not provide that many shifts. ====
-*
- NS = MIN( NSMAX, NSR, MAX( 2, KBOT-KTOP ) )
- NS = NS - MOD( NS, 2 )
-*
-* ==== If there have been no deflations
-* . in a multiple of KEXSH iterations,
-* . then try exceptional shifts.
-* . Otherwise use shifts provided by
-* . DLAQR2 above or from the eigenvalues
-* . of a trailing principal submatrix. ====
-*
- IF( MOD( NDFL, KEXSH ).EQ.0 ) THEN
- KS = KBOT - NS + 1
- DO 30 I = KBOT, MAX( KS+1, KTOP+2 ), -2
- SS = ABS( H( I, I-1 ) ) + ABS( H( I-1, I-2 ) )
- AA = WILK1*SS + H( I, I )
- BB = SS
- CC = WILK2*SS
- DD = AA
- CALL DLANV2( AA, BB, CC, DD, WR( I-1 ), WI( I-1 ),
- $ WR( I ), WI( I ), CS, SN )
- 30 CONTINUE
- IF( KS.EQ.KTOP ) THEN
- WR( KS+1 ) = H( KS+1, KS+1 )
- WI( KS+1 ) = ZERO
- WR( KS ) = WR( KS+1 )
- WI( KS ) = WI( KS+1 )
- END IF
- ELSE
-*
-* ==== Got NS/2 or fewer shifts? Use DLAHQR
-* . on a trailing principal submatrix to
-* . get more. (Since NS.LE.NSMAX.LE.(N+6)/9,
-* . there is enough space below the subdiagonal
-* . to fit an NS-by-NS scratch array.) ====
-*
- IF( KBOT-KS+1.LE.NS / 2 ) THEN
- KS = KBOT - NS + 1
- KT = N - NS + 1
- CALL DLACPY( 'A', NS, NS, H( KS, KS ), LDH,
- $ H( KT, 1 ), LDH )
- CALL DLAHQR( .false., .false., NS, 1, NS,
- $ H( KT, 1 ), LDH, WR( KS ), WI( KS ),
- $ 1, 1, ZDUM, 1, INF )
- KS = KS + INF
-*
-* ==== In case of a rare QR failure use
-* . eigenvalues of the trailing 2-by-2
-* . principal submatrix. ====
-*
- IF( KS.GE.KBOT ) THEN
- AA = H( KBOT-1, KBOT-1 )
- CC = H( KBOT, KBOT-1 )
- BB = H( KBOT-1, KBOT )
- DD = H( KBOT, KBOT )
- CALL DLANV2( AA, BB, CC, DD, WR( KBOT-1 ),
- $ WI( KBOT-1 ), WR( KBOT ),
- $ WI( KBOT ), CS, SN )
- KS = KBOT - 1
- END IF
- END IF
-*
- IF( KBOT-KS+1.GT.NS ) THEN
-*
-* ==== Sort the shifts (Helps a little)
-* . Bubble sort keeps complex conjugate
-* . pairs together. ====
-*
- SORTED = .false.
- DO 50 K = KBOT, KS + 1, -1
- IF( SORTED )
- $ GO TO 60
- SORTED = .true.
- DO 40 I = KS, K - 1
- IF( ABS( WR( I ) )+ABS( WI( I ) ).LT.
- $ ABS( WR( I+1 ) )+ABS( WI( I+1 ) ) ) THEN
- SORTED = .false.
-*
- SWAP = WR( I )
- WR( I ) = WR( I+1 )
- WR( I+1 ) = SWAP
-*
- SWAP = WI( I )
- WI( I ) = WI( I+1 )
- WI( I+1 ) = SWAP
- END IF
- 40 CONTINUE
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
-* ==== Shuffle shifts into pairs of real shifts
-* . and pairs of complex conjugate shifts
-* . assuming complex conjugate shifts are
-* . already adjacent to one another. (Yes,
-* . they are.) ====
-*
- DO 70 I = KBOT, KS + 2, -2
- IF( WI( I ).NE.-WI( I-1 ) ) THEN
-*
- SWAP = WR( I )
- WR( I ) = WR( I-1 )
- WR( I-1 ) = WR( I-2 )
- WR( I-2 ) = SWAP
-*
- SWAP = WI( I )
- WI( I ) = WI( I-1 )
- WI( I-1 ) = WI( I-2 )
- WI( I-2 ) = SWAP
- END IF
- 70 CONTINUE
- END IF
-*
-* ==== If there are only two shifts and both are
-* . real, then use only one. ====
-*
- IF( KBOT-KS+1.EQ.2 ) THEN
- IF( WI( KBOT ).EQ.ZERO ) THEN
- IF( ABS( WR( KBOT )-H( KBOT, KBOT ) ).LT.
- $ ABS( WR( KBOT-1 )-H( KBOT, KBOT ) ) ) THEN
- WR( KBOT-1 ) = WR( KBOT )
- ELSE
- WR( KBOT ) = WR( KBOT-1 )
- END IF
- END IF
- END IF
-*
-* ==== Use up to NS of the the smallest magnatiude
-* . shifts. If there aren't NS shifts available,
-* . then use them all, possibly dropping one to
-* . make the number of shifts even. ====
-*
- NS = MIN( NS, KBOT-KS+1 )
- NS = NS - MOD( NS, 2 )
- KS = KBOT - NS + 1
-*
-* ==== Small-bulge multi-shift QR sweep:
-* . split workspace under the subdiagonal into
-* . - a KDU-by-KDU work array U in the lower
-* . left-hand-corner,
-* . - a KDU-by-at-least-KDU-but-more-is-better
-* . (KDU-by-NHo) horizontal work array WH along
-* . the bottom edge,
-* . - and an at-least-KDU-but-more-is-better-by-KDU
-* . (NVE-by-KDU) vertical work WV arrow along
-* . the left-hand-edge. ====
-*
- KDU = 3*NS - 3
- KU = N - KDU + 1
- KWH = KDU + 1
- NHO = ( N-KDU+1-4 ) - ( KDU+1 ) + 1
- KWV = KDU + 4
- NVE = N - KDU - KWV + 1
-*
-* ==== Small-bulge multi-shift QR sweep ====
-*
- CALL DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NS,
- $ WR( KS ), WI( KS ), H, LDH, ILOZ, IHIZ, Z,
- $ LDZ, WORK, 3, H( KU, 1 ), LDH, NVE,
- $ H( KWV, 1 ), LDH, NHO, H( KU, KWH ), LDH )
- END IF
-*
-* ==== Note progress (or the lack of it). ====
-*
- IF( LD.GT.0 ) THEN
- NDFL = 1
- ELSE
- NDFL = NDFL + 1
- END IF
-*
-* ==== End of main loop ====
- 80 CONTINUE
-*
-* ==== Iteration limit exceeded. Set INFO to show where
-* . the problem occurred and exit. ====
-*
- INFO = KBOT
- 90 CONTINUE
- END IF
-*
-* ==== Return the optimal value of LWORK. ====
-*
- WORK( 1 ) = DBLE( LWKOPT )
-*
-* ==== End of DLAQR4 ====
-*
- END
diff --git a/mtx/lapack_src/dlaqr5.f b/mtx/lapack_src/dlaqr5.f
deleted file mode 100644
index 9fa954147..000000000
--- a/mtx/lapack_src/dlaqr5.f
+++ /dev/null
@@ -1,921 +0,0 @@
-*> \brief \b DLAQR5
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAQR5 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
-* SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U,
-* LDU, NV, WV, LDWV, NH, WH, LDWH )
-*
-* .. Scalar Arguments ..
-* INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV,
-* $ LDWH, LDWV, LDZ, N, NH, NSHFTS, NV
-* LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION H( LDH, * ), SI( * ), SR( * ), U( LDU, * ),
-* $ V( LDV, * ), WH( LDWH, * ), WV( LDWV, * ),
-* $ Z( LDZ, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLAQR5, called by DLAQR0, performs a
-*> single small-bulge multi-shift QR sweep.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] WANTT
-*> \verbatim
-*> WANTT is logical scalar
-*> WANTT = .true. if the quasi-triangular Schur factor
-*> is being computed. WANTT is set to .false. otherwise.
-*> \endverbatim
-*>
-*> \param[in] WANTZ
-*> \verbatim
-*> WANTZ is logical scalar
-*> WANTZ = .true. if the orthogonal Schur factor is being
-*> computed. WANTZ is set to .false. otherwise.
-*> \endverbatim
-*>
-*> \param[in] KACC22
-*> \verbatim
-*> KACC22 is integer with value 0, 1, or 2.
-*> Specifies the computation mode of far-from-diagonal
-*> orthogonal updates.
-*> = 0: DLAQR5 does not accumulate reflections and does not
-*> use matrix-matrix multiply to update far-from-diagonal
-*> matrix entries.
-*> = 1: DLAQR5 accumulates reflections and uses matrix-matrix
-*> multiply to update the far-from-diagonal matrix entries.
-*> = 2: DLAQR5 accumulates reflections, uses matrix-matrix
-*> multiply to update the far-from-diagonal matrix entries,
-*> and takes advantage of 2-by-2 block structure during
-*> matrix multiplies.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is integer scalar
-*> N is the order of the Hessenberg matrix H upon which this
-*> subroutine operates.
-*> \endverbatim
-*>
-*> \param[in] KTOP
-*> \verbatim
-*> KTOP is integer scalar
-*> \endverbatim
-*>
-*> \param[in] KBOT
-*> \verbatim
-*> KBOT is integer scalar
-*> These are the first and last rows and columns of an
-*> isolated diagonal block upon which the QR sweep is to be
-*> applied. It is assumed without a check that
-*> either KTOP = 1 or H(KTOP,KTOP-1) = 0
-*> and
-*> either KBOT = N or H(KBOT+1,KBOT) = 0.
-*> \endverbatim
-*>
-*> \param[in] NSHFTS
-*> \verbatim
-*> NSHFTS is integer scalar
-*> NSHFTS gives the number of simultaneous shifts. NSHFTS
-*> must be positive and even.
-*> \endverbatim
-*>
-*> \param[in,out] SR
-*> \verbatim
-*> SR is DOUBLE PRECISION array of size (NSHFTS)
-*> \endverbatim
-*>
-*> \param[in,out] SI
-*> \verbatim
-*> SI is DOUBLE PRECISION array of size (NSHFTS)
-*> SR contains the real parts and SI contains the imaginary
-*> parts of the NSHFTS shifts of origin that define the
-*> multi-shift QR sweep. On output SR and SI may be
-*> reordered.
-*> \endverbatim
-*>
-*> \param[in,out] H
-*> \verbatim
-*> H is DOUBLE PRECISION array of size (LDH,N)
-*> On input H contains a Hessenberg matrix. On output a
-*> multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied
-*> to the isolated diagonal block in rows and columns KTOP
-*> through KBOT.
-*> \endverbatim
-*>
-*> \param[in] LDH
-*> \verbatim
-*> LDH is integer scalar
-*> LDH is the leading dimension of H just as declared in the
-*> calling procedure. LDH.GE.MAX(1,N).
-*> \endverbatim
-*>
-*> \param[in] ILOZ
-*> \verbatim
-*> ILOZ is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHIZ
-*> \verbatim
-*> IHIZ is INTEGER
-*> Specify the rows of Z to which transformations must be
-*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array of size (LDZ,IHI)
-*> If WANTZ = .TRUE., then the QR Sweep orthogonal
-*> similarity transformation is accumulated into
-*> Z(ILOZ:IHIZ,ILO:IHI) from the right.
-*> If WANTZ = .FALSE., then Z is unreferenced.
-*> \endverbatim
-*>
-*> \param[in] LDZ
-*> \verbatim
-*> LDZ is integer scalar
-*> LDA is the leading dimension of Z just as declared in
-*> the calling procedure. LDZ.GE.N.
-*> \endverbatim
-*>
-*> \param[out] V
-*> \verbatim
-*> V is DOUBLE PRECISION array of size (LDV,NSHFTS/2)
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is integer scalar
-*> LDV is the leading dimension of V as declared in the
-*> calling procedure. LDV.GE.3.
-*> \endverbatim
-*>
-*> \param[out] U
-*> \verbatim
-*> U is DOUBLE PRECISION array of size
-*> (LDU,3*NSHFTS-3)
-*> \endverbatim
-*>
-*> \param[in] LDU
-*> \verbatim
-*> LDU is integer scalar
-*> LDU is the leading dimension of U just as declared in the
-*> in the calling subroutine. LDU.GE.3*NSHFTS-3.
-*> \endverbatim
-*>
-*> \param[in] NH
-*> \verbatim
-*> NH is integer scalar
-*> NH is the number of columns in array WH available for
-*> workspace. NH.GE.1.
-*> \endverbatim
-*>
-*> \param[out] WH
-*> \verbatim
-*> WH is DOUBLE PRECISION array of size (LDWH,NH)
-*> \endverbatim
-*>
-*> \param[in] LDWH
-*> \verbatim
-*> LDWH is integer scalar
-*> Leading dimension of WH just as declared in the
-*> calling procedure. LDWH.GE.3*NSHFTS-3.
-*> \endverbatim
-*>
-*> \param[in] NV
-*> \verbatim
-*> NV is integer scalar
-*> NV is the number of rows in WV agailable for workspace.
-*> NV.GE.1.
-*> \endverbatim
-*>
-*> \param[out] WV
-*> \verbatim
-*> WV is DOUBLE PRECISION array of size
-*> (LDWV,3*NSHFTS-3)
-*> \endverbatim
-*>
-*> \param[in] LDWV
-*> \verbatim
-*> LDWV is integer scalar
-*> LDWV is the leading dimension of WV as declared in the
-*> in the calling subroutine. LDWV.GE.NV.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Karen Braman and Ralph Byers, Department of Mathematics,
-*> University of Kansas, USA
-*
-*> \par References:
-* ================
-*>
-*> K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*> Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*> Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*> 929--947, 2002.
-*>
-* =====================================================================
- SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
- $ SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U,
- $ LDU, NV, WV, LDWV, NH, WH, LDWH )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV,
- $ LDWH, LDWV, LDZ, N, NH, NSHFTS, NV
- LOGICAL WANTT, WANTZ
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION H( LDH, * ), SI( * ), SR( * ), U( LDU, * ),
- $ V( LDV, * ), WH( LDWH, * ), WV( LDWV, * ),
- $ Z( LDZ, * )
-* ..
-*
-* ================================================================
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0d0, ONE = 1.0d0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION ALPHA, BETA, H11, H12, H21, H22, REFSUM,
- $ SAFMAX, SAFMIN, SCL, SMLNUM, SWAP, TST1, TST2,
- $ ULP
- INTEGER I, I2, I4, INCOL, J, J2, J4, JBOT, JCOL, JLEN,
- $ JROW, JTOP, K, K1, KDU, KMS, KNZ, KRCOL, KZS,
- $ M, M22, MBOT, MEND, MSTART, MTOP, NBMPS, NDCOL,
- $ NS, NU
- LOGICAL ACCUM, BLK22, BMP22
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
-*
- INTRINSIC ABS, DBLE, MAX, MIN, MOD
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION VT( 3 )
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMM, DLABAD, DLACPY, DLAQR1, DLARFG, DLASET,
- $ DTRMM
-* ..
-* .. Executable Statements ..
-*
-* ==== If there are no shifts, then there is nothing to do. ====
-*
- IF( NSHFTS.LT.2 )
- $ RETURN
-*
-* ==== If the active block is empty or 1-by-1, then there
-* . is nothing to do. ====
-*
- IF( KTOP.GE.KBOT )
- $ RETURN
-*
-* ==== Shuffle shifts into pairs of real shifts and pairs
-* . of complex conjugate shifts assuming complex
-* . conjugate shifts are already adjacent to one
-* . another. ====
-*
- DO 10 I = 1, NSHFTS - 2, 2
- IF( SI( I ).NE.-SI( I+1 ) ) THEN
-*
- SWAP = SR( I )
- SR( I ) = SR( I+1 )
- SR( I+1 ) = SR( I+2 )
- SR( I+2 ) = SWAP
-*
- SWAP = SI( I )
- SI( I ) = SI( I+1 )
- SI( I+1 ) = SI( I+2 )
- SI( I+2 ) = SWAP
- END IF
- 10 CONTINUE
-*
-* ==== NSHFTS is supposed to be even, but if it is odd,
-* . then simply reduce it by one. The shuffle above
-* . ensures that the dropped shift is real and that
-* . the remaining shifts are paired. ====
-*
- NS = NSHFTS - MOD( NSHFTS, 2 )
-*
-* ==== Machine constants for deflation ====
-*
- SAFMIN = DLAMCH( 'SAFE MINIMUM' )
- SAFMAX = ONE / SAFMIN
- CALL DLABAD( SAFMIN, SAFMAX )
- ULP = DLAMCH( 'PRECISION' )
- SMLNUM = SAFMIN*( DBLE( N ) / ULP )
-*
-* ==== Use accumulated reflections to update far-from-diagonal
-* . entries ? ====
-*
- ACCUM = ( KACC22.EQ.1 ) .OR. ( KACC22.EQ.2 )
-*
-* ==== If so, exploit the 2-by-2 block structure? ====
-*
- BLK22 = ( NS.GT.2 ) .AND. ( KACC22.EQ.2 )
-*
-* ==== clear trash ====
-*
- IF( KTOP+2.LE.KBOT )
- $ H( KTOP+2, KTOP ) = ZERO
-*
-* ==== NBMPS = number of 2-shift bulges in the chain ====
-*
- NBMPS = NS / 2
-*
-* ==== KDU = width of slab ====
-*
- KDU = 6*NBMPS - 3
-*
-* ==== Create and chase chains of NBMPS bulges ====
-*
- DO 220 INCOL = 3*( 1-NBMPS ) + KTOP - 1, KBOT - 2, 3*NBMPS - 2
- NDCOL = INCOL + KDU
- IF( ACCUM )
- $ CALL DLASET( 'ALL', KDU, KDU, ZERO, ONE, U, LDU )
-*
-* ==== Near-the-diagonal bulge chase. The following loop
-* . performs the near-the-diagonal part of a small bulge
-* . multi-shift QR sweep. Each 6*NBMPS-2 column diagonal
-* . chunk extends from column INCOL to column NDCOL
-* . (including both column INCOL and column NDCOL). The
-* . following loop chases a 3*NBMPS column long chain of
-* . NBMPS bulges 3*NBMPS-2 columns to the right. (INCOL
-* . may be less than KTOP and and NDCOL may be greater than
-* . KBOT indicating phantom columns from which to chase
-* . bulges before they are actually introduced or to which
-* . to chase bulges beyond column KBOT.) ====
-*
- DO 150 KRCOL = INCOL, MIN( INCOL+3*NBMPS-3, KBOT-2 )
-*
-* ==== Bulges number MTOP to MBOT are active double implicit
-* . shift bulges. There may or may not also be small
-* . 2-by-2 bulge, if there is room. The inactive bulges
-* . (if any) must wait until the active bulges have moved
-* . down the diagonal to make room. The phantom matrix
-* . paradigm described above helps keep track. ====
-*
- MTOP = MAX( 1, ( ( KTOP-1 )-KRCOL+2 ) / 3+1 )
- MBOT = MIN( NBMPS, ( KBOT-KRCOL ) / 3 )
- M22 = MBOT + 1
- BMP22 = ( MBOT.LT.NBMPS ) .AND. ( KRCOL+3*( M22-1 ) ).EQ.
- $ ( KBOT-2 )
-*
-* ==== Generate reflections to chase the chain right
-* . one column. (The minimum value of K is KTOP-1.) ====
-*
- DO 20 M = MTOP, MBOT
- K = KRCOL + 3*( M-1 )
- IF( K.EQ.KTOP-1 ) THEN
- CALL DLAQR1( 3, H( KTOP, KTOP ), LDH, SR( 2*M-1 ),
- $ SI( 2*M-1 ), SR( 2*M ), SI( 2*M ),
- $ V( 1, M ) )
- ALPHA = V( 1, M )
- CALL DLARFG( 3, ALPHA, V( 2, M ), 1, V( 1, M ) )
- ELSE
- BETA = H( K+1, K )
- V( 2, M ) = H( K+2, K )
- V( 3, M ) = H( K+3, K )
- CALL DLARFG( 3, BETA, V( 2, M ), 1, V( 1, M ) )
-*
-* ==== A Bulge may collapse because of vigilant
-* . deflation or destructive underflow. In the
-* . underflow case, try the two-small-subdiagonals
-* . trick to try to reinflate the bulge. ====
-*
- IF( H( K+3, K ).NE.ZERO .OR. H( K+3, K+1 ).NE.
- $ ZERO .OR. H( K+3, K+2 ).EQ.ZERO ) THEN
-*
-* ==== Typical case: not collapsed (yet). ====
-*
- H( K+1, K ) = BETA
- H( K+2, K ) = ZERO
- H( K+3, K ) = ZERO
- ELSE
-*
-* ==== Atypical case: collapsed. Attempt to
-* . reintroduce ignoring H(K+1,K) and H(K+2,K).
-* . If the fill resulting from the new
-* . reflector is too large, then abandon it.
-* . Otherwise, use the new one. ====
-*
- CALL DLAQR1( 3, H( K+1, K+1 ), LDH, SR( 2*M-1 ),
- $ SI( 2*M-1 ), SR( 2*M ), SI( 2*M ),
- $ VT )
- ALPHA = VT( 1 )
- CALL DLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )
- REFSUM = VT( 1 )*( H( K+1, K )+VT( 2 )*
- $ H( K+2, K ) )
-*
- IF( ABS( H( K+2, K )-REFSUM*VT( 2 ) )+
- $ ABS( REFSUM*VT( 3 ) ).GT.ULP*
- $ ( ABS( H( K, K ) )+ABS( H( K+1,
- $ K+1 ) )+ABS( H( K+2, K+2 ) ) ) ) THEN
-*
-* ==== Starting a new bulge here would
-* . create non-negligible fill. Use
-* . the old one with trepidation. ====
-*
- H( K+1, K ) = BETA
- H( K+2, K ) = ZERO
- H( K+3, K ) = ZERO
- ELSE
-*
-* ==== Stating a new bulge here would
-* . create only negligible fill.
-* . Replace the old reflector with
-* . the new one. ====
-*
- H( K+1, K ) = H( K+1, K ) - REFSUM
- H( K+2, K ) = ZERO
- H( K+3, K ) = ZERO
- V( 1, M ) = VT( 1 )
- V( 2, M ) = VT( 2 )
- V( 3, M ) = VT( 3 )
- END IF
- END IF
- END IF
- 20 CONTINUE
-*
-* ==== Generate a 2-by-2 reflection, if needed. ====
-*
- K = KRCOL + 3*( M22-1 )
- IF( BMP22 ) THEN
- IF( K.EQ.KTOP-1 ) THEN
- CALL DLAQR1( 2, H( K+1, K+1 ), LDH, SR( 2*M22-1 ),
- $ SI( 2*M22-1 ), SR( 2*M22 ), SI( 2*M22 ),
- $ V( 1, M22 ) )
- BETA = V( 1, M22 )
- CALL DLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )
- ELSE
- BETA = H( K+1, K )
- V( 2, M22 ) = H( K+2, K )
- CALL DLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )
- H( K+1, K ) = BETA
- H( K+2, K ) = ZERO
- END IF
- END IF
-*
-* ==== Multiply H by reflections from the left ====
-*
- IF( ACCUM ) THEN
- JBOT = MIN( NDCOL, KBOT )
- ELSE IF( WANTT ) THEN
- JBOT = N
- ELSE
- JBOT = KBOT
- END IF
- DO 40 J = MAX( KTOP, KRCOL ), JBOT
- MEND = MIN( MBOT, ( J-KRCOL+2 ) / 3 )
- DO 30 M = MTOP, MEND
- K = KRCOL + 3*( M-1 )
- REFSUM = V( 1, M )*( H( K+1, J )+V( 2, M )*
- $ H( K+2, J )+V( 3, M )*H( K+3, J ) )
- H( K+1, J ) = H( K+1, J ) - REFSUM
- H( K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M )
- H( K+3, J ) = H( K+3, J ) - REFSUM*V( 3, M )
- 30 CONTINUE
- 40 CONTINUE
- IF( BMP22 ) THEN
- K = KRCOL + 3*( M22-1 )
- DO 50 J = MAX( K+1, KTOP ), JBOT
- REFSUM = V( 1, M22 )*( H( K+1, J )+V( 2, M22 )*
- $ H( K+2, J ) )
- H( K+1, J ) = H( K+1, J ) - REFSUM
- H( K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M22 )
- 50 CONTINUE
- END IF
-*
-* ==== Multiply H by reflections from the right.
-* . Delay filling in the last row until the
-* . vigilant deflation check is complete. ====
-*
- IF( ACCUM ) THEN
- JTOP = MAX( KTOP, INCOL )
- ELSE IF( WANTT ) THEN
- JTOP = 1
- ELSE
- JTOP = KTOP
- END IF
- DO 90 M = MTOP, MBOT
- IF( V( 1, M ).NE.ZERO ) THEN
- K = KRCOL + 3*( M-1 )
- DO 60 J = JTOP, MIN( KBOT, K+3 )
- REFSUM = V( 1, M )*( H( J, K+1 )+V( 2, M )*
- $ H( J, K+2 )+V( 3, M )*H( J, K+3 ) )
- H( J, K+1 ) = H( J, K+1 ) - REFSUM
- H( J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M )
- H( J, K+3 ) = H( J, K+3 ) - REFSUM*V( 3, M )
- 60 CONTINUE
-*
- IF( ACCUM ) THEN
-*
-* ==== Accumulate U. (If necessary, update Z later
-* . with with an efficient matrix-matrix
-* . multiply.) ====
-*
- KMS = K - INCOL
- DO 70 J = MAX( 1, KTOP-INCOL ), KDU
- REFSUM = V( 1, M )*( U( J, KMS+1 )+V( 2, M )*
- $ U( J, KMS+2 )+V( 3, M )*U( J, KMS+3 ) )
- U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
- U( J, KMS+2 ) = U( J, KMS+2 ) - REFSUM*V( 2, M )
- U( J, KMS+3 ) = U( J, KMS+3 ) - REFSUM*V( 3, M )
- 70 CONTINUE
- ELSE IF( WANTZ ) THEN
-*
-* ==== U is not accumulated, so update Z
-* . now by multiplying by reflections
-* . from the right. ====
-*
- DO 80 J = ILOZ, IHIZ
- REFSUM = V( 1, M )*( Z( J, K+1 )+V( 2, M )*
- $ Z( J, K+2 )+V( 3, M )*Z( J, K+3 ) )
- Z( J, K+1 ) = Z( J, K+1 ) - REFSUM
- Z( J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M )
- Z( J, K+3 ) = Z( J, K+3 ) - REFSUM*V( 3, M )
- 80 CONTINUE
- END IF
- END IF
- 90 CONTINUE
-*
-* ==== Special case: 2-by-2 reflection (if needed) ====
-*
- K = KRCOL + 3*( M22-1 )
- IF( BMP22 ) THEN
- IF ( V( 1, M22 ).NE.ZERO ) THEN
- DO 100 J = JTOP, MIN( KBOT, K+3 )
- REFSUM = V( 1, M22 )*( H( J, K+1 )+V( 2, M22 )*
- $ H( J, K+2 ) )
- H( J, K+1 ) = H( J, K+1 ) - REFSUM
- H( J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M22 )
- 100 CONTINUE
-*
- IF( ACCUM ) THEN
- KMS = K - INCOL
- DO 110 J = MAX( 1, KTOP-INCOL ), KDU
- REFSUM = V( 1, M22 )*( U( J, KMS+1 )+
- $ V( 2, M22 )*U( J, KMS+2 ) )
- U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
- U( J, KMS+2 ) = U( J, KMS+2 ) -
- $ REFSUM*V( 2, M22 )
- 110 CONTINUE
- ELSE IF( WANTZ ) THEN
- DO 120 J = ILOZ, IHIZ
- REFSUM = V( 1, M22 )*( Z( J, K+1 )+V( 2, M22 )*
- $ Z( J, K+2 ) )
- Z( J, K+1 ) = Z( J, K+1 ) - REFSUM
- Z( J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M22 )
- 120 CONTINUE
- END IF
- END IF
- END IF
-*
-* ==== Vigilant deflation check ====
-*
- MSTART = MTOP
- IF( KRCOL+3*( MSTART-1 ).LT.KTOP )
- $ MSTART = MSTART + 1
- MEND = MBOT
- IF( BMP22 )
- $ MEND = MEND + 1
- IF( KRCOL.EQ.KBOT-2 )
- $ MEND = MEND + 1
- DO 130 M = MSTART, MEND
- K = MIN( KBOT-1, KRCOL+3*( M-1 ) )
-*
-* ==== The following convergence test requires that
-* . the tradition small-compared-to-nearby-diagonals
-* . criterion and the Ahues & Tisseur (LAWN 122, 1997)
-* . criteria both be satisfied. The latter improves
-* . accuracy in some examples. Falling back on an
-* . alternate convergence criterion when TST1 or TST2
-* . is zero (as done here) is traditional but probably
-* . unnecessary. ====
-*
- IF( H( K+1, K ).NE.ZERO ) THEN
- TST1 = ABS( H( K, K ) ) + ABS( H( K+1, K+1 ) )
- IF( TST1.EQ.ZERO ) THEN
- IF( K.GE.KTOP+1 )
- $ TST1 = TST1 + ABS( H( K, K-1 ) )
- IF( K.GE.KTOP+2 )
- $ TST1 = TST1 + ABS( H( K, K-2 ) )
- IF( K.GE.KTOP+3 )
- $ TST1 = TST1 + ABS( H( K, K-3 ) )
- IF( K.LE.KBOT-2 )
- $ TST1 = TST1 + ABS( H( K+2, K+1 ) )
- IF( K.LE.KBOT-3 )
- $ TST1 = TST1 + ABS( H( K+3, K+1 ) )
- IF( K.LE.KBOT-4 )
- $ TST1 = TST1 + ABS( H( K+4, K+1 ) )
- END IF
- IF( ABS( H( K+1, K ) ).LE.MAX( SMLNUM, ULP*TST1 ) )
- $ THEN
- H12 = MAX( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )
- H21 = MIN( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )
- H11 = MAX( ABS( H( K+1, K+1 ) ),
- $ ABS( H( K, K )-H( K+1, K+1 ) ) )
- H22 = MIN( ABS( H( K+1, K+1 ) ),
- $ ABS( H( K, K )-H( K+1, K+1 ) ) )
- SCL = H11 + H12
- TST2 = H22*( H11 / SCL )
-*
- IF( TST2.EQ.ZERO .OR. H21*( H12 / SCL ).LE.
- $ MAX( SMLNUM, ULP*TST2 ) )H( K+1, K ) = ZERO
- END IF
- END IF
- 130 CONTINUE
-*
-* ==== Fill in the last row of each bulge. ====
-*
- MEND = MIN( NBMPS, ( KBOT-KRCOL-1 ) / 3 )
- DO 140 M = MTOP, MEND
- K = KRCOL + 3*( M-1 )
- REFSUM = V( 1, M )*V( 3, M )*H( K+4, K+3 )
- H( K+4, K+1 ) = -REFSUM
- H( K+4, K+2 ) = -REFSUM*V( 2, M )
- H( K+4, K+3 ) = H( K+4, K+3 ) - REFSUM*V( 3, M )
- 140 CONTINUE
-*
-* ==== End of near-the-diagonal bulge chase. ====
-*
- 150 CONTINUE
-*
-* ==== Use U (if accumulated) to update far-from-diagonal
-* . entries in H. If required, use U to update Z as
-* . well. ====
-*
- IF( ACCUM ) THEN
- IF( WANTT ) THEN
- JTOP = 1
- JBOT = N
- ELSE
- JTOP = KTOP
- JBOT = KBOT
- END IF
- IF( ( .NOT.BLK22 ) .OR. ( INCOL.LT.KTOP ) .OR.
- $ ( NDCOL.GT.KBOT ) .OR. ( NS.LE.2 ) ) THEN
-*
-* ==== Updates not exploiting the 2-by-2 block
-* . structure of U. K1 and NU keep track of
-* . the location and size of U in the special
-* . cases of introducing bulges and chasing
-* . bulges off the bottom. In these special
-* . cases and in case the number of shifts
-* . is NS = 2, there is no 2-by-2 block
-* . structure to exploit. ====
-*
- K1 = MAX( 1, KTOP-INCOL )
- NU = ( KDU-MAX( 0, NDCOL-KBOT ) ) - K1 + 1
-*
-* ==== Horizontal Multiply ====
-*
- DO 160 JCOL = MIN( NDCOL, KBOT ) + 1, JBOT, NH
- JLEN = MIN( NH, JBOT-JCOL+1 )
- CALL DGEMM( 'C', 'N', NU, JLEN, NU, ONE, U( K1, K1 ),
- $ LDU, H( INCOL+K1, JCOL ), LDH, ZERO, WH,
- $ LDWH )
- CALL DLACPY( 'ALL', NU, JLEN, WH, LDWH,
- $ H( INCOL+K1, JCOL ), LDH )
- 160 CONTINUE
-*
-* ==== Vertical multiply ====
-*
- DO 170 JROW = JTOP, MAX( KTOP, INCOL ) - 1, NV
- JLEN = MIN( NV, MAX( KTOP, INCOL )-JROW )
- CALL DGEMM( 'N', 'N', JLEN, NU, NU, ONE,
- $ H( JROW, INCOL+K1 ), LDH, U( K1, K1 ),
- $ LDU, ZERO, WV, LDWV )
- CALL DLACPY( 'ALL', JLEN, NU, WV, LDWV,
- $ H( JROW, INCOL+K1 ), LDH )
- 170 CONTINUE
-*
-* ==== Z multiply (also vertical) ====
-*
- IF( WANTZ ) THEN
- DO 180 JROW = ILOZ, IHIZ, NV
- JLEN = MIN( NV, IHIZ-JROW+1 )
- CALL DGEMM( 'N', 'N', JLEN, NU, NU, ONE,
- $ Z( JROW, INCOL+K1 ), LDZ, U( K1, K1 ),
- $ LDU, ZERO, WV, LDWV )
- CALL DLACPY( 'ALL', JLEN, NU, WV, LDWV,
- $ Z( JROW, INCOL+K1 ), LDZ )
- 180 CONTINUE
- END IF
- ELSE
-*
-* ==== Updates exploiting U's 2-by-2 block structure.
-* . (I2, I4, J2, J4 are the last rows and columns
-* . of the blocks.) ====
-*
- I2 = ( KDU+1 ) / 2
- I4 = KDU
- J2 = I4 - I2
- J4 = KDU
-*
-* ==== KZS and KNZ deal with the band of zeros
-* . along the diagonal of one of the triangular
-* . blocks. ====
-*
- KZS = ( J4-J2 ) - ( NS+1 )
- KNZ = NS + 1
-*
-* ==== Horizontal multiply ====
-*
- DO 190 JCOL = MIN( NDCOL, KBOT ) + 1, JBOT, NH
- JLEN = MIN( NH, JBOT-JCOL+1 )
-*
-* ==== Copy bottom of H to top+KZS of scratch ====
-* (The first KZS rows get multiplied by zero.) ====
-*
- CALL DLACPY( 'ALL', KNZ, JLEN, H( INCOL+1+J2, JCOL ),
- $ LDH, WH( KZS+1, 1 ), LDWH )
-*
-* ==== Multiply by U21**T ====
-*
- CALL DLASET( 'ALL', KZS, JLEN, ZERO, ZERO, WH, LDWH )
- CALL DTRMM( 'L', 'U', 'C', 'N', KNZ, JLEN, ONE,
- $ U( J2+1, 1+KZS ), LDU, WH( KZS+1, 1 ),
- $ LDWH )
-*
-* ==== Multiply top of H by U11**T ====
-*
- CALL DGEMM( 'C', 'N', I2, JLEN, J2, ONE, U, LDU,
- $ H( INCOL+1, JCOL ), LDH, ONE, WH, LDWH )
-*
-* ==== Copy top of H to bottom of WH ====
-*
- CALL DLACPY( 'ALL', J2, JLEN, H( INCOL+1, JCOL ), LDH,
- $ WH( I2+1, 1 ), LDWH )
-*
-* ==== Multiply by U21**T ====
-*
- CALL DTRMM( 'L', 'L', 'C', 'N', J2, JLEN, ONE,
- $ U( 1, I2+1 ), LDU, WH( I2+1, 1 ), LDWH )
-*
-* ==== Multiply by U22 ====
-*
- CALL DGEMM( 'C', 'N', I4-I2, JLEN, J4-J2, ONE,
- $ U( J2+1, I2+1 ), LDU,
- $ H( INCOL+1+J2, JCOL ), LDH, ONE,
- $ WH( I2+1, 1 ), LDWH )
-*
-* ==== Copy it back ====
-*
- CALL DLACPY( 'ALL', KDU, JLEN, WH, LDWH,
- $ H( INCOL+1, JCOL ), LDH )
- 190 CONTINUE
-*
-* ==== Vertical multiply ====
-*
- DO 200 JROW = JTOP, MAX( INCOL, KTOP ) - 1, NV
- JLEN = MIN( NV, MAX( INCOL, KTOP )-JROW )
-*
-* ==== Copy right of H to scratch (the first KZS
-* . columns get multiplied by zero) ====
-*
- CALL DLACPY( 'ALL', JLEN, KNZ, H( JROW, INCOL+1+J2 ),
- $ LDH, WV( 1, 1+KZS ), LDWV )
-*
-* ==== Multiply by U21 ====
-*
- CALL DLASET( 'ALL', JLEN, KZS, ZERO, ZERO, WV, LDWV )
- CALL DTRMM( 'R', 'U', 'N', 'N', JLEN, KNZ, ONE,
- $ U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ),
- $ LDWV )
-*
-* ==== Multiply by U11 ====
-*
- CALL DGEMM( 'N', 'N', JLEN, I2, J2, ONE,
- $ H( JROW, INCOL+1 ), LDH, U, LDU, ONE, WV,
- $ LDWV )
-*
-* ==== Copy left of H to right of scratch ====
-*
- CALL DLACPY( 'ALL', JLEN, J2, H( JROW, INCOL+1 ), LDH,
- $ WV( 1, 1+I2 ), LDWV )
-*
-* ==== Multiply by U21 ====
-*
- CALL DTRMM( 'R', 'L', 'N', 'N', JLEN, I4-I2, ONE,
- $ U( 1, I2+1 ), LDU, WV( 1, 1+I2 ), LDWV )
-*
-* ==== Multiply by U22 ====
-*
- CALL DGEMM( 'N', 'N', JLEN, I4-I2, J4-J2, ONE,
- $ H( JROW, INCOL+1+J2 ), LDH,
- $ U( J2+1, I2+1 ), LDU, ONE, WV( 1, 1+I2 ),
- $ LDWV )
-*
-* ==== Copy it back ====
-*
- CALL DLACPY( 'ALL', JLEN, KDU, WV, LDWV,
- $ H( JROW, INCOL+1 ), LDH )
- 200 CONTINUE
-*
-* ==== Multiply Z (also vertical) ====
-*
- IF( WANTZ ) THEN
- DO 210 JROW = ILOZ, IHIZ, NV
- JLEN = MIN( NV, IHIZ-JROW+1 )
-*
-* ==== Copy right of Z to left of scratch (first
-* . KZS columns get multiplied by zero) ====
-*
- CALL DLACPY( 'ALL', JLEN, KNZ,
- $ Z( JROW, INCOL+1+J2 ), LDZ,
- $ WV( 1, 1+KZS ), LDWV )
-*
-* ==== Multiply by U12 ====
-*
- CALL DLASET( 'ALL', JLEN, KZS, ZERO, ZERO, WV,
- $ LDWV )
- CALL DTRMM( 'R', 'U', 'N', 'N', JLEN, KNZ, ONE,
- $ U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ),
- $ LDWV )
-*
-* ==== Multiply by U11 ====
-*
- CALL DGEMM( 'N', 'N', JLEN, I2, J2, ONE,
- $ Z( JROW, INCOL+1 ), LDZ, U, LDU, ONE,
- $ WV, LDWV )
-*
-* ==== Copy left of Z to right of scratch ====
-*
- CALL DLACPY( 'ALL', JLEN, J2, Z( JROW, INCOL+1 ),
- $ LDZ, WV( 1, 1+I2 ), LDWV )
-*
-* ==== Multiply by U21 ====
-*
- CALL DTRMM( 'R', 'L', 'N', 'N', JLEN, I4-I2, ONE,
- $ U( 1, I2+1 ), LDU, WV( 1, 1+I2 ),
- $ LDWV )
-*
-* ==== Multiply by U22 ====
-*
- CALL DGEMM( 'N', 'N', JLEN, I4-I2, J4-J2, ONE,
- $ Z( JROW, INCOL+1+J2 ), LDZ,
- $ U( J2+1, I2+1 ), LDU, ONE,
- $ WV( 1, 1+I2 ), LDWV )
-*
-* ==== Copy the result back to Z ====
-*
- CALL DLACPY( 'ALL', JLEN, KDU, WV, LDWV,
- $ Z( JROW, INCOL+1 ), LDZ )
- 210 CONTINUE
- END IF
- END IF
- END IF
- 220 CONTINUE
-*
-* ==== End of DLAQR5 ====
-*
- END
diff --git a/mtx/lapack_src/dlarf.f b/mtx/lapack_src/dlarf.f
deleted file mode 100644
index 2a82ff439..000000000
--- a/mtx/lapack_src/dlarf.f
+++ /dev/null
@@ -1,227 +0,0 @@
-*> \brief \b DLARF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARF + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE
-* INTEGER INCV, LDC, M, N
-* DOUBLE PRECISION TAU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': form H * C
-*> = 'R': form C * H
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension
-*> (1 + (M-1)*abs(INCV)) if SIDE = 'L'
-*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
-*> The vector v in the representation of H. V is not used if
-*> TAU = 0.
-*> \endverbatim
-*>
-*> \param[in] INCV
-*> \verbatim
-*> INCV is INTEGER
-*> The increment between elements of v. INCV <> 0.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*> The value tau in the representation of H.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
-*> or C * H if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (N) if SIDE = 'L'
-*> or (M) if SIDE = 'R'
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE
- INTEGER INCV, LDC, M, N
- DOUBLE PRECISION TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL APPLYLEFT
- INTEGER I, LASTV, LASTC
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DGER
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILADLR, ILADLC
- EXTERNAL LSAME, ILADLR, ILADLC
-* ..
-* .. Executable Statements ..
-*
- APPLYLEFT = LSAME( SIDE, 'L' )
- LASTV = 0
- LASTC = 0
- IF( TAU.NE.ZERO ) THEN
-! Set up variables for scanning V. LASTV begins pointing to the end
-! of V.
- IF( APPLYLEFT ) THEN
- LASTV = M
- ELSE
- LASTV = N
- END IF
- IF( INCV.GT.0 ) THEN
- I = 1 + (LASTV-1) * INCV
- ELSE
- I = 1
- END IF
-! Look for the last non-zero row in V.
- DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
- LASTV = LASTV - 1
- I = I - INCV
- END DO
- IF( APPLYLEFT ) THEN
-! Scan for the last non-zero column in C(1:lastv,:).
- LASTC = ILADLC(LASTV, N, C, LDC)
- ELSE
-! Scan for the last non-zero row in C(:,1:lastv).
- LASTC = ILADLR(M, LASTV, C, LDC)
- END IF
- END IF
-! Note that lastc.eq.0 renders the BLAS operations null; no special
-! case is needed at this level.
- IF( APPLYLEFT ) THEN
-*
-* Form H * C
-*
- IF( LASTV.GT.0 ) THEN
-*
-* w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1)
-*
- CALL DGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, INCV,
- $ ZERO, WORK, 1 )
-*
-* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T
-*
- CALL DGER( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
- END IF
- ELSE
-*
-* Form C * H
-*
- IF( LASTV.GT.0 ) THEN
-*
-* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
-*
- CALL DGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
- $ V, INCV, ZERO, WORK, 1 )
-*
-* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T
-*
- CALL DGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
- END IF
- END IF
- RETURN
-*
-* End of DLARF
-*
- END
diff --git a/mtx/lapack_src/dlarfb.f b/mtx/lapack_src/dlarfb.f
deleted file mode 100644
index 206d3b268..000000000
--- a/mtx/lapack_src/dlarfb.f
+++ /dev/null
@@ -1,762 +0,0 @@
-*> \brief \b DLARFB
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARFB + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
-* T, LDT, C, LDC, WORK, LDWORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIRECT, SIDE, STOREV, TRANS
-* INTEGER K, LDC, LDT, LDV, LDWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION C( LDC, * ), T( LDT, * ), V( LDV, * ),
-* $ WORK( LDWORK, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply H or H**T from the Left
-*> = 'R': apply H or H**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply H (No transpose)
-*> = 'T': apply H**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIRECT
-*> \verbatim
-*> DIRECT is CHARACTER*1
-*> Indicates how H is formed from a product of elementary
-*> reflectors
-*> = 'F': H = H(1) H(2) . . . H(k) (Forward)
-*> = 'B': H = H(k) . . . H(2) H(1) (Backward)
-*> \endverbatim
-*>
-*> \param[in] STOREV
-*> \verbatim
-*> STOREV is CHARACTER*1
-*> Indicates how the vectors which define the elementary
-*> reflectors are stored:
-*> = 'C': Columnwise
-*> = 'R': Rowwise
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The order of the matrix T (= the number of elementary
-*> reflectors whose product defines the block reflector).
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension
-*> (LDV,K) if STOREV = 'C'
-*> (LDV,M) if STOREV = 'R' and SIDE = 'L'
-*> (LDV,N) if STOREV = 'R' and SIDE = 'R'
-*> The matrix V. See Further Details.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
-*> if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
-*> if STOREV = 'R', LDV >= K.
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,K)
-*> The triangular k by k matrix T in the representation of the
-*> block reflector.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= K.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by H*C or H**T*C or C*H or C*H**T.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LDWORK,K)
-*> \endverbatim
-*>
-*> \param[in] LDWORK
-*> \verbatim
-*> LDWORK is INTEGER
-*> The leading dimension of the array WORK.
-*> If SIDE = 'L', LDWORK >= max(1,N);
-*> if SIDE = 'R', LDWORK >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The shape of the matrix V and the storage of the vectors which define
-*> the H(i) is best illustrated by the following example with n = 5 and
-*> k = 3. The elements equal to 1 are not stored; the corresponding
-*> array elements are modified but restored on exit. The rest of the
-*> array is not used.
-*>
-*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
-*>
-*> V = ( 1 ) V = ( 1 v1 v1 v1 v1 )
-*> ( v1 1 ) ( 1 v2 v2 v2 )
-*> ( v1 v2 1 ) ( 1 v3 v3 )
-*> ( v1 v2 v3 )
-*> ( v1 v2 v3 )
-*>
-*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
-*>
-*> V = ( v1 v2 v3 ) V = ( v1 v1 1 )
-*> ( v1 v2 v3 ) ( v2 v2 v2 1 )
-*> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 )
-*> ( 1 v3 )
-*> ( 1 )
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
- $ T, LDT, C, LDC, WORK, LDWORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIRECT, SIDE, STOREV, TRANS
- INTEGER K, LDC, LDT, LDV, LDWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION C( LDC, * ), T( LDT, * ), V( LDV, * ),
- $ WORK( LDWORK, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- CHARACTER TRANST
- INTEGER I, J, LASTV, LASTC
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILADLR, ILADLC
- EXTERNAL LSAME, ILADLR, ILADLC
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DGEMM, DTRMM
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( M.LE.0 .OR. N.LE.0 )
- $ RETURN
-*
- IF( LSAME( TRANS, 'N' ) ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
- IF( LSAME( STOREV, 'C' ) ) THEN
-*
- IF( LSAME( DIRECT, 'F' ) ) THEN
-*
-* Let V = ( V1 ) (first K rows)
-* ( V2 )
-* where V1 is unit lower triangular.
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C or H**T * C where C = ( C1 )
-* ( C2 )
-*
- LASTV = MAX( K, ILADLR( M, K, V, LDV ) )
- LASTC = ILADLC( LASTV, N, C, LDC )
-*
-* W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK)
-*
-* W := C1**T
-*
- DO 10 J = 1, K
- CALL DCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
- 10 CONTINUE
-*
-* W := W * V1
-*
- CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C2**T *V2
-*
- CALL DGEMM( 'Transpose', 'No transpose',
- $ LASTC, K, LASTV-K,
- $ ONE, C( K+1, 1 ), LDC, V( K+1, 1 ), LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T**T or W * T
-*
- CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - V * W**T
-*
- IF( LASTV.GT.K ) THEN
-*
-* C2 := C2 - V2 * W**T
-*
- CALL DGEMM( 'No transpose', 'Transpose',
- $ LASTV-K, LASTC, K,
- $ -ONE, V( K+1, 1 ), LDV, WORK, LDWORK, ONE,
- $ C( K+1, 1 ), LDC )
- END IF
-*
-* W := W * V1**T
-*
- CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
-*
-* C1 := C1 - W**T
-*
- DO 30 J = 1, K
- DO 20 I = 1, LASTC
- C( J, I ) = C( J, I ) - WORK( I, J )
- 20 CONTINUE
- 30 CONTINUE
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form C * H or C * H**T where C = ( C1 C2 )
-*
- LASTV = MAX( K, ILADLR( N, K, V, LDV ) )
- LASTC = ILADLR( M, LASTV, C, LDC )
-*
-* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
-*
-* W := C1
-*
- DO 40 J = 1, K
- CALL DCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
- 40 CONTINUE
-*
-* W := W * V1
-*
- CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C2 * V2
-*
- CALL DGEMM( 'No transpose', 'No transpose',
- $ LASTC, K, LASTV-K,
- $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T or W * T**T
-*
- CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - W * V**T
-*
- IF( LASTV.GT.K ) THEN
-*
-* C2 := C2 - W * V2**T
-*
- CALL DGEMM( 'No transpose', 'Transpose',
- $ LASTC, LASTV-K, K,
- $ -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, ONE,
- $ C( 1, K+1 ), LDC )
- END IF
-*
-* W := W * V1**T
-*
- CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
-*
-* C1 := C1 - W
-*
- DO 60 J = 1, K
- DO 50 I = 1, LASTC
- C( I, J ) = C( I, J ) - WORK( I, J )
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
- ELSE
-*
-* Let V = ( V1 )
-* ( V2 ) (last K rows)
-* where V2 is unit upper triangular.
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C or H**T * C where C = ( C1 )
-* ( C2 )
-*
- LASTV = MAX( K, ILADLR( M, K, V, LDV ) )
- LASTC = ILADLC( LASTV, N, C, LDC )
-*
-* W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK)
-*
-* W := C2**T
-*
- DO 70 J = 1, K
- CALL DCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
- $ WORK( 1, J ), 1 )
- 70 CONTINUE
-*
-* W := W * V2
-*
- CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
- $ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C1**T*V1
-*
- CALL DGEMM( 'Transpose', 'No transpose',
- $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T**T or W * T
-*
- CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - V * W**T
-*
- IF( LASTV.GT.K ) THEN
-*
-* C1 := C1 - V1 * W**T
-*
- CALL DGEMM( 'No transpose', 'Transpose',
- $ LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
- $ ONE, C, LDC )
- END IF
-*
-* W := W * V2**T
-*
- CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
- $ WORK, LDWORK )
-*
-* C2 := C2 - W**T
-*
- DO 90 J = 1, K
- DO 80 I = 1, LASTC
- C( LASTV-K+J, I ) = C( LASTV-K+J, I ) - WORK(I, J)
- 80 CONTINUE
- 90 CONTINUE
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form C * H or C * H**T where C = ( C1 C2 )
-*
- LASTV = MAX( K, ILADLR( N, K, V, LDV ) )
- LASTC = ILADLR( M, LASTV, C, LDC )
-*
-* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
-*
-* W := C2
-*
- DO 100 J = 1, K
- CALL DCOPY( LASTC, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
- 100 CONTINUE
-*
-* W := W * V2
-*
- CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
- $ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C1 * V1
-*
- CALL DGEMM( 'No transpose', 'No transpose',
- $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T or W * T**T
-*
- CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - W * V**T
-*
- IF( LASTV.GT.K ) THEN
-*
-* C1 := C1 - W * V1**T
-*
- CALL DGEMM( 'No transpose', 'Transpose',
- $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
- $ ONE, C, LDC )
- END IF
-*
-* W := W * V2**T
-*
- CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
- $ WORK, LDWORK )
-*
-* C2 := C2 - W
-*
- DO 120 J = 1, K
- DO 110 I = 1, LASTC
- C( I, LASTV-K+J ) = C( I, LASTV-K+J ) - WORK(I, J)
- 110 CONTINUE
- 120 CONTINUE
- END IF
- END IF
-*
- ELSE IF( LSAME( STOREV, 'R' ) ) THEN
-*
- IF( LSAME( DIRECT, 'F' ) ) THEN
-*
-* Let V = ( V1 V2 ) (V1: first K columns)
-* where V1 is unit upper triangular.
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C or H**T * C where C = ( C1 )
-* ( C2 )
-*
- LASTV = MAX( K, ILADLC( K, M, V, LDV ) )
- LASTC = ILADLC( LASTV, N, C, LDC )
-*
-* W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK)
-*
-* W := C1**T
-*
- DO 130 J = 1, K
- CALL DCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
- 130 CONTINUE
-*
-* W := W * V1**T
-*
- CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C2**T*V2**T
-*
- CALL DGEMM( 'Transpose', 'Transpose',
- $ LASTC, K, LASTV-K,
- $ ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T**T or W * T
-*
- CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - V**T * W**T
-*
- IF( LASTV.GT.K ) THEN
-*
-* C2 := C2 - V2**T * W**T
-*
- CALL DGEMM( 'Transpose', 'Transpose',
- $ LASTV-K, LASTC, K,
- $ -ONE, V( 1, K+1 ), LDV, WORK, LDWORK,
- $ ONE, C( K+1, 1 ), LDC )
- END IF
-*
-* W := W * V1
-*
- CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
-*
-* C1 := C1 - W**T
-*
- DO 150 J = 1, K
- DO 140 I = 1, LASTC
- C( J, I ) = C( J, I ) - WORK( I, J )
- 140 CONTINUE
- 150 CONTINUE
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form C * H or C * H**T where C = ( C1 C2 )
-*
- LASTV = MAX( K, ILADLC( K, N, V, LDV ) )
- LASTC = ILADLR( M, LASTV, C, LDC )
-*
-* W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK)
-*
-* W := C1
-*
- DO 160 J = 1, K
- CALL DCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
- 160 CONTINUE
-*
-* W := W * V1**T
-*
- CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C2 * V2**T
-*
- CALL DGEMM( 'No transpose', 'Transpose',
- $ LASTC, K, LASTV-K,
- $ ONE, C( 1, K+1 ), LDC, V( 1, K+1 ), LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T or W * T**T
-*
- CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - W * V
-*
- IF( LASTV.GT.K ) THEN
-*
-* C2 := C2 - W * V2
-*
- CALL DGEMM( 'No transpose', 'No transpose',
- $ LASTC, LASTV-K, K,
- $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV,
- $ ONE, C( 1, K+1 ), LDC )
- END IF
-*
-* W := W * V1
-*
- CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
-*
-* C1 := C1 - W
-*
- DO 180 J = 1, K
- DO 170 I = 1, LASTC
- C( I, J ) = C( I, J ) - WORK( I, J )
- 170 CONTINUE
- 180 CONTINUE
-*
- END IF
-*
- ELSE
-*
-* Let V = ( V1 V2 ) (V2: last K columns)
-* where V2 is unit lower triangular.
-*
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C or H**T * C where C = ( C1 )
-* ( C2 )
-*
- LASTV = MAX( K, ILADLC( K, M, V, LDV ) )
- LASTC = ILADLC( LASTV, N, C, LDC )
-*
-* W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK)
-*
-* W := C2**T
-*
- DO 190 J = 1, K
- CALL DCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
- $ WORK( 1, J ), 1 )
- 190 CONTINUE
-*
-* W := W * V2**T
-*
- CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
- $ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C1**T * V1**T
-*
- CALL DGEMM( 'Transpose', 'Transpose',
- $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T**T or W * T
-*
- CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - V**T * W**T
-*
- IF( LASTV.GT.K ) THEN
-*
-* C1 := C1 - V1**T * W**T
-*
- CALL DGEMM( 'Transpose', 'Transpose',
- $ LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
- $ ONE, C, LDC )
- END IF
-*
-* W := W * V2
-*
- CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
- $ WORK, LDWORK )
-*
-* C2 := C2 - W**T
-*
- DO 210 J = 1, K
- DO 200 I = 1, LASTC
- C( LASTV-K+J, I ) = C( LASTV-K+J, I ) - WORK(I, J)
- 200 CONTINUE
- 210 CONTINUE
-*
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form C * H or C * H**T where C = ( C1 C2 )
-*
- LASTV = MAX( K, ILADLC( K, N, V, LDV ) )
- LASTC = ILADLR( M, LASTV, C, LDC )
-*
-* W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK)
-*
-* W := C2
-*
- DO 220 J = 1, K
- CALL DCOPY( LASTC, C( 1, LASTV-K+J ), 1,
- $ WORK( 1, J ), 1 )
- 220 CONTINUE
-*
-* W := W * V2**T
-*
- CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
- $ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
-*
-* W := W + C1 * V1**T
-*
- CALL DGEMM( 'No transpose', 'Transpose',
- $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
- $ ONE, WORK, LDWORK )
- END IF
-*
-* W := W * T or W * T**T
-*
- CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
- $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
-*
-* C := C - W * V
-*
- IF( LASTV.GT.K ) THEN
-*
-* C1 := C1 - W * V1
-*
- CALL DGEMM( 'No transpose', 'No transpose',
- $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
- $ ONE, C, LDC )
- END IF
-*
-* W := W * V2
-*
- CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
- $ WORK, LDWORK )
-*
-* C1 := C1 - W
-*
- DO 240 J = 1, K
- DO 230 I = 1, LASTC
- C( I, LASTV-K+J ) = C( I, LASTV-K+J ) - WORK(I, J)
- 230 CONTINUE
- 240 CONTINUE
-*
- END IF
-*
- END IF
- END IF
-*
- RETURN
-*
-* End of DLARFB
-*
- END
diff --git a/mtx/lapack_src/dlarfg.f b/mtx/lapack_src/dlarfg.f
deleted file mode 100644
index 458ad2e05..000000000
--- a/mtx/lapack_src/dlarfg.f
+++ /dev/null
@@ -1,196 +0,0 @@
-*> \brief \b DLARFG
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARFG + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* DOUBLE PRECISION ALPHA, TAU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the elementary reflector.
-*> \endverbatim
-*>
-*> \param[in,out] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> On entry, the value alpha.
-*> On exit, it is overwritten with the value beta.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension
-*> (1+(N-2)*abs(INCX))
-*> On entry, the vector x.
-*> On exit, it is overwritten with the vector v.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between elements of X. INCX > 0.
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*> The value tau.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
- DOUBLE PRECISION ALPHA, TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER J, KNT
- DOUBLE PRECISION BETA, RSAFMN, SAFMIN, XNORM
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH, DLAPY2, DNRM2
- EXTERNAL DLAMCH, DLAPY2, DNRM2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL
-* ..
-* .. Executable Statements ..
-*
- IF( N.LE.1 ) THEN
- TAU = ZERO
- RETURN
- END IF
-*
- XNORM = DNRM2( N-1, X, INCX )
-*
- IF( XNORM.EQ.ZERO ) THEN
-*
-* H = I
-*
- TAU = ZERO
- ELSE
-*
-* general case
-*
- BETA = -SIGN( DLAPY2( ALPHA, XNORM ), ALPHA )
- SAFMIN = DLAMCH( 'S' ) / DLAMCH( 'E' )
- KNT = 0
- IF( ABS( BETA ).LT.SAFMIN ) THEN
-*
-* XNORM, BETA may be inaccurate; scale X and recompute them
-*
- RSAFMN = ONE / SAFMIN
- 10 CONTINUE
- KNT = KNT + 1
- CALL DSCAL( N-1, RSAFMN, X, INCX )
- BETA = BETA*RSAFMN
- ALPHA = ALPHA*RSAFMN
- IF( ABS( BETA ).LT.SAFMIN )
- $ GO TO 10
-*
-* New BETA is at most 1, at least SAFMIN
-*
- XNORM = DNRM2( N-1, X, INCX )
- BETA = -SIGN( DLAPY2( ALPHA, XNORM ), ALPHA )
- END IF
- TAU = ( BETA-ALPHA ) / BETA
- CALL DSCAL( N-1, ONE / ( ALPHA-BETA ), X, INCX )
-*
-* If ALPHA is subnormal, it may lose relative accuracy
-*
- DO 20 J = 1, KNT
- BETA = BETA*SAFMIN
- 20 CONTINUE
- ALPHA = BETA
- END IF
-*
- RETURN
-*
-* End of DLARFG
-*
- END
diff --git a/mtx/lapack_src/dlarft.f b/mtx/lapack_src/dlarft.f
deleted file mode 100644
index 4b7550403..000000000
--- a/mtx/lapack_src/dlarft.f
+++ /dev/null
@@ -1,326 +0,0 @@
-*> \brief \b DLARFT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARFT + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIRECT, STOREV
-* INTEGER K, LDT, LDV, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION T( LDT, * ), TAU( * ), V( LDV, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] DIRECT
-*> \verbatim
-*> DIRECT is CHARACTER*1
-*> Specifies the order in which the elementary reflectors are
-*> multiplied to form the block reflector:
-*> = 'F': H = H(1) H(2) . . . H(k) (Forward)
-*> = 'B': H = H(k) . . . H(2) H(1) (Backward)
-*> \endverbatim
-*>
-*> \param[in] STOREV
-*> \verbatim
-*> STOREV is CHARACTER*1
-*> Specifies how the vectors which define the elementary
-*> reflectors are stored (see also Further Details):
-*> = 'C': columnwise
-*> = 'R': rowwise
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the block reflector H. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The order of the triangular factor T (= the number of
-*> elementary reflectors). K >= 1.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension
-*> (LDV,K) if STOREV = 'C'
-*> (LDV,N) if STOREV = 'R'
-*> The matrix V. See further details.
-*> \endverbatim
-*>
-*> \param[in] LDV
-*> \verbatim
-*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i).
-*> \endverbatim
-*>
-*> \param[out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,K)
-*> The k by k triangular factor T of the block reflector.
-*> If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
-*> lower triangular. The rest of the array is not used.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= K.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The shape of the matrix V and the storage of the vectors which define
-*> the H(i) is best illustrated by the following example with n = 5 and
-*> k = 3. The elements equal to 1 are not stored.
-*>
-*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
-*>
-*> V = ( 1 ) V = ( 1 v1 v1 v1 v1 )
-*> ( v1 1 ) ( 1 v2 v2 v2 )
-*> ( v1 v2 1 ) ( 1 v3 v3 )
-*> ( v1 v2 v3 )
-*> ( v1 v2 v3 )
-*>
-*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
-*>
-*> V = ( v1 v2 v3 ) V = ( v1 v1 1 )
-*> ( v1 v2 v3 ) ( v2 v2 v2 1 )
-*> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 )
-*> ( 1 v3 )
-*> ( 1 )
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
-*
-* -- LAPACK auxiliary routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIRECT, STOREV
- INTEGER K, LDT, LDV, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION T( LDT, * ), TAU( * ), V( LDV, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, PREVLASTV, LASTV
-* ..
-* .. External Subroutines ..
- EXTERNAL DGEMV, DTRMV
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
- IF( LSAME( DIRECT, 'F' ) ) THEN
- PREVLASTV = N
- DO I = 1, K
- PREVLASTV = MAX( I, PREVLASTV )
- IF( TAU( I ).EQ.ZERO ) THEN
-*
-* H(i) = I
-*
- DO J = 1, I
- T( J, I ) = ZERO
- END DO
- ELSE
-*
-* general case
-*
- IF( LSAME( STOREV, 'C' ) ) THEN
-* Skip any trailing zeros.
- DO LASTV = N, I+1, -1
- IF( V( LASTV, I ).NE.ZERO ) EXIT
- END DO
- DO J = 1, I-1
- T( J, I ) = -TAU( I ) * V( I , J )
- END DO
- J = MIN( LASTV, PREVLASTV )
-*
-* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**T * V(i:j,i)
-*
- CALL DGEMV( 'Transpose', J-I, I-1, -TAU( I ),
- $ V( I+1, 1 ), LDV, V( I+1, I ), 1, ONE,
- $ T( 1, I ), 1 )
- ELSE
-* Skip any trailing zeros.
- DO LASTV = N, I+1, -1
- IF( V( I, LASTV ).NE.ZERO ) EXIT
- END DO
- DO J = 1, I-1
- T( J, I ) = -TAU( I ) * V( J , I )
- END DO
- J = MIN( LASTV, PREVLASTV )
-*
-* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**T
-*
- CALL DGEMV( 'No transpose', I-1, J-I, -TAU( I ),
- $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV, ONE,
- $ T( 1, I ), 1 )
- END IF
-*
-* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
-*
- CALL DTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
- $ LDT, T( 1, I ), 1 )
- T( I, I ) = TAU( I )
- IF( I.GT.1 ) THEN
- PREVLASTV = MAX( PREVLASTV, LASTV )
- ELSE
- PREVLASTV = LASTV
- END IF
- END IF
- END DO
- ELSE
- PREVLASTV = 1
- DO I = K, 1, -1
- IF( TAU( I ).EQ.ZERO ) THEN
-*
-* H(i) = I
-*
- DO J = I, K
- T( J, I ) = ZERO
- END DO
- ELSE
-*
-* general case
-*
- IF( I.LT.K ) THEN
- IF( LSAME( STOREV, 'C' ) ) THEN
-* Skip any leading zeros.
- DO LASTV = 1, I-1
- IF( V( LASTV, I ).NE.ZERO ) EXIT
- END DO
- DO J = I+1, K
- T( J, I ) = -TAU( I ) * V( N-K+I , J )
- END DO
- J = MAX( LASTV, PREVLASTV )
-*
-* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**T * V(j:n-k+i,i)
-*
- CALL DGEMV( 'Transpose', N-K+I-J, K-I, -TAU( I ),
- $ V( J, I+1 ), LDV, V( J, I ), 1, ONE,
- $ T( I+1, I ), 1 )
- ELSE
-* Skip any leading zeros.
- DO LASTV = 1, I-1
- IF( V( I, LASTV ).NE.ZERO ) EXIT
- END DO
- DO J = I+1, K
- T( J, I ) = -TAU( I ) * V( J, N-K+I )
- END DO
- J = MAX( LASTV, PREVLASTV )
-*
-* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**T
-*
- CALL DGEMV( 'No transpose', K-I, N-K+I-J,
- $ -TAU( I ), V( I+1, J ), LDV, V( I, J ), LDV,
- $ ONE, T( I+1, I ), 1 )
- END IF
-*
-* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)
-*
- CALL DTRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
- $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
- IF( I.GT.1 ) THEN
- PREVLASTV = MIN( PREVLASTV, LASTV )
- ELSE
- PREVLASTV = LASTV
- END IF
- END IF
- T( I, I ) = TAU( I )
- END IF
- END DO
- END IF
- RETURN
-*
-* End of DLARFT
-*
- END
diff --git a/mtx/lapack_src/dlarfx.f b/mtx/lapack_src/dlarfx.f
deleted file mode 100644
index 76338199a..000000000
--- a/mtx/lapack_src/dlarfx.f
+++ /dev/null
@@ -1,697 +0,0 @@
-*> \brief \b DLARFX
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARFX + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARFX( SIDE, M, N, V, TAU, C, LDC, WORK )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE
-* INTEGER LDC, M, N
-* DOUBLE PRECISION TAU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': form H * C
-*> = 'R': form C * H
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C.
-*> \endverbatim
-*>
-*> \param[in] V
-*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (M) if SIDE = 'L'
-*> or (N) if SIDE = 'R'
-*> The vector v in the representation of H.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*> The value tau in the representation of H.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
-*> or C * H if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDA >= (1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (N) if SIDE = 'L'
-*> or (M) if SIDE = 'R'
-*> WORK is not referenced if H has order < 11.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLARFX( SIDE, M, N, V, TAU, C, LDC, WORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE
- INTEGER LDC, M, N
- DOUBLE PRECISION TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER J
- DOUBLE PRECISION SUM, T1, T10, T2, T3, T4, T5, T6, T7, T8, T9,
- $ V1, V10, V2, V3, V4, V5, V6, V7, V8, V9
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF
-* ..
-* .. Executable Statements ..
-*
- IF( TAU.EQ.ZERO )
- $ RETURN
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form H * C, where H has order m.
-*
- GO TO ( 10, 30, 50, 70, 90, 110, 130, 150,
- $ 170, 190 )M
-*
-* Code for general M
-*
- CALL DLARF( SIDE, M, N, V, 1, TAU, C, LDC, WORK )
- GO TO 410
- 10 CONTINUE
-*
-* Special code for 1 x 1 Householder
-*
- T1 = ONE - TAU*V( 1 )*V( 1 )
- DO 20 J = 1, N
- C( 1, J ) = T1*C( 1, J )
- 20 CONTINUE
- GO TO 410
- 30 CONTINUE
-*
-* Special code for 2 x 2 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- DO 40 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- 40 CONTINUE
- GO TO 410
- 50 CONTINUE
-*
-* Special code for 3 x 3 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- DO 60 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- 60 CONTINUE
- GO TO 410
- 70 CONTINUE
-*
-* Special code for 4 x 4 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- DO 80 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- 80 CONTINUE
- GO TO 410
- 90 CONTINUE
-*
-* Special code for 5 x 5 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- DO 100 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- 100 CONTINUE
- GO TO 410
- 110 CONTINUE
-*
-* Special code for 6 x 6 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- DO 120 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- C( 6, J ) = C( 6, J ) - SUM*T6
- 120 CONTINUE
- GO TO 410
- 130 CONTINUE
-*
-* Special code for 7 x 7 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- DO 140 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
- $ V7*C( 7, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- C( 6, J ) = C( 6, J ) - SUM*T6
- C( 7, J ) = C( 7, J ) - SUM*T7
- 140 CONTINUE
- GO TO 410
- 150 CONTINUE
-*
-* Special code for 8 x 8 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- DO 160 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
- $ V7*C( 7, J ) + V8*C( 8, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- C( 6, J ) = C( 6, J ) - SUM*T6
- C( 7, J ) = C( 7, J ) - SUM*T7
- C( 8, J ) = C( 8, J ) - SUM*T8
- 160 CONTINUE
- GO TO 410
- 170 CONTINUE
-*
-* Special code for 9 x 9 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- V9 = V( 9 )
- T9 = TAU*V9
- DO 180 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
- $ V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- C( 6, J ) = C( 6, J ) - SUM*T6
- C( 7, J ) = C( 7, J ) - SUM*T7
- C( 8, J ) = C( 8, J ) - SUM*T8
- C( 9, J ) = C( 9, J ) - SUM*T9
- 180 CONTINUE
- GO TO 410
- 190 CONTINUE
-*
-* Special code for 10 x 10 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- V9 = V( 9 )
- T9 = TAU*V9
- V10 = V( 10 )
- T10 = TAU*V10
- DO 200 J = 1, N
- SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
- $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
- $ V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J ) +
- $ V10*C( 10, J )
- C( 1, J ) = C( 1, J ) - SUM*T1
- C( 2, J ) = C( 2, J ) - SUM*T2
- C( 3, J ) = C( 3, J ) - SUM*T3
- C( 4, J ) = C( 4, J ) - SUM*T4
- C( 5, J ) = C( 5, J ) - SUM*T5
- C( 6, J ) = C( 6, J ) - SUM*T6
- C( 7, J ) = C( 7, J ) - SUM*T7
- C( 8, J ) = C( 8, J ) - SUM*T8
- C( 9, J ) = C( 9, J ) - SUM*T9
- C( 10, J ) = C( 10, J ) - SUM*T10
- 200 CONTINUE
- GO TO 410
- ELSE
-*
-* Form C * H, where H has order n.
-*
- GO TO ( 210, 230, 250, 270, 290, 310, 330, 350,
- $ 370, 390 )N
-*
-* Code for general N
-*
- CALL DLARF( SIDE, M, N, V, 1, TAU, C, LDC, WORK )
- GO TO 410
- 210 CONTINUE
-*
-* Special code for 1 x 1 Householder
-*
- T1 = ONE - TAU*V( 1 )*V( 1 )
- DO 220 J = 1, M
- C( J, 1 ) = T1*C( J, 1 )
- 220 CONTINUE
- GO TO 410
- 230 CONTINUE
-*
-* Special code for 2 x 2 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- DO 240 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- 240 CONTINUE
- GO TO 410
- 250 CONTINUE
-*
-* Special code for 3 x 3 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- DO 260 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- 260 CONTINUE
- GO TO 410
- 270 CONTINUE
-*
-* Special code for 4 x 4 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- DO 280 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- 280 CONTINUE
- GO TO 410
- 290 CONTINUE
-*
-* Special code for 5 x 5 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- DO 300 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- 300 CONTINUE
- GO TO 410
- 310 CONTINUE
-*
-* Special code for 6 x 6 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- DO 320 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- C( J, 6 ) = C( J, 6 ) - SUM*T6
- 320 CONTINUE
- GO TO 410
- 330 CONTINUE
-*
-* Special code for 7 x 7 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- DO 340 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
- $ V7*C( J, 7 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- C( J, 6 ) = C( J, 6 ) - SUM*T6
- C( J, 7 ) = C( J, 7 ) - SUM*T7
- 340 CONTINUE
- GO TO 410
- 350 CONTINUE
-*
-* Special code for 8 x 8 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- DO 360 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
- $ V7*C( J, 7 ) + V8*C( J, 8 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- C( J, 6 ) = C( J, 6 ) - SUM*T6
- C( J, 7 ) = C( J, 7 ) - SUM*T7
- C( J, 8 ) = C( J, 8 ) - SUM*T8
- 360 CONTINUE
- GO TO 410
- 370 CONTINUE
-*
-* Special code for 9 x 9 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- V9 = V( 9 )
- T9 = TAU*V9
- DO 380 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
- $ V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- C( J, 6 ) = C( J, 6 ) - SUM*T6
- C( J, 7 ) = C( J, 7 ) - SUM*T7
- C( J, 8 ) = C( J, 8 ) - SUM*T8
- C( J, 9 ) = C( J, 9 ) - SUM*T9
- 380 CONTINUE
- GO TO 410
- 390 CONTINUE
-*
-* Special code for 10 x 10 Householder
-*
- V1 = V( 1 )
- T1 = TAU*V1
- V2 = V( 2 )
- T2 = TAU*V2
- V3 = V( 3 )
- T3 = TAU*V3
- V4 = V( 4 )
- T4 = TAU*V4
- V5 = V( 5 )
- T5 = TAU*V5
- V6 = V( 6 )
- T6 = TAU*V6
- V7 = V( 7 )
- T7 = TAU*V7
- V8 = V( 8 )
- T8 = TAU*V8
- V9 = V( 9 )
- T9 = TAU*V9
- V10 = V( 10 )
- T10 = TAU*V10
- DO 400 J = 1, M
- SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
- $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
- $ V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 ) +
- $ V10*C( J, 10 )
- C( J, 1 ) = C( J, 1 ) - SUM*T1
- C( J, 2 ) = C( J, 2 ) - SUM*T2
- C( J, 3 ) = C( J, 3 ) - SUM*T3
- C( J, 4 ) = C( J, 4 ) - SUM*T4
- C( J, 5 ) = C( J, 5 ) - SUM*T5
- C( J, 6 ) = C( J, 6 ) - SUM*T6
- C( J, 7 ) = C( J, 7 ) - SUM*T7
- C( J, 8 ) = C( J, 8 ) - SUM*T8
- C( J, 9 ) = C( J, 9 ) - SUM*T9
- C( J, 10 ) = C( J, 10 ) - SUM*T10
- 400 CONTINUE
- GO TO 410
- END IF
- 410 CONTINUE
- RETURN
-*
-* End of DLARFX
-*
- END
diff --git a/mtx/lapack_src/dlartg.f b/mtx/lapack_src/dlartg.f
deleted file mode 100644
index aa68c3776..000000000
--- a/mtx/lapack_src/dlartg.f
+++ /dev/null
@@ -1,204 +0,0 @@
-*> \brief \b DLARTG
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLARTG + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLARTG( F, G, CS, SN, R )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION CS, F, G, R, SN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLARTG generate 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 BLAS1 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 without doing any
-*> floating point operations (saves work in DBDSQR when
-*> there are zeros on the diagonal).
-*>
-*> If F exceeds G in magnitude, CS will be positive.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] F
-*> \verbatim
-*> F is DOUBLE PRECISION
-*> The first component of vector to be rotated.
-*> \endverbatim
-*>
-*> \param[in] G
-*> \verbatim
-*> G is DOUBLE PRECISION
-*> The second component of vector to be rotated.
-*> \endverbatim
-*>
-*> \param[out] CS
-*> \verbatim
-*> CS is DOUBLE PRECISION
-*> The cosine of the rotation.
-*> \endverbatim
-*>
-*> \param[out] SN
-*> \verbatim
-*> SN is DOUBLE PRECISION
-*> The sine of the rotation.
-*> \endverbatim
-*>
-*> \param[out] R
-*> \verbatim
-*> R is DOUBLE PRECISION
-*> The nonzero component of the rotated vector.
-*>
-*> This version has a few statements commented out for thread safety
-*> (machine parameters are computed on each entry). 10 feb 03, SJH.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLARTG( F, G, CS, SN, R )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION CS, F, G, R, SN
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D0 )
-* ..
-* .. Local Scalars ..
-* LOGICAL FIRST
- INTEGER COUNT, I
- DOUBLE PRECISION EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, INT, LOG, MAX, SQRT
-* ..
-* .. Save statement ..
-* SAVE FIRST, SAFMX2, SAFMIN, SAFMN2
-* ..
-* .. Data statements ..
-* DATA FIRST / .TRUE. /
-* ..
-* .. Executable Statements ..
-*
-* IF( FIRST ) THEN
- SAFMIN = DLAMCH( 'S' )
- EPS = DLAMCH( 'E' )
- SAFMN2 = DLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) /
- $ LOG( DLAMCH( 'B' ) ) / TWO )
- SAFMX2 = ONE / SAFMN2
-* FIRST = .FALSE.
-* END IF
- IF( G.EQ.ZERO ) THEN
- CS = ONE
- SN = ZERO
- R = F
- ELSE IF( F.EQ.ZERO ) THEN
- CS = ZERO
- SN = ONE
- R = G
- ELSE
- F1 = F
- G1 = G
- SCALE = MAX( ABS( F1 ), ABS( G1 ) )
- IF( SCALE.GE.SAFMX2 ) THEN
- COUNT = 0
- 10 CONTINUE
- COUNT = COUNT + 1
- F1 = F1*SAFMN2
- G1 = G1*SAFMN2
- SCALE = MAX( ABS( F1 ), ABS( G1 ) )
- IF( SCALE.GE.SAFMX2 )
- $ GO TO 10
- R = SQRT( F1**2+G1**2 )
- CS = F1 / R
- SN = G1 / R
- DO 20 I = 1, COUNT
- R = R*SAFMX2
- 20 CONTINUE
- ELSE IF( SCALE.LE.SAFMN2 ) THEN
- COUNT = 0
- 30 CONTINUE
- COUNT = COUNT + 1
- F1 = F1*SAFMX2
- G1 = G1*SAFMX2
- SCALE = MAX( ABS( F1 ), ABS( G1 ) )
- IF( SCALE.LE.SAFMN2 )
- $ GO TO 30
- R = SQRT( F1**2+G1**2 )
- CS = F1 / R
- SN = G1 / R
- DO 40 I = 1, COUNT
- R = R*SAFMN2
- 40 CONTINUE
- ELSE
- R = SQRT( F1**2+G1**2 )
- CS = F1 / R
- SN = G1 / R
- END IF
- IF( ABS( F ).GT.ABS( G ) .AND. CS.LT.ZERO ) THEN
- CS = -CS
- SN = -SN
- R = -R
- END IF
- END IF
- RETURN
-*
-* End of DLARTG
-*
- END
diff --git a/mtx/lapack_src/dlas2.f b/mtx/lapack_src/dlas2.f
deleted file mode 100644
index a6a711dda..000000000
--- a/mtx/lapack_src/dlas2.f
+++ /dev/null
@@ -1,183 +0,0 @@
-*> \brief \b DLAS2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLAS2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLAS2( F, G, H, SSMIN, SSMAX )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION F, G, H, SSMAX, SSMIN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] F
-*> \verbatim
-*> F is DOUBLE PRECISION
-*> The (1,1) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] G
-*> \verbatim
-*> G is DOUBLE PRECISION
-*> The (1,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] H
-*> \verbatim
-*> H is DOUBLE PRECISION
-*> The (2,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[out] SSMIN
-*> \verbatim
-*> SSMIN is DOUBLE PRECISION
-*> The smaller singular value.
-*> \endverbatim
-*>
-*> \param[out] SSMAX
-*> \verbatim
-*> SSMAX is DOUBLE PRECISION
-*> The larger singular value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Barring over/underflow, all output quantities are correct to within
-*> a few units in the last place (ulps), even in the absence of a guard
-*> digit in addition/subtraction.
-*>
-*> In IEEE arithmetic, the code works correctly if one matrix element is
-*> infinite.
-*>
-*> Overflow will not occur unless the largest singular value itself
-*> overflows, or is within a few ulps of overflow. (On machines with
-*> partial overflow, like the Cray, overflow may occur if the largest
-*> singular value is within a factor of 2 of overflow.)
-*>
-*> Underflow is harmless if underflow is gradual. Otherwise, results
-*> may correspond to a matrix modified by perturbations of size near
-*> the underflow threshold.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLAS2( F, G, H, SSMIN, SSMAX )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION F, G, H, SSMAX, SSMIN
-* ..
-*
-* ====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D0 )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION AS, AT, AU, C, FA, FHMN, FHMX, GA, HA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- FA = ABS( F )
- GA = ABS( G )
- HA = ABS( H )
- FHMN = MIN( FA, HA )
- FHMX = MAX( FA, HA )
- IF( FHMN.EQ.ZERO ) THEN
- SSMIN = ZERO
- IF( FHMX.EQ.ZERO ) THEN
- SSMAX = GA
- ELSE
- SSMAX = MAX( FHMX, GA )*SQRT( ONE+
- $ ( MIN( FHMX, GA ) / MAX( FHMX, GA ) )**2 )
- END IF
- ELSE
- IF( GA.LT.FHMX ) THEN
- AS = ONE + FHMN / FHMX
- AT = ( FHMX-FHMN ) / FHMX
- AU = ( GA / FHMX )**2
- C = TWO / ( SQRT( AS*AS+AU )+SQRT( AT*AT+AU ) )
- SSMIN = FHMN*C
- SSMAX = FHMX / C
- ELSE
- AU = FHMX / GA
- IF( AU.EQ.ZERO ) THEN
-*
-* Avoid possible harmful underflow if exponent range
-* asymmetric (true SSMIN may not underflow even if
-* AU underflows)
-*
- SSMIN = ( FHMN*FHMX ) / GA
- SSMAX = GA
- ELSE
- AS = ONE + FHMN / FHMX
- AT = ( FHMX-FHMN ) / FHMX
- C = ONE / ( SQRT( ONE+( AS*AU )**2 )+
- $ SQRT( ONE+( AT*AU )**2 ) )
- SSMIN = ( FHMN*C )*AU
- SSMIN = SSMIN + SSMIN
- SSMAX = GA / ( C+C )
- END IF
- END IF
- END IF
- RETURN
-*
-* End of DLAS2
-*
- END
diff --git a/mtx/lapack_src/dlascl.f b/mtx/lapack_src/dlascl.f
deleted file mode 100644
index 5b4d3b24e..000000000
--- a/mtx/lapack_src/dlascl.f
+++ /dev/null
@@ -1,364 +0,0 @@
-*> \brief \b DLASCL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASCL + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TYPE
-* INTEGER INFO, KL, KU, LDA, M, N
-* DOUBLE PRECISION CFROM, CTO
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TYPE
-*> \verbatim
-*> TYPE is CHARACTER*1
-*> TYPE indices the storage type of the input matrix.
-*> = 'G': A is a full matrix.
-*> = 'L': A is a lower triangular matrix.
-*> = 'U': A is an upper triangular matrix.
-*> = 'H': A is an upper Hessenberg matrix.
-*> = 'B': A is a symmetric band matrix with lower bandwidth KL
-*> and upper bandwidth KU and with the only the lower
-*> half stored.
-*> = 'Q': A is a symmetric band matrix with lower bandwidth KL
-*> and upper bandwidth KU and with the only the upper
-*> half stored.
-*> = 'Z': A is a band matrix with lower bandwidth KL and upper
-*> bandwidth KU. See DGBTRF for storage details.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The lower bandwidth of A. Referenced only if TYPE = 'B',
-*> 'Q' or 'Z'.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The upper bandwidth of A. Referenced only if TYPE = 'B',
-*> 'Q' or 'Z'.
-*> \endverbatim
-*>
-*> \param[in] CFROM
-*> \verbatim
-*> CFROM is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in] CTO
-*> \verbatim
-*> CTO is DOUBLE PRECISION
-*>
-*> The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
-*> without over/underflow if the final result CTO*A(I,J)/CFROM
-*> can be represented without over/underflow. CFROM must be
-*> nonzero.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The matrix to be multiplied by CTO/CFROM. See TYPE for the
-*> storage type.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> 0 - successful exit
-*> <0 - if INFO = -i, the i-th argument had an illegal value.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TYPE
- INTEGER INFO, KL, KU, LDA, M, N
- DOUBLE PRECISION CFROM, CTO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL DONE
- INTEGER I, ITYPE, J, K1, K2, K3, K4
- DOUBLE PRECISION BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM
-* ..
-* .. External Functions ..
- LOGICAL LSAME, DISNAN
- DOUBLE PRECISION DLAMCH
- EXTERNAL LSAME, DLAMCH, DISNAN
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
-*
- IF( LSAME( TYPE, 'G' ) ) THEN
- ITYPE = 0
- ELSE IF( LSAME( TYPE, 'L' ) ) THEN
- ITYPE = 1
- ELSE IF( LSAME( TYPE, 'U' ) ) THEN
- ITYPE = 2
- ELSE IF( LSAME( TYPE, 'H' ) ) THEN
- ITYPE = 3
- ELSE IF( LSAME( TYPE, 'B' ) ) THEN
- ITYPE = 4
- ELSE IF( LSAME( TYPE, 'Q' ) ) THEN
- ITYPE = 5
- ELSE IF( LSAME( TYPE, 'Z' ) ) THEN
- ITYPE = 6
- ELSE
- ITYPE = -1
- END IF
-*
- IF( ITYPE.EQ.-1 ) THEN
- INFO = -1
- ELSE IF( CFROM.EQ.ZERO .OR. DISNAN(CFROM) ) THEN
- INFO = -4
- ELSE IF( DISNAN(CTO) ) THEN
- INFO = -5
- ELSE IF( M.LT.0 ) THEN
- INFO = -6
- ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.4 .AND. N.NE.M ) .OR.
- $ ( ITYPE.EQ.5 .AND. N.NE.M ) ) THEN
- INFO = -7
- ELSE IF( ITYPE.LE.3 .AND. LDA.LT.MAX( 1, M ) ) THEN
- INFO = -9
- ELSE IF( ITYPE.GE.4 ) THEN
- IF( KL.LT.0 .OR. KL.GT.MAX( M-1, 0 ) ) THEN
- INFO = -2
- ELSE IF( KU.LT.0 .OR. KU.GT.MAX( N-1, 0 ) .OR.
- $ ( ( ITYPE.EQ.4 .OR. ITYPE.EQ.5 ) .AND. KL.NE.KU ) )
- $ THEN
- INFO = -3
- ELSE IF( ( ITYPE.EQ.4 .AND. LDA.LT.KL+1 ) .OR.
- $ ( ITYPE.EQ.5 .AND. LDA.LT.KU+1 ) .OR.
- $ ( ITYPE.EQ.6 .AND. LDA.LT.2*KL+KU+1 ) ) THEN
- INFO = -9
- END IF
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASCL', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. M.EQ.0 )
- $ RETURN
-*
-* Get machine parameters
-*
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
-*
- CFROMC = CFROM
- CTOC = CTO
-*
- 10 CONTINUE
- CFROM1 = CFROMC*SMLNUM
- IF( CFROM1.EQ.CFROMC ) THEN
-! CFROMC is an inf. Multiply by a correctly signed zero for
-! finite CTOC, or a NaN if CTOC is infinite.
- MUL = CTOC / CFROMC
- DONE = .TRUE.
- CTO1 = CTOC
- ELSE
- CTO1 = CTOC / BIGNUM
- IF( CTO1.EQ.CTOC ) THEN
-! CTOC is either 0 or an inf. In both cases, CTOC itself
-! serves as the correct multiplication factor.
- MUL = CTOC
- DONE = .TRUE.
- CFROMC = ONE
- ELSE IF( ABS( CFROM1 ).GT.ABS( CTOC ) .AND. CTOC.NE.ZERO ) THEN
- MUL = SMLNUM
- DONE = .FALSE.
- CFROMC = CFROM1
- ELSE IF( ABS( CTO1 ).GT.ABS( CFROMC ) ) THEN
- MUL = BIGNUM
- DONE = .FALSE.
- CTOC = CTO1
- ELSE
- MUL = CTOC / CFROMC
- DONE = .TRUE.
- END IF
- END IF
-*
- IF( ITYPE.EQ.0 ) THEN
-*
-* Full matrix
-*
- DO 30 J = 1, N
- DO 20 I = 1, M
- A( I, J ) = A( I, J )*MUL
- 20 CONTINUE
- 30 CONTINUE
-*
- ELSE IF( ITYPE.EQ.1 ) THEN
-*
-* Lower triangular matrix
-*
- DO 50 J = 1, N
- DO 40 I = J, M
- A( I, J ) = A( I, J )*MUL
- 40 CONTINUE
- 50 CONTINUE
-*
- ELSE IF( ITYPE.EQ.2 ) THEN
-*
-* Upper triangular matrix
-*
- DO 70 J = 1, N
- DO 60 I = 1, MIN( J, M )
- A( I, J ) = A( I, J )*MUL
- 60 CONTINUE
- 70 CONTINUE
-*
- ELSE IF( ITYPE.EQ.3 ) THEN
-*
-* Upper Hessenberg matrix
-*
- DO 90 J = 1, N
- DO 80 I = 1, MIN( J+1, M )
- A( I, J ) = A( I, J )*MUL
- 80 CONTINUE
- 90 CONTINUE
-*
- ELSE IF( ITYPE.EQ.4 ) THEN
-*
-* Lower half of a symmetric band matrix
-*
- K3 = KL + 1
- K4 = N + 1
- DO 110 J = 1, N
- DO 100 I = 1, MIN( K3, K4-J )
- A( I, J ) = A( I, J )*MUL
- 100 CONTINUE
- 110 CONTINUE
-*
- ELSE IF( ITYPE.EQ.5 ) THEN
-*
-* Upper half of a symmetric band matrix
-*
- K1 = KU + 2
- K3 = KU + 1
- DO 130 J = 1, N
- DO 120 I = MAX( K1-J, 1 ), K3
- A( I, J ) = A( I, J )*MUL
- 120 CONTINUE
- 130 CONTINUE
-*
- ELSE IF( ITYPE.EQ.6 ) THEN
-*
-* Band matrix
-*
- K1 = KL + KU + 2
- K2 = KL + 1
- K3 = 2*KL + KU + 1
- K4 = KL + KU + 1 + M
- DO 150 J = 1, N
- DO 140 I = MAX( K1-J, K2 ), MIN( K3, K4-J )
- A( I, J ) = A( I, J )*MUL
- 140 CONTINUE
- 150 CONTINUE
-*
- END IF
-*
- IF( .NOT.DONE )
- $ GO TO 10
-*
- RETURN
-*
-* End of DLASCL
-*
- END
diff --git a/mtx/lapack_src/dlaset.f b/mtx/lapack_src/dlaset.f
deleted file mode 100644
index 166a8da97..000000000
--- a/mtx/lapack_src/dlaset.f
+++ /dev/null
@@ -1,184 +0,0 @@
-*> \brief \b DLASET
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASET + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* INTEGER LDA, M, N
-* DOUBLE PRECISION ALPHA, BETA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASET initializes an m-by-n matrix A to BETA on the diagonal and
-*> ALPHA on the offdiagonals.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies the part of the matrix A to be set.
-*> = 'U': Upper triangular part is set; the strictly lower
-*> triangular part of A is not changed.
-*> = 'L': Lower triangular part is set; the strictly upper
-*> triangular part of A is not changed.
-*> Otherwise: All of the matrix A is set.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ALPHA
-*> \verbatim
-*> ALPHA is DOUBLE PRECISION
-*> The constant to which the offdiagonal elements are to be set.
-*> \endverbatim
-*>
-*> \param[in] BETA
-*> \verbatim
-*> BETA is DOUBLE PRECISION
-*> The constant to which the diagonal elements are to be set.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On exit, the leading m-by-n submatrix of A is set as follows:
-*>
-*> if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
-*> if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
-*> otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
-*>
-*> and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER LDA, M, N
- DOUBLE PRECISION ALPHA, BETA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
- IF( LSAME( UPLO, 'U' ) ) THEN
-*
-* Set the strictly upper triangular or trapezoidal part of the
-* array to ALPHA.
-*
- DO 20 J = 2, N
- DO 10 I = 1, MIN( J-1, M )
- A( I, J ) = ALPHA
- 10 CONTINUE
- 20 CONTINUE
-*
- ELSE IF( LSAME( UPLO, 'L' ) ) THEN
-*
-* Set the strictly lower triangular or trapezoidal part of the
-* array to ALPHA.
-*
- DO 40 J = 1, MIN( M, N )
- DO 30 I = J + 1, M
- A( I, J ) = ALPHA
- 30 CONTINUE
- 40 CONTINUE
-*
- ELSE
-*
-* Set the leading m-by-n submatrix to ALPHA.
-*
- DO 60 J = 1, N
- DO 50 I = 1, M
- A( I, J ) = ALPHA
- 50 CONTINUE
- 60 CONTINUE
- END IF
-*
-* Set the first min(M,N) diagonal elements to BETA.
-*
- DO 70 I = 1, MIN( M, N )
- A( I, I ) = BETA
- 70 CONTINUE
-*
- RETURN
-*
-* End of DLASET
-*
- END
diff --git a/mtx/lapack_src/dlasq1.f b/mtx/lapack_src/dlasq1.f
deleted file mode 100644
index af70675ab..000000000
--- a/mtx/lapack_src/dlasq1.f
+++ /dev/null
@@ -1,224 +0,0 @@
-*> \brief \b DLASQ1
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASQ1 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASQ1( N, D, E, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * ), E( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows and columns in the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, D contains the diagonal elements of the
-*> bidiagonal matrix whose SVD is desired. On normal exit,
-*> D contains the singular values in decreasing order.
-*> \endverbatim
-*>
-*> \param[in,out] E
-*> \verbatim
-*> E is DOUBLE PRECISION array, dimension (N)
-*> On entry, elements E(1:N-1) contain the off-diagonal elements
-*> of the bidiagonal matrix whose SVD is desired.
-*> On exit, E is overwritten.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (4*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: the algorithm failed
-*> = 1, a split was marked by a positive value in E
-*> = 2, current block of Z not diagonalized after 100*N
-*> iterations (in inner while loop) On exit D and E
-*> represent a matrix with the same singular values
-*> which the calling subroutine could use to finish the
-*> computation, or even feed back into DLASQ1
-*> = 3, termination criterion of outer while loop not met
-*> (program created more than N unreduced blocks)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLASQ1( N, D, E, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * ), E( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IINFO
- DOUBLE PRECISION EPS, SCALE, SAFMIN, SIGMN, SIGMX
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DLAS2, DLASCL, DLASQ2, DLASRT, XERBLA
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -2
- CALL XERBLA( 'DLASQ1', -INFO )
- RETURN
- ELSE IF( N.EQ.0 ) THEN
- RETURN
- ELSE IF( N.EQ.1 ) THEN
- D( 1 ) = ABS( D( 1 ) )
- RETURN
- ELSE IF( N.EQ.2 ) THEN
- CALL DLAS2( D( 1 ), E( 1 ), D( 2 ), SIGMN, SIGMX )
- D( 1 ) = SIGMX
- D( 2 ) = SIGMN
- RETURN
- END IF
-*
-* Estimate the largest singular value.
-*
- SIGMX = ZERO
- DO 10 I = 1, N - 1
- D( I ) = ABS( D( I ) )
- SIGMX = MAX( SIGMX, ABS( E( I ) ) )
- 10 CONTINUE
- D( N ) = ABS( D( N ) )
-*
-* Early return if SIGMX is zero (matrix is already diagonal).
-*
- IF( SIGMX.EQ.ZERO ) THEN
- CALL DLASRT( 'D', N, D, IINFO )
- RETURN
- END IF
-*
- DO 20 I = 1, N
- SIGMX = MAX( SIGMX, D( I ) )
- 20 CONTINUE
-*
-* Copy D and E into WORK (in the Z format) and scale (squaring the
-* input data makes scaling by a power of the radix pointless).
-*
- EPS = DLAMCH( 'Precision' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- SCALE = SQRT( EPS / SAFMIN )
- CALL DCOPY( N, D, 1, WORK( 1 ), 2 )
- CALL DCOPY( N-1, E, 1, WORK( 2 ), 2 )
- CALL DLASCL( 'G', 0, 0, SIGMX, SCALE, 2*N-1, 1, WORK, 2*N-1,
- $ IINFO )
-*
-* Compute the q's and e's.
-*
- DO 30 I = 1, 2*N - 1
- WORK( I ) = WORK( I )**2
- 30 CONTINUE
- WORK( 2*N ) = ZERO
-*
- CALL DLASQ2( N, WORK, INFO )
-*
- IF( INFO.EQ.0 ) THEN
- DO 40 I = 1, N
- D( I ) = SQRT( WORK( I ) )
- 40 CONTINUE
- CALL DLASCL( 'G', 0, 0, SCALE, SIGMX, N, 1, D, N, IINFO )
- ELSE IF( INFO.EQ.2 ) THEN
-*
-* Maximum number of iterations exceeded. Move data from WORK
-* into D and E so the calling subroutine can try to finish
-*
- DO I = 1, N
- D( I ) = SQRT( WORK( 2*I-1 ) )
- E( I ) = SQRT( WORK( 2*I ) )
- END DO
- CALL DLASCL( 'G', 0, 0, SCALE, SIGMX, N, 1, D, N, IINFO )
- CALL DLASCL( 'G', 0, 0, SCALE, SIGMX, N, 1, E, N, IINFO )
- END IF
-*
- RETURN
-*
-* End of DLASQ1
-*
- END
diff --git a/mtx/lapack_src/dlasq2.f b/mtx/lapack_src/dlasq2.f
deleted file mode 100644
index 94feaba7b..000000000
--- a/mtx/lapack_src/dlasq2.f
+++ /dev/null
@@ -1,582 +0,0 @@
-*> \brief \b DLASQ2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASQ2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASQ2( N, Z, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of rows and columns in the matrix. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( 4*N )
-*> On entry Z holds the qd array. On exit, entries 1 to N hold
-*> the eigenvalues in decreasing order, Z( 2*N+1 ) holds the
-*> trace, and Z( 2*N+2 ) holds the sum of the eigenvalues. If
-*> N > 2, then Z( 2*N+3 ) holds the iteration count, Z( 2*N+4 )
-*> holds NDIVS/NIN^2, and Z( 2*N+5 ) holds the percentage of
-*> shifts that failed.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if the i-th argument is a scalar and had an illegal
-*> value, then INFO = -i, if the i-th argument is an
-*> array and the j-entry had an illegal value, then
-*> INFO = -(i*100+j)
-*> > 0: the algorithm failed
-*> = 1, a split was marked by a positive value in E
-*> = 2, current block of Z not diagonalized after 100*N
-*> iterations (in inner while loop). On exit Z holds
-*> a qd array with the same eigenvalues as the given Z.
-*> = 3, termination criterion of outer while loop not met
-*> (program created more than N unreduced blocks)
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Local Variables: I0:N0 defines a current unreduced segment of Z.
-*> The shifts are accumulated in SIGMA. Iteration count is in ITER.
-*> Ping-pong is controlled by PP (alternates between 0 and 1).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLASQ2( N, Z, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION CBIAS
- PARAMETER ( CBIAS = 1.50D0 )
- DOUBLE PRECISION ZERO, HALF, ONE, TWO, FOUR, HUNDRD
- PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0,
- $ TWO = 2.0D0, FOUR = 4.0D0, HUNDRD = 100.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL IEEE
- INTEGER I0, I1, I4, IINFO, IPN4, ITER, IWHILA, IWHILB,
- $ K, KMIN, N0, N1, NBIG, NDIV, NFAIL, PP, SPLT,
- $ TTYPE
- DOUBLE PRECISION D, DEE, DEEMIN, DESIG, DMIN, DMIN1, DMIN2, DN,
- $ DN1, DN2, E, EMAX, EMIN, EPS, G, OLDEMN, QMAX,
- $ QMIN, S, SAFMIN, SIGMA, T, TAU, TEMP, TOL,
- $ TOL2, TRACE, ZMAX, TEMPE, TEMPQ
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASQ3, DLASRT, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH, ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments.
-* (in case DLASQ2 is not called by DLASQ1)
-*
- INFO = 0
- EPS = DLAMCH( 'Precision' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- TOL = EPS*HUNDRD
- TOL2 = TOL**2
-*
- IF( N.LT.0 ) THEN
- INFO = -1
- CALL XERBLA( 'DLASQ2', 1 )
- RETURN
- ELSE IF( N.EQ.0 ) THEN
- RETURN
- ELSE IF( N.EQ.1 ) THEN
-*
-* 1-by-1 case.
-*
- IF( Z( 1 ).LT.ZERO ) THEN
- INFO = -201
- CALL XERBLA( 'DLASQ2', 2 )
- END IF
- RETURN
- ELSE IF( N.EQ.2 ) THEN
-*
-* 2-by-2 case.
-*
- IF( Z( 2 ).LT.ZERO .OR. Z( 3 ).LT.ZERO ) THEN
- INFO = -2
- CALL XERBLA( 'DLASQ2', 2 )
- RETURN
- ELSE IF( Z( 3 ).GT.Z( 1 ) ) THEN
- D = Z( 3 )
- Z( 3 ) = Z( 1 )
- Z( 1 ) = D
- END IF
- Z( 5 ) = Z( 1 ) + Z( 2 ) + Z( 3 )
- IF( Z( 2 ).GT.Z( 3 )*TOL2 ) THEN
- T = HALF*( ( Z( 1 )-Z( 3 ) )+Z( 2 ) )
- S = Z( 3 )*( Z( 2 ) / T )
- IF( S.LE.T ) THEN
- S = Z( 3 )*( Z( 2 ) / ( T*( ONE+SQRT( ONE+S / T ) ) ) )
- ELSE
- S = Z( 3 )*( Z( 2 ) / ( T+SQRT( T )*SQRT( T+S ) ) )
- END IF
- T = Z( 1 ) + ( S+Z( 2 ) )
- Z( 3 ) = Z( 3 )*( Z( 1 ) / T )
- Z( 1 ) = T
- END IF
- Z( 2 ) = Z( 3 )
- Z( 6 ) = Z( 2 ) + Z( 1 )
- RETURN
- END IF
-*
-* Check for negative data and compute sums of q's and e's.
-*
- Z( 2*N ) = ZERO
- EMIN = Z( 2 )
- QMAX = ZERO
- ZMAX = ZERO
- D = ZERO
- E = ZERO
-*
- DO 10 K = 1, 2*( N-1 ), 2
- IF( Z( K ).LT.ZERO ) THEN
- INFO = -( 200+K )
- CALL XERBLA( 'DLASQ2', 2 )
- RETURN
- ELSE IF( Z( K+1 ).LT.ZERO ) THEN
- INFO = -( 200+K+1 )
- CALL XERBLA( 'DLASQ2', 2 )
- RETURN
- END IF
- D = D + Z( K )
- E = E + Z( K+1 )
- QMAX = MAX( QMAX, Z( K ) )
- EMIN = MIN( EMIN, Z( K+1 ) )
- ZMAX = MAX( QMAX, ZMAX, Z( K+1 ) )
- 10 CONTINUE
- IF( Z( 2*N-1 ).LT.ZERO ) THEN
- INFO = -( 200+2*N-1 )
- CALL XERBLA( 'DLASQ2', 2 )
- RETURN
- END IF
- D = D + Z( 2*N-1 )
- QMAX = MAX( QMAX, Z( 2*N-1 ) )
- ZMAX = MAX( QMAX, ZMAX )
-*
-* Check for diagonality.
-*
- IF( E.EQ.ZERO ) THEN
- DO 20 K = 2, N
- Z( K ) = Z( 2*K-1 )
- 20 CONTINUE
- CALL DLASRT( 'D', N, Z, IINFO )
- Z( 2*N-1 ) = D
- RETURN
- END IF
-*
- TRACE = D + E
-*
-* Check for zero data.
-*
- IF( TRACE.EQ.ZERO ) THEN
- Z( 2*N-1 ) = ZERO
- RETURN
- END IF
-*
-* Check whether the machine is IEEE conformable.
-*
- IEEE = ILAENV( 10, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1 .AND.
- $ ILAENV( 11, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1
-*
-* Rearrange data for locality: Z=(q1,qq1,e1,ee1,q2,qq2,e2,ee2,...).
-*
- DO 30 K = 2*N, 2, -2
- Z( 2*K ) = ZERO
- Z( 2*K-1 ) = Z( K )
- Z( 2*K-2 ) = ZERO
- Z( 2*K-3 ) = Z( K-1 )
- 30 CONTINUE
-*
- I0 = 1
- N0 = N
-*
-* Reverse the qd-array, if warranted.
-*
- IF( CBIAS*Z( 4*I0-3 ).LT.Z( 4*N0-3 ) ) THEN
- IPN4 = 4*( I0+N0 )
- DO 40 I4 = 4*I0, 2*( I0+N0-1 ), 4
- TEMP = Z( I4-3 )
- Z( I4-3 ) = Z( IPN4-I4-3 )
- Z( IPN4-I4-3 ) = TEMP
- TEMP = Z( I4-1 )
- Z( I4-1 ) = Z( IPN4-I4-5 )
- Z( IPN4-I4-5 ) = TEMP
- 40 CONTINUE
- END IF
-*
-* Initial split checking via dqd and Li's test.
-*
- PP = 0
-*
- DO 80 K = 1, 2
-*
- D = Z( 4*N0+PP-3 )
- DO 50 I4 = 4*( N0-1 ) + PP, 4*I0 + PP, -4
- IF( Z( I4-1 ).LE.TOL2*D ) THEN
- Z( I4-1 ) = -ZERO
- D = Z( I4-3 )
- ELSE
- D = Z( I4-3 )*( D / ( D+Z( I4-1 ) ) )
- END IF
- 50 CONTINUE
-*
-* dqd maps Z to ZZ plus Li's test.
-*
- EMIN = Z( 4*I0+PP+1 )
- D = Z( 4*I0+PP-3 )
- DO 60 I4 = 4*I0 + PP, 4*( N0-1 ) + PP, 4
- Z( I4-2*PP-2 ) = D + Z( I4-1 )
- IF( Z( I4-1 ).LE.TOL2*D ) THEN
- Z( I4-1 ) = -ZERO
- Z( I4-2*PP-2 ) = D
- Z( I4-2*PP ) = ZERO
- D = Z( I4+1 )
- ELSE IF( SAFMIN*Z( I4+1 ).LT.Z( I4-2*PP-2 ) .AND.
- $ SAFMIN*Z( I4-2*PP-2 ).LT.Z( I4+1 ) ) THEN
- TEMP = Z( I4+1 ) / Z( I4-2*PP-2 )
- Z( I4-2*PP ) = Z( I4-1 )*TEMP
- D = D*TEMP
- ELSE
- Z( I4-2*PP ) = Z( I4+1 )*( Z( I4-1 ) / Z( I4-2*PP-2 ) )
- D = Z( I4+1 )*( D / Z( I4-2*PP-2 ) )
- END IF
- EMIN = MIN( EMIN, Z( I4-2*PP ) )
- 60 CONTINUE
- Z( 4*N0-PP-2 ) = D
-*
-* Now find qmax.
-*
- QMAX = Z( 4*I0-PP-2 )
- DO 70 I4 = 4*I0 - PP + 2, 4*N0 - PP - 2, 4
- QMAX = MAX( QMAX, Z( I4 ) )
- 70 CONTINUE
-*
-* Prepare for the next iteration on K.
-*
- PP = 1 - PP
- 80 CONTINUE
-*
-* Initialise variables to pass to DLASQ3.
-*
- TTYPE = 0
- DMIN1 = ZERO
- DMIN2 = ZERO
- DN = ZERO
- DN1 = ZERO
- DN2 = ZERO
- G = ZERO
- TAU = ZERO
-*
- ITER = 2
- NFAIL = 0
- NDIV = 2*( N0-I0 )
-*
- DO 160 IWHILA = 1, N + 1
- IF( N0.LT.1 )
- $ GO TO 170
-*
-* While array unfinished do
-*
-* E(N0) holds the value of SIGMA when submatrix in I0:N0
-* splits from the rest of the array, but is negated.
-*
- DESIG = ZERO
- IF( N0.EQ.N ) THEN
- SIGMA = ZERO
- ELSE
- SIGMA = -Z( 4*N0-1 )
- END IF
- IF( SIGMA.LT.ZERO ) THEN
- INFO = 1
- RETURN
- END IF
-*
-* Find last unreduced submatrix's top index I0, find QMAX and
-* EMIN. Find Gershgorin-type bound if Q's much greater than E's.
-*
- EMAX = ZERO
- IF( N0.GT.I0 ) THEN
- EMIN = ABS( Z( 4*N0-5 ) )
- ELSE
- EMIN = ZERO
- END IF
- QMIN = Z( 4*N0-3 )
- QMAX = QMIN
- DO 90 I4 = 4*N0, 8, -4
- IF( Z( I4-5 ).LE.ZERO )
- $ GO TO 100
- IF( QMIN.GE.FOUR*EMAX ) THEN
- QMIN = MIN( QMIN, Z( I4-3 ) )
- EMAX = MAX( EMAX, Z( I4-5 ) )
- END IF
- QMAX = MAX( QMAX, Z( I4-7 )+Z( I4-5 ) )
- EMIN = MIN( EMIN, Z( I4-5 ) )
- 90 CONTINUE
- I4 = 4
-*
- 100 CONTINUE
- I0 = I4 / 4
- PP = 0
-*
- IF( N0-I0.GT.1 ) THEN
- DEE = Z( 4*I0-3 )
- DEEMIN = DEE
- KMIN = I0
- DO 110 I4 = 4*I0+1, 4*N0-3, 4
- DEE = Z( I4 )*( DEE /( DEE+Z( I4-2 ) ) )
- IF( DEE.LE.DEEMIN ) THEN
- DEEMIN = DEE
- KMIN = ( I4+3 )/4
- END IF
- 110 CONTINUE
- IF( (KMIN-I0)*2.LT.N0-KMIN .AND.
- $ DEEMIN.LE.HALF*Z(4*N0-3) ) THEN
- IPN4 = 4*( I0+N0 )
- PP = 2
- DO 120 I4 = 4*I0, 2*( I0+N0-1 ), 4
- TEMP = Z( I4-3 )
- Z( I4-3 ) = Z( IPN4-I4-3 )
- Z( IPN4-I4-3 ) = TEMP
- TEMP = Z( I4-2 )
- Z( I4-2 ) = Z( IPN4-I4-2 )
- Z( IPN4-I4-2 ) = TEMP
- TEMP = Z( I4-1 )
- Z( I4-1 ) = Z( IPN4-I4-5 )
- Z( IPN4-I4-5 ) = TEMP
- TEMP = Z( I4 )
- Z( I4 ) = Z( IPN4-I4-4 )
- Z( IPN4-I4-4 ) = TEMP
- 120 CONTINUE
- END IF
- END IF
-*
-* Put -(initial shift) into DMIN.
-*
- DMIN = -MAX( ZERO, QMIN-TWO*SQRT( QMIN )*SQRT( EMAX ) )
-*
-* Now I0:N0 is unreduced.
-* PP = 0 for ping, PP = 1 for pong.
-* PP = 2 indicates that flipping was applied to the Z array and
-* and that the tests for deflation upon entry in DLASQ3
-* should not be performed.
-*
- NBIG = 100*( N0-I0+1 )
- DO 140 IWHILB = 1, NBIG
- IF( I0.GT.N0 )
- $ GO TO 150
-*
-* While submatrix unfinished take a good dqds step.
-*
- CALL DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
- $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1,
- $ DN2, G, TAU )
-*
- PP = 1 - PP
-*
-* When EMIN is very small check for splits.
-*
- IF( PP.EQ.0 .AND. N0-I0.GE.3 ) THEN
- IF( Z( 4*N0 ).LE.TOL2*QMAX .OR.
- $ Z( 4*N0-1 ).LE.TOL2*SIGMA ) THEN
- SPLT = I0 - 1
- QMAX = Z( 4*I0-3 )
- EMIN = Z( 4*I0-1 )
- OLDEMN = Z( 4*I0 )
- DO 130 I4 = 4*I0, 4*( N0-3 ), 4
- IF( Z( I4 ).LE.TOL2*Z( I4-3 ) .OR.
- $ Z( I4-1 ).LE.TOL2*SIGMA ) THEN
- Z( I4-1 ) = -SIGMA
- SPLT = I4 / 4
- QMAX = ZERO
- EMIN = Z( I4+3 )
- OLDEMN = Z( I4+4 )
- ELSE
- QMAX = MAX( QMAX, Z( I4+1 ) )
- EMIN = MIN( EMIN, Z( I4-1 ) )
- OLDEMN = MIN( OLDEMN, Z( I4 ) )
- END IF
- 130 CONTINUE
- Z( 4*N0-1 ) = EMIN
- Z( 4*N0 ) = OLDEMN
- I0 = SPLT + 1
- END IF
- END IF
-*
- 140 CONTINUE
-*
- INFO = 2
-*
-* Maximum number of iterations exceeded, restore the shift
-* SIGMA and place the new d's and e's in a qd array.
-* This might need to be done for several blocks
-*
- I1 = I0
- N1 = N0
- 145 CONTINUE
- TEMPQ = Z( 4*I0-3 )
- Z( 4*I0-3 ) = Z( 4*I0-3 ) + SIGMA
- DO K = I0+1, N0
- TEMPE = Z( 4*K-5 )
- Z( 4*K-5 ) = Z( 4*K-5 ) * (TEMPQ / Z( 4*K-7 ))
- TEMPQ = Z( 4*K-3 )
- Z( 4*K-3 ) = Z( 4*K-3 ) + SIGMA + TEMPE - Z( 4*K-5 )
- END DO
-*
-* Prepare to do this on the previous block if there is one
-*
- IF( I1.GT.1 ) THEN
- N1 = I1-1
- DO WHILE( ( I1.GE.2 ) .AND. ( Z(4*I1-5).GE.ZERO ) )
- I1 = I1 - 1
- END DO
- SIGMA = -Z(4*N1-1)
- GO TO 145
- END IF
-
- DO K = 1, N
- Z( 2*K-1 ) = Z( 4*K-3 )
-*
-* Only the block 1..N0 is unfinished. The rest of the e's
-* must be essentially zero, although sometimes other data
-* has been stored in them.
-*
- IF( K.LT.N0 ) THEN
- Z( 2*K ) = Z( 4*K-1 )
- ELSE
- Z( 2*K ) = 0
- END IF
- END DO
- RETURN
-*
-* end IWHILB
-*
- 150 CONTINUE
-*
- 160 CONTINUE
-*
- INFO = 3
- RETURN
-*
-* end IWHILA
-*
- 170 CONTINUE
-*
-* Move q's to the front.
-*
- DO 180 K = 2, N
- Z( K ) = Z( 4*K-3 )
- 180 CONTINUE
-*
-* Sort and compute sum of eigenvalues.
-*
- CALL DLASRT( 'D', N, Z, IINFO )
-*
- E = ZERO
- DO 190 K = N, 1, -1
- E = E + Z( K )
- 190 CONTINUE
-*
-* Store trace, sum(eigenvalues) and information on performance.
-*
- Z( 2*N+1 ) = TRACE
- Z( 2*N+2 ) = E
- Z( 2*N+3 ) = DBLE( ITER )
- Z( 2*N+4 ) = DBLE( NDIV ) / DBLE( N**2 )
- Z( 2*N+5 ) = HUNDRD*NFAIL / DBLE( ITER )
- RETURN
-*
-* End of DLASQ2
-*
- END
diff --git a/mtx/lapack_src/dlasq3.f b/mtx/lapack_src/dlasq3.f
deleted file mode 100644
index d044b10ae..000000000
--- a/mtx/lapack_src/dlasq3.f
+++ /dev/null
@@ -1,421 +0,0 @@
-*> \brief \b DLASQ3
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASQ3 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
-* ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1,
-* DN2, G, TAU )
-*
-* .. Scalar Arguments ..
-* LOGICAL IEEE
-* INTEGER I0, ITER, N0, NDIV, NFAIL, PP
-* DOUBLE PRECISION DESIG, DMIN, DMIN1, DMIN2, DN, DN1, DN2, G,
-* $ QMAX, SIGMA, TAU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I0
-*> \verbatim
-*> I0 is INTEGER
-*> First index.
-*> \endverbatim
-*>
-*> \param[in,out] N0
-*> \verbatim
-*> N0 is INTEGER
-*> Last index.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( 4*N )
-*> Z holds the qd array.
-*> \endverbatim
-*>
-*> \param[in,out] PP
-*> \verbatim
-*> PP is INTEGER
-*> PP=0 for ping, PP=1 for pong.
-*> PP=2 indicates that flipping was applied to the Z array
-*> and that the initial tests for deflation should not be
-*> performed.
-*> \endverbatim
-*>
-*> \param[out] DMIN
-*> \verbatim
-*> DMIN is DOUBLE PRECISION
-*> Minimum value of d.
-*> \endverbatim
-*>
-*> \param[out] SIGMA
-*> \verbatim
-*> SIGMA is DOUBLE PRECISION
-*> Sum of shifts used in current segment.
-*> \endverbatim
-*>
-*> \param[in,out] DESIG
-*> \verbatim
-*> DESIG is DOUBLE PRECISION
-*> Lower order part of SIGMA
-*> \endverbatim
-*>
-*> \param[in] QMAX
-*> \verbatim
-*> QMAX is DOUBLE PRECISION
-*> Maximum value of q.
-*> \endverbatim
-*>
-*> \param[out] NFAIL
-*> \verbatim
-*> NFAIL is INTEGER
-*> Number of times shift was too big.
-*> \endverbatim
-*>
-*> \param[out] ITER
-*> \verbatim
-*> ITER is INTEGER
-*> Number of iterations.
-*> \endverbatim
-*>
-*> \param[out] NDIV
-*> \verbatim
-*> NDIV is INTEGER
-*> Number of divisions.
-*> \endverbatim
-*>
-*> \param[in] IEEE
-*> \verbatim
-*> IEEE is LOGICAL
-*> Flag for IEEE or non IEEE arithmetic (passed to DLASQ5).
-*> \endverbatim
-*>
-*> \param[in,out] TTYPE
-*> \verbatim
-*> TTYPE is INTEGER
-*> Shift type.
-*> \endverbatim
-*>
-*> \param[in,out] DMIN1
-*> \verbatim
-*> DMIN1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] DMIN2
-*> \verbatim
-*> DMIN2 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] DN
-*> \verbatim
-*> DN is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] DN1
-*> \verbatim
-*> DN1 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] DN2
-*> \verbatim
-*> DN2 is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] G
-*> \verbatim
-*> G is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*>
-*> These are passed as arguments in order to save their values
-*> between calls to DLASQ3.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
- $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1,
- $ DN2, G, TAU )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- LOGICAL IEEE
- INTEGER I0, ITER, N0, NDIV, NFAIL, PP
- DOUBLE PRECISION DESIG, DMIN, DMIN1, DMIN2, DN, DN1, DN2, G,
- $ QMAX, SIGMA, TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION CBIAS
- PARAMETER ( CBIAS = 1.50D0 )
- DOUBLE PRECISION ZERO, QURTR, HALF, ONE, TWO, HUNDRD
- PARAMETER ( ZERO = 0.0D0, QURTR = 0.250D0, HALF = 0.5D0,
- $ ONE = 1.0D0, TWO = 2.0D0, HUNDRD = 100.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER IPN4, J4, N0IN, NN, TTYPE
- DOUBLE PRECISION EPS, S, T, TEMP, TOL, TOL2
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASQ4, DLASQ5, DLASQ6
-* ..
-* .. External Function ..
- DOUBLE PRECISION DLAMCH
- LOGICAL DISNAN
- EXTERNAL DISNAN, DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- N0IN = N0
- EPS = DLAMCH( 'Precision' )
- TOL = EPS*HUNDRD
- TOL2 = TOL**2
-*
-* Check for deflation.
-*
- 10 CONTINUE
-*
- IF( N0.LT.I0 )
- $ RETURN
- IF( N0.EQ.I0 )
- $ GO TO 20
- NN = 4*N0 + PP
- IF( N0.EQ.( I0+1 ) )
- $ GO TO 40
-*
-* Check whether E(N0-1) is negligible, 1 eigenvalue.
-*
- IF( Z( NN-5 ).GT.TOL2*( SIGMA+Z( NN-3 ) ) .AND.
- $ Z( NN-2*PP-4 ).GT.TOL2*Z( NN-7 ) )
- $ GO TO 30
-*
- 20 CONTINUE
-*
- Z( 4*N0-3 ) = Z( 4*N0+PP-3 ) + SIGMA
- N0 = N0 - 1
- GO TO 10
-*
-* Check whether E(N0-2) is negligible, 2 eigenvalues.
-*
- 30 CONTINUE
-*
- IF( Z( NN-9 ).GT.TOL2*SIGMA .AND.
- $ Z( NN-2*PP-8 ).GT.TOL2*Z( NN-11 ) )
- $ GO TO 50
-*
- 40 CONTINUE
-*
- IF( Z( NN-3 ).GT.Z( NN-7 ) ) THEN
- S = Z( NN-3 )
- Z( NN-3 ) = Z( NN-7 )
- Z( NN-7 ) = S
- END IF
- IF( Z( NN-5 ).GT.Z( NN-3 )*TOL2 ) THEN
- T = HALF*( ( Z( NN-7 )-Z( NN-3 ) )+Z( NN-5 ) )
- S = Z( NN-3 )*( Z( NN-5 ) / T )
- IF( S.LE.T ) THEN
- S = Z( NN-3 )*( Z( NN-5 ) /
- $ ( T*( ONE+SQRT( ONE+S / T ) ) ) )
- ELSE
- S = Z( NN-3 )*( Z( NN-5 ) / ( T+SQRT( T )*SQRT( T+S ) ) )
- END IF
- T = Z( NN-7 ) + ( S+Z( NN-5 ) )
- Z( NN-3 ) = Z( NN-3 )*( Z( NN-7 ) / T )
- Z( NN-7 ) = T
- END IF
- Z( 4*N0-7 ) = Z( NN-7 ) + SIGMA
- Z( 4*N0-3 ) = Z( NN-3 ) + SIGMA
- N0 = N0 - 2
- GO TO 10
-*
- 50 CONTINUE
- IF( PP.EQ.2 )
- $ PP = 0
-*
-* Reverse the qd-array, if warranted.
-*
- IF( DMIN.LE.ZERO .OR. N0.LT.N0IN ) THEN
- IF( CBIAS*Z( 4*I0+PP-3 ).LT.Z( 4*N0+PP-3 ) ) THEN
- IPN4 = 4*( I0+N0 )
- DO 60 J4 = 4*I0, 2*( I0+N0-1 ), 4
- TEMP = Z( J4-3 )
- Z( J4-3 ) = Z( IPN4-J4-3 )
- Z( IPN4-J4-3 ) = TEMP
- TEMP = Z( J4-2 )
- Z( J4-2 ) = Z( IPN4-J4-2 )
- Z( IPN4-J4-2 ) = TEMP
- TEMP = Z( J4-1 )
- Z( J4-1 ) = Z( IPN4-J4-5 )
- Z( IPN4-J4-5 ) = TEMP
- TEMP = Z( J4 )
- Z( J4 ) = Z( IPN4-J4-4 )
- Z( IPN4-J4-4 ) = TEMP
- 60 CONTINUE
- IF( N0-I0.LE.4 ) THEN
- Z( 4*N0+PP-1 ) = Z( 4*I0+PP-1 )
- Z( 4*N0-PP ) = Z( 4*I0-PP )
- END IF
- DMIN2 = MIN( DMIN2, Z( 4*N0+PP-1 ) )
- Z( 4*N0+PP-1 ) = MIN( Z( 4*N0+PP-1 ), Z( 4*I0+PP-1 ),
- $ Z( 4*I0+PP+3 ) )
- Z( 4*N0-PP ) = MIN( Z( 4*N0-PP ), Z( 4*I0-PP ),
- $ Z( 4*I0-PP+4 ) )
- QMAX = MAX( QMAX, Z( 4*I0+PP-3 ), Z( 4*I0+PP+1 ) )
- DMIN = -ZERO
- END IF
- END IF
-*
-* Choose a shift.
-*
- CALL DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, DN1,
- $ DN2, TAU, TTYPE, G )
-*
-* Call dqds until DMIN > 0.
-*
- 70 CONTINUE
-*
- CALL DLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2, DN,
- $ DN1, DN2, IEEE, EPS )
-*
- NDIV = NDIV + ( N0-I0+2 )
- ITER = ITER + 1
-*
-* Check status.
-*
- IF( DMIN.GE.ZERO .AND. DMIN1.GE.ZERO ) THEN
-*
-* Success.
-*
- GO TO 90
-*
- ELSE IF( DMIN.LT.ZERO .AND. DMIN1.GT.ZERO .AND.
- $ Z( 4*( N0-1 )-PP ).LT.TOL*( SIGMA+DN1 ) .AND.
- $ ABS( DN ).LT.TOL*SIGMA ) THEN
-*
-* Convergence hidden by negative DN.
-*
- Z( 4*( N0-1 )-PP+2 ) = ZERO
- DMIN = ZERO
- GO TO 90
- ELSE IF( DMIN.LT.ZERO ) THEN
-*
-* TAU too big. Select new TAU and try again.
-*
- NFAIL = NFAIL + 1
- IF( TTYPE.LT.-22 ) THEN
-*
-* Failed twice. Play it safe.
-*
- TAU = ZERO
- ELSE IF( DMIN1.GT.ZERO ) THEN
-*
-* Late failure. Gives excellent shift.
-*
- TAU = ( TAU+DMIN )*( ONE-TWO*EPS )
- TTYPE = TTYPE - 11
- ELSE
-*
-* Early failure. Divide by 4.
-*
- TAU = QURTR*TAU
- TTYPE = TTYPE - 12
- END IF
- GO TO 70
- ELSE IF( DISNAN( DMIN ) ) THEN
-*
-* NaN.
-*
- IF( TAU.EQ.ZERO ) THEN
- GO TO 80
- ELSE
- TAU = ZERO
- GO TO 70
- END IF
- ELSE
-*
-* Possible underflow. Play it safe.
-*
- GO TO 80
- END IF
-*
-* Risk of underflow.
-*
- 80 CONTINUE
- CALL DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN, DN1, DN2 )
- NDIV = NDIV + ( N0-I0+2 )
- ITER = ITER + 1
- TAU = ZERO
-*
- 90 CONTINUE
- IF( TAU.LT.SIGMA ) THEN
- DESIG = DESIG + TAU
- T = SIGMA + DESIG
- DESIG = DESIG - ( T-SIGMA )
- ELSE
- T = SIGMA + TAU
- DESIG = SIGMA - ( T-TAU ) + DESIG
- END IF
- SIGMA = T
-*
- RETURN
-*
-* End of DLASQ3
-*
- END
diff --git a/mtx/lapack_src/dlasq4.f b/mtx/lapack_src/dlasq4.f
deleted file mode 100644
index dc6fb719c..000000000
--- a/mtx/lapack_src/dlasq4.f
+++ /dev/null
@@ -1,425 +0,0 @@
-*> \brief \b DLASQ4
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASQ4 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
-* DN1, DN2, TAU, TTYPE, G )
-*
-* .. Scalar Arguments ..
-* INTEGER I0, N0, N0IN, PP, TTYPE
-* DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DN1, DN2, G, TAU
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASQ4 computes an approximation TAU to the smallest eigenvalue
-*> using values of d from the previous transform.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I0
-*> \verbatim
-*> I0 is INTEGER
-*> First index.
-*> \endverbatim
-*>
-*> \param[in] N0
-*> \verbatim
-*> N0 is INTEGER
-*> Last index.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( 4*N )
-*> Z holds the qd array.
-*> \endverbatim
-*>
-*> \param[in] PP
-*> \verbatim
-*> PP is INTEGER
-*> PP=0 for ping, PP=1 for pong.
-*> \endverbatim
-*>
-*> \param[in] N0IN
-*> \verbatim
-*> N0IN is INTEGER
-*> The value of N0 at start of EIGTEST.
-*> \endverbatim
-*>
-*> \param[in] DMIN
-*> \verbatim
-*> DMIN is DOUBLE PRECISION
-*> Minimum value of d.
-*> \endverbatim
-*>
-*> \param[in] DMIN1
-*> \verbatim
-*> DMIN1 is DOUBLE PRECISION
-*> Minimum value of d, excluding D( N0 ).
-*> \endverbatim
-*>
-*> \param[in] DMIN2
-*> \verbatim
-*> DMIN2 is DOUBLE PRECISION
-*> Minimum value of d, excluding D( N0 ) and D( N0-1 ).
-*> \endverbatim
-*>
-*> \param[in] DN
-*> \verbatim
-*> DN is DOUBLE PRECISION
-*> d(N)
-*> \endverbatim
-*>
-*> \param[in] DN1
-*> \verbatim
-*> DN1 is DOUBLE PRECISION
-*> d(N-1)
-*> \endverbatim
-*>
-*> \param[in] DN2
-*> \verbatim
-*> DN2 is DOUBLE PRECISION
-*> d(N-2)
-*> \endverbatim
-*>
-*> \param[out] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*> This is the shift.
-*> \endverbatim
-*>
-*> \param[out] TTYPE
-*> \verbatim
-*> TTYPE is INTEGER
-*> Shift type.
-*> \endverbatim
-*>
-*> \param[in,out] G
-*> \verbatim
-*> G is REAL
-*> G is passed as an argument in order to save its value between
-*> calls to DLASQ4.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> CNST1 = 9/16
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
- $ DN1, DN2, TAU, TTYPE, G )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER I0, N0, N0IN, PP, TTYPE
- DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DN1, DN2, G, TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION CNST1, CNST2, CNST3
- PARAMETER ( CNST1 = 0.5630D0, CNST2 = 1.010D0,
- $ CNST3 = 1.050D0 )
- DOUBLE PRECISION QURTR, THIRD, HALF, ZERO, ONE, TWO, HUNDRD
- PARAMETER ( QURTR = 0.250D0, THIRD = 0.3330D0,
- $ HALF = 0.50D0, ZERO = 0.0D0, ONE = 1.0D0,
- $ TWO = 2.0D0, HUNDRD = 100.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER I4, NN, NP
- DOUBLE PRECISION A2, B1, B2, GAM, GAP1, GAP2, S
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* A negative DMIN forces the shift to take that absolute value
-* TTYPE records the type of shift.
-*
- IF( DMIN.LE.ZERO ) THEN
- TAU = -DMIN
- TTYPE = -1
- RETURN
- END IF
-*
- NN = 4*N0 + PP
- IF( N0IN.EQ.N0 ) THEN
-*
-* No eigenvalues deflated.
-*
- IF( DMIN.EQ.DN .OR. DMIN.EQ.DN1 ) THEN
-*
- B1 = SQRT( Z( NN-3 ) )*SQRT( Z( NN-5 ) )
- B2 = SQRT( Z( NN-7 ) )*SQRT( Z( NN-9 ) )
- A2 = Z( NN-7 ) + Z( NN-5 )
-*
-* Cases 2 and 3.
-*
- IF( DMIN.EQ.DN .AND. DMIN1.EQ.DN1 ) THEN
- GAP2 = DMIN2 - A2 - DMIN2*QURTR
- IF( GAP2.GT.ZERO .AND. GAP2.GT.B2 ) THEN
- GAP1 = A2 - DN - ( B2 / GAP2 )*B2
- ELSE
- GAP1 = A2 - DN - ( B1+B2 )
- END IF
- IF( GAP1.GT.ZERO .AND. GAP1.GT.B1 ) THEN
- S = MAX( DN-( B1 / GAP1 )*B1, HALF*DMIN )
- TTYPE = -2
- ELSE
- S = ZERO
- IF( DN.GT.B1 )
- $ S = DN - B1
- IF( A2.GT.( B1+B2 ) )
- $ S = MIN( S, A2-( B1+B2 ) )
- S = MAX( S, THIRD*DMIN )
- TTYPE = -3
- END IF
- ELSE
-*
-* Case 4.
-*
- TTYPE = -4
- S = QURTR*DMIN
- IF( DMIN.EQ.DN ) THEN
- GAM = DN
- A2 = ZERO
- IF( Z( NN-5 ) .GT. Z( NN-7 ) )
- $ RETURN
- B2 = Z( NN-5 ) / Z( NN-7 )
- NP = NN - 9
- ELSE
- NP = NN - 2*PP
- B2 = Z( NP-2 )
- GAM = DN1
- IF( Z( NP-4 ) .GT. Z( NP-2 ) )
- $ RETURN
- A2 = Z( NP-4 ) / Z( NP-2 )
- IF( Z( NN-9 ) .GT. Z( NN-11 ) )
- $ RETURN
- B2 = Z( NN-9 ) / Z( NN-11 )
- NP = NN - 13
- END IF
-*
-* Approximate contribution to norm squared from I < NN-1.
-*
- A2 = A2 + B2
- DO 10 I4 = NP, 4*I0 - 1 + PP, -4
- IF( B2.EQ.ZERO )
- $ GO TO 20
- B1 = B2
- IF( Z( I4 ) .GT. Z( I4-2 ) )
- $ RETURN
- B2 = B2*( Z( I4 ) / Z( I4-2 ) )
- A2 = A2 + B2
- IF( HUNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 )
- $ GO TO 20
- 10 CONTINUE
- 20 CONTINUE
- A2 = CNST3*A2
-*
-* Rayleigh quotient residual bound.
-*
- IF( A2.LT.CNST1 )
- $ S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
- END IF
- ELSE IF( DMIN.EQ.DN2 ) THEN
-*
-* Case 5.
-*
- TTYPE = -5
- S = QURTR*DMIN
-*
-* Compute contribution to norm squared from I > NN-2.
-*
- NP = NN - 2*PP
- B1 = Z( NP-2 )
- B2 = Z( NP-6 )
- GAM = DN2
- IF( Z( NP-8 ).GT.B2 .OR. Z( NP-4 ).GT.B1 )
- $ RETURN
- A2 = ( Z( NP-8 ) / B2 )*( ONE+Z( NP-4 ) / B1 )
-*
-* Approximate contribution to norm squared from I < NN-2.
-*
- IF( N0-I0.GT.2 ) THEN
- B2 = Z( NN-13 ) / Z( NN-15 )
- A2 = A2 + B2
- DO 30 I4 = NN - 17, 4*I0 - 1 + PP, -4
- IF( B2.EQ.ZERO )
- $ GO TO 40
- B1 = B2
- IF( Z( I4 ) .GT. Z( I4-2 ) )
- $ RETURN
- B2 = B2*( Z( I4 ) / Z( I4-2 ) )
- A2 = A2 + B2
- IF( HUNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 )
- $ GO TO 40
- 30 CONTINUE
- 40 CONTINUE
- A2 = CNST3*A2
- END IF
-*
- IF( A2.LT.CNST1 )
- $ S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
- ELSE
-*
-* Case 6, no information to guide us.
-*
- IF( TTYPE.EQ.-6 ) THEN
- G = G + THIRD*( ONE-G )
- ELSE IF( TTYPE.EQ.-18 ) THEN
- G = QURTR*THIRD
- ELSE
- G = QURTR
- END IF
- S = G*DMIN
- TTYPE = -6
- END IF
-*
- ELSE IF( N0IN.EQ.( N0+1 ) ) THEN
-*
-* One eigenvalue just deflated. Use DMIN1, DN1 for DMIN and DN.
-*
- IF( DMIN1.EQ.DN1 .AND. DMIN2.EQ.DN2 ) THEN
-*
-* Cases 7 and 8.
-*
- TTYPE = -7
- S = THIRD*DMIN1
- IF( Z( NN-5 ).GT.Z( NN-7 ) )
- $ RETURN
- B1 = Z( NN-5 ) / Z( NN-7 )
- B2 = B1
- IF( B2.EQ.ZERO )
- $ GO TO 60
- DO 50 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
- A2 = B1
- IF( Z( I4 ).GT.Z( I4-2 ) )
- $ RETURN
- B1 = B1*( Z( I4 ) / Z( I4-2 ) )
- B2 = B2 + B1
- IF( HUNDRD*MAX( B1, A2 ).LT.B2 )
- $ GO TO 60
- 50 CONTINUE
- 60 CONTINUE
- B2 = SQRT( CNST3*B2 )
- A2 = DMIN1 / ( ONE+B2**2 )
- GAP2 = HALF*DMIN2 - A2
- IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
- S = MAX( S, A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ) )
- ELSE
- S = MAX( S, A2*( ONE-CNST2*B2 ) )
- TTYPE = -8
- END IF
- ELSE
-*
-* Case 9.
-*
- S = QURTR*DMIN1
- IF( DMIN1.EQ.DN1 )
- $ S = HALF*DMIN1
- TTYPE = -9
- END IF
-*
- ELSE IF( N0IN.EQ.( N0+2 ) ) THEN
-*
-* Two eigenvalues deflated. Use DMIN2, DN2 for DMIN and DN.
-*
-* Cases 10 and 11.
-*
- IF( DMIN2.EQ.DN2 .AND. TWO*Z( NN-5 ).LT.Z( NN-7 ) ) THEN
- TTYPE = -10
- S = THIRD*DMIN2
- IF( Z( NN-5 ).GT.Z( NN-7 ) )
- $ RETURN
- B1 = Z( NN-5 ) / Z( NN-7 )
- B2 = B1
- IF( B2.EQ.ZERO )
- $ GO TO 80
- DO 70 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
- IF( Z( I4 ).GT.Z( I4-2 ) )
- $ RETURN
- B1 = B1*( Z( I4 ) / Z( I4-2 ) )
- B2 = B2 + B1
- IF( HUNDRD*B1.LT.B2 )
- $ GO TO 80
- 70 CONTINUE
- 80 CONTINUE
- B2 = SQRT( CNST3*B2 )
- A2 = DMIN2 / ( ONE+B2**2 )
- GAP2 = Z( NN-7 ) + Z( NN-9 ) -
- $ SQRT( Z( NN-11 ) )*SQRT( Z( NN-9 ) ) - A2
- IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
- S = MAX( S, A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ) )
- ELSE
- S = MAX( S, A2*( ONE-CNST2*B2 ) )
- END IF
- ELSE
- S = QURTR*DMIN2
- TTYPE = -11
- END IF
- ELSE IF( N0IN.GT.( N0+2 ) ) THEN
-*
-* Case 12, more than two eigenvalues deflated. No information.
-*
- S = ZERO
- TTYPE = -12
- END IF
-*
- TAU = S
- RETURN
-*
-* End of DLASQ4
-*
- END
diff --git a/mtx/lapack_src/dlasq5.f b/mtx/lapack_src/dlasq5.f
deleted file mode 100644
index 3724419b1..000000000
--- a/mtx/lapack_src/dlasq5.f
+++ /dev/null
@@ -1,410 +0,0 @@
-*> \brief \b DLASQ5
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASQ5 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2, DN,
-* DNM1, DNM2, IEEE, EPS )
-*
-* .. Scalar Arguments ..
-* LOGICAL IEEE
-* INTEGER I0, N0, PP
-* DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU, SIGMA, EPS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASQ5 computes one dqds transform in ping-pong form, one
-*> version for IEEE machines another for non IEEE machines.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I0
-*> \verbatim
-*> I0 is INTEGER
-*> First index.
-*> \endverbatim
-*>
-*> \param[in] N0
-*> \verbatim
-*> N0 is INTEGER
-*> Last index.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( 4*N )
-*> Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
-*> an extra argument.
-*> \endverbatim
-*>
-*> \param[in] PP
-*> \verbatim
-*> PP is INTEGER
-*> PP=0 for ping, PP=1 for pong.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION
-*> This is the shift.
-*> \endverbatim
-*>
-*> \param[in] SIGMA
-*> \verbatim
-*> SIGMA is DOUBLE PRECISION
-*> This is the accumulated shift up to this step.
-*> \endverbatim
-*>
-*> \param[out] DMIN
-*> \verbatim
-*> DMIN is DOUBLE PRECISION
-*> Minimum value of d.
-*> \endverbatim
-*>
-*> \param[out] DMIN1
-*> \verbatim
-*> DMIN1 is DOUBLE PRECISION
-*> Minimum value of d, excluding D( N0 ).
-*> \endverbatim
-*>
-*> \param[out] DMIN2
-*> \verbatim
-*> DMIN2 is DOUBLE PRECISION
-*> Minimum value of d, excluding D( N0 ) and D( N0-1 ).
-*> \endverbatim
-*>
-*> \param[out] DN
-*> \verbatim
-*> DN is DOUBLE PRECISION
-*> d(N0), the last value of d.
-*> \endverbatim
-*>
-*> \param[out] DNM1
-*> \verbatim
-*> DNM1 is DOUBLE PRECISION
-*> d(N0-1).
-*> \endverbatim
-*>
-*> \param[out] DNM2
-*> \verbatim
-*> DNM2 is DOUBLE PRECISION
-*> d(N0-2).
-*> \endverbatim
-*>
-*> \param[in] IEEE
-*> \verbatim
-*> IEEE is LOGICAL
-*> Flag for IEEE or non IEEE arithmetic.
-*> \endverbatim
-*
-*> \param[in] EPS
-*> \verbatim
-*> EPS is DOUBLE PRECISION
-*> This is the value of epsilon used.
-*> \endverbatim
-*>
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2,
- $ DN, DNM1, DNM2, IEEE, EPS )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- LOGICAL IEEE
- INTEGER I0, N0, PP
- DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU,
- $ SIGMA, EPS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameter ..
- DOUBLE PRECISION ZERO, HALF
- PARAMETER ( ZERO = 0.0D0, HALF = 0.5 )
-* ..
-* .. Local Scalars ..
- INTEGER J4, J4P2
- DOUBLE PRECISION D, EMIN, TEMP, DTHRESH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
- IF( ( N0-I0-1 ).LE.0 )
- $ RETURN
-*
- DTHRESH = EPS*(SIGMA+TAU)
- IF( TAU.LT.DTHRESH*HALF ) TAU = ZERO
- IF( TAU.NE.ZERO ) THEN
- J4 = 4*I0 + PP - 3
- EMIN = Z( J4+4 )
- D = Z( J4 ) - TAU
- DMIN = D
- DMIN1 = -Z( J4 )
-*
- IF( IEEE ) THEN
-*
-* Code for IEEE arithmetic.
-*
- IF( PP.EQ.0 ) THEN
- DO 10 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-2 ) = D + Z( J4-1 )
- TEMP = Z( J4+1 ) / Z( J4-2 )
- D = D*TEMP - TAU
- DMIN = MIN( DMIN, D )
- Z( J4 ) = Z( J4-1 )*TEMP
- EMIN = MIN( Z( J4 ), EMIN )
- 10 CONTINUE
- ELSE
- DO 20 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-3 ) = D + Z( J4 )
- TEMP = Z( J4+2 ) / Z( J4-3 )
- D = D*TEMP - TAU
- DMIN = MIN( DMIN, D )
- Z( J4-1 ) = Z( J4 )*TEMP
- EMIN = MIN( Z( J4-1 ), EMIN )
- 20 CONTINUE
- END IF
-*
-* Unroll last two steps.
-*
- DNM2 = D
- DMIN2 = DMIN
- J4 = 4*( N0-2 ) - PP
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM2 + Z( J4P2 )
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
- DMIN = MIN( DMIN, DNM1 )
-*
- DMIN1 = DMIN
- J4 = J4 + 4
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM1 + Z( J4P2 )
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
- DMIN = MIN( DMIN, DN )
-*
- ELSE
-*
-* Code for non IEEE arithmetic.
-*
- IF( PP.EQ.0 ) THEN
- DO 30 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-2 ) = D + Z( J4-1 )
- IF( D.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
- D = Z( J4+1 )*( D / Z( J4-2 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4 ) )
- 30 CONTINUE
- ELSE
- DO 40 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-3 ) = D + Z( J4 )
- IF( D.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
- D = Z( J4+2 )*( D / Z( J4-3 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4-1 ) )
- 40 CONTINUE
- END IF
-*
-* Unroll last two steps.
-*
- DNM2 = D
- DMIN2 = DMIN
- J4 = 4*( N0-2 ) - PP
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM2 + Z( J4P2 )
- IF( DNM2.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, DNM1 )
-*
- DMIN1 = DMIN
- J4 = J4 + 4
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM1 + Z( J4P2 )
- IF( DNM1.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, DN )
-*
- END IF
- ELSE
-* This is the version that sets d's to zero if they are small enough
- J4 = 4*I0 + PP - 3
- EMIN = Z( J4+4 )
- D = Z( J4 ) - TAU
- DMIN = D
- DMIN1 = -Z( J4 )
- IF( IEEE ) THEN
-*
-* Code for IEEE arithmetic.
-*
- IF( PP.EQ.0 ) THEN
- DO 50 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-2 ) = D + Z( J4-1 )
- TEMP = Z( J4+1 ) / Z( J4-2 )
- D = D*TEMP - TAU
- IF( D.LT.DTHRESH ) D = ZERO
- DMIN = MIN( DMIN, D )
- Z( J4 ) = Z( J4-1 )*TEMP
- EMIN = MIN( Z( J4 ), EMIN )
- 50 CONTINUE
- ELSE
- DO 60 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-3 ) = D + Z( J4 )
- TEMP = Z( J4+2 ) / Z( J4-3 )
- D = D*TEMP - TAU
- IF( D.LT.DTHRESH ) D = ZERO
- DMIN = MIN( DMIN, D )
- Z( J4-1 ) = Z( J4 )*TEMP
- EMIN = MIN( Z( J4-1 ), EMIN )
- 60 CONTINUE
- END IF
-*
-* Unroll last two steps.
-*
- DNM2 = D
- DMIN2 = DMIN
- J4 = 4*( N0-2 ) - PP
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM2 + Z( J4P2 )
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
- DMIN = MIN( DMIN, DNM1 )
-*
- DMIN1 = DMIN
- J4 = J4 + 4
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM1 + Z( J4P2 )
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
- DMIN = MIN( DMIN, DN )
-*
- ELSE
-*
-* Code for non IEEE arithmetic.
-*
- IF( PP.EQ.0 ) THEN
- DO 70 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-2 ) = D + Z( J4-1 )
- IF( D.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
- D = Z( J4+1 )*( D / Z( J4-2 ) ) - TAU
- END IF
- IF( D.LT.DTHRESH) D = ZERO
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4 ) )
- 70 CONTINUE
- ELSE
- DO 80 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-3 ) = D + Z( J4 )
- IF( D.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
- D = Z( J4+2 )*( D / Z( J4-3 ) ) - TAU
- END IF
- IF( D.LT.DTHRESH) D = ZERO
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4-1 ) )
- 80 CONTINUE
- END IF
-*
-* Unroll last two steps.
-*
- DNM2 = D
- DMIN2 = DMIN
- J4 = 4*( N0-2 ) - PP
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM2 + Z( J4P2 )
- IF( DNM2.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, DNM1 )
-*
- DMIN1 = DMIN
- J4 = J4 + 4
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM1 + Z( J4P2 )
- IF( DNM1.LT.ZERO ) THEN
- RETURN
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
- END IF
- DMIN = MIN( DMIN, DN )
-*
- END IF
- END IF
-*
- Z( J4+2 ) = DN
- Z( 4*N0-PP ) = EMIN
- RETURN
-*
-* End of DLASQ5
-*
- END
diff --git a/mtx/lapack_src/dlasq6.f b/mtx/lapack_src/dlasq6.f
deleted file mode 100644
index e069fa6f7..000000000
--- a/mtx/lapack_src/dlasq6.f
+++ /dev/null
@@ -1,254 +0,0 @@
-*> \brief \b DLASQ6
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASQ6 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN,
-* DNM1, DNM2 )
-*
-* .. Scalar Arguments ..
-* INTEGER I0, N0, PP
-* DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASQ6 computes one dqd (shift equal to zero) transform in
-*> ping-pong form, with protection against underflow and overflow.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I0
-*> \verbatim
-*> I0 is INTEGER
-*> First index.
-*> \endverbatim
-*>
-*> \param[in] N0
-*> \verbatim
-*> N0 is INTEGER
-*> Last index.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( 4*N )
-*> Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
-*> an extra argument.
-*> \endverbatim
-*>
-*> \param[in] PP
-*> \verbatim
-*> PP is INTEGER
-*> PP=0 for ping, PP=1 for pong.
-*> \endverbatim
-*>
-*> \param[out] DMIN
-*> \verbatim
-*> DMIN is DOUBLE PRECISION
-*> Minimum value of d.
-*> \endverbatim
-*>
-*> \param[out] DMIN1
-*> \verbatim
-*> DMIN1 is DOUBLE PRECISION
-*> Minimum value of d, excluding D( N0 ).
-*> \endverbatim
-*>
-*> \param[out] DMIN2
-*> \verbatim
-*> DMIN2 is DOUBLE PRECISION
-*> Minimum value of d, excluding D( N0 ) and D( N0-1 ).
-*> \endverbatim
-*>
-*> \param[out] DN
-*> \verbatim
-*> DN is DOUBLE PRECISION
-*> d(N0), the last value of d.
-*> \endverbatim
-*>
-*> \param[out] DNM1
-*> \verbatim
-*> DNM1 is DOUBLE PRECISION
-*> d(N0-1).
-*> \endverbatim
-*>
-*> \param[out] DNM2
-*> \verbatim
-*> DNM2 is DOUBLE PRECISION
-*> d(N0-2).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN,
- $ DNM1, DNM2 )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER I0, N0, PP
- DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameter ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER J4, J4P2
- DOUBLE PRECISION D, EMIN, SAFMIN, TEMP
-* ..
-* .. External Function ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
- IF( ( N0-I0-1 ).LE.0 )
- $ RETURN
-*
- SAFMIN = DLAMCH( 'Safe minimum' )
- J4 = 4*I0 + PP - 3
- EMIN = Z( J4+4 )
- D = Z( J4 )
- DMIN = D
-*
- IF( PP.EQ.0 ) THEN
- DO 10 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-2 ) = D + Z( J4-1 )
- IF( Z( J4-2 ).EQ.ZERO ) THEN
- Z( J4 ) = ZERO
- D = Z( J4+1 )
- DMIN = D
- EMIN = ZERO
- ELSE IF( SAFMIN*Z( J4+1 ).LT.Z( J4-2 ) .AND.
- $ SAFMIN*Z( J4-2 ).LT.Z( J4+1 ) ) THEN
- TEMP = Z( J4+1 ) / Z( J4-2 )
- Z( J4 ) = Z( J4-1 )*TEMP
- D = D*TEMP
- ELSE
- Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
- D = Z( J4+1 )*( D / Z( J4-2 ) )
- END IF
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4 ) )
- 10 CONTINUE
- ELSE
- DO 20 J4 = 4*I0, 4*( N0-3 ), 4
- Z( J4-3 ) = D + Z( J4 )
- IF( Z( J4-3 ).EQ.ZERO ) THEN
- Z( J4-1 ) = ZERO
- D = Z( J4+2 )
- DMIN = D
- EMIN = ZERO
- ELSE IF( SAFMIN*Z( J4+2 ).LT.Z( J4-3 ) .AND.
- $ SAFMIN*Z( J4-3 ).LT.Z( J4+2 ) ) THEN
- TEMP = Z( J4+2 ) / Z( J4-3 )
- Z( J4-1 ) = Z( J4 )*TEMP
- D = D*TEMP
- ELSE
- Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
- D = Z( J4+2 )*( D / Z( J4-3 ) )
- END IF
- DMIN = MIN( DMIN, D )
- EMIN = MIN( EMIN, Z( J4-1 ) )
- 20 CONTINUE
- END IF
-*
-* Unroll last two steps.
-*
- DNM2 = D
- DMIN2 = DMIN
- J4 = 4*( N0-2 ) - PP
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM2 + Z( J4P2 )
- IF( Z( J4-2 ).EQ.ZERO ) THEN
- Z( J4 ) = ZERO
- DNM1 = Z( J4P2+2 )
- DMIN = DNM1
- EMIN = ZERO
- ELSE IF( SAFMIN*Z( J4P2+2 ).LT.Z( J4-2 ) .AND.
- $ SAFMIN*Z( J4-2 ).LT.Z( J4P2+2 ) ) THEN
- TEMP = Z( J4P2+2 ) / Z( J4-2 )
- Z( J4 ) = Z( J4P2 )*TEMP
- DNM1 = DNM2*TEMP
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) )
- END IF
- DMIN = MIN( DMIN, DNM1 )
-*
- DMIN1 = DMIN
- J4 = J4 + 4
- J4P2 = J4 + 2*PP - 1
- Z( J4-2 ) = DNM1 + Z( J4P2 )
- IF( Z( J4-2 ).EQ.ZERO ) THEN
- Z( J4 ) = ZERO
- DN = Z( J4P2+2 )
- DMIN = DN
- EMIN = ZERO
- ELSE IF( SAFMIN*Z( J4P2+2 ).LT.Z( J4-2 ) .AND.
- $ SAFMIN*Z( J4-2 ).LT.Z( J4P2+2 ) ) THEN
- TEMP = Z( J4P2+2 ) / Z( J4-2 )
- Z( J4 ) = Z( J4P2 )*TEMP
- DN = DNM1*TEMP
- ELSE
- Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
- DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) )
- END IF
- DMIN = MIN( DMIN, DN )
-*
- Z( J4+2 ) = DN
- Z( 4*N0-PP ) = EMIN
- RETURN
-*
-* End of DLASQ6
-*
- END
diff --git a/mtx/lapack_src/dlasr.f b/mtx/lapack_src/dlasr.f
deleted file mode 100644
index bbe6217dd..000000000
--- a/mtx/lapack_src/dlasr.f
+++ /dev/null
@@ -1,436 +0,0 @@
-*> \brief \b DLASR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASR + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIRECT, PIVOT, SIDE
-* INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( * ), S( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> Specifies whether the plane rotation matrix P is applied to
-*> A on the left or the right.
-*> = 'L': Left, compute A := P*A
-*> = 'R': Right, compute A:= A*P**T
-*> \endverbatim
-*>
-*> \param[in] PIVOT
-*> \verbatim
-*> PIVOT is CHARACTER*1
-*> Specifies the plane for which P(k) is a plane rotation
-*> matrix.
-*> = 'V': Variable pivot, the plane (k,k+1)
-*> = 'T': Top pivot, the plane (1,k+1)
-*> = 'B': Bottom pivot, the plane (k,z)
-*> \endverbatim
-*>
-*> \param[in] DIRECT
-*> \verbatim
-*> DIRECT is CHARACTER*1
-*> Specifies whether P is a forward or backward sequence of
-*> plane rotations.
-*> = 'F': Forward, P = P(z-1)*...*P(2)*P(1)
-*> = 'B': Backward, P = P(1)*P(2)*...*P(z-1)
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. If m <= 1, an immediate
-*> return is effected.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. If n <= 1, an
-*> immediate return is effected.
-*> \endverbatim
-*>
-*> \param[in] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension
-*> (M-1) if SIDE = 'L'
-*> (N-1) if SIDE = 'R'
-*> The cosines c(k) of the plane rotations.
-*> \endverbatim
-*>
-*> \param[in] S
-*> \verbatim
-*> S is DOUBLE PRECISION array, dimension
-*> (M-1) if SIDE = 'L'
-*> (N-1) if SIDE = 'R'
-*> The sines s(k) of the plane rotations. The 2-by-2 plane
-*> rotation part of the matrix P(k), R(k), has the form
-*> R(k) = ( c(k) s(k) )
-*> ( -s(k) c(k) ).
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The M-by-N matrix A. On exit, A is overwritten by P*A if
-*> SIDE = 'R' or by A*P**T if SIDE = 'L'.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIRECT, PIVOT, SIDE
- INTEGER LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( * ), S( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, INFO, J
- DOUBLE PRECISION CTEMP, STEMP, TEMP
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters
-*
- INFO = 0
- IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN
- INFO = 1
- ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT,
- $ 'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN
- INFO = 2
- ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) )
- $ THEN
- INFO = 3
- ELSE IF( M.LT.0 ) THEN
- INFO = 4
- ELSE IF( N.LT.0 ) THEN
- INFO = 5
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = 9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASR ', INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
- $ RETURN
- IF( LSAME( SIDE, 'L' ) ) THEN
-*
-* Form P * A
-*
- IF( LSAME( PIVOT, 'V' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 20 J = 1, M - 1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 10 I = 1, N
- TEMP = A( J+1, I )
- A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
- A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
- 10 CONTINUE
- END IF
- 20 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 40 J = M - 1, 1, -1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 30 I = 1, N
- TEMP = A( J+1, I )
- A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
- A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
- 30 CONTINUE
- END IF
- 40 CONTINUE
- END IF
- ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 60 J = 2, M
- CTEMP = C( J-1 )
- STEMP = S( J-1 )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 50 I = 1, N
- TEMP = A( J, I )
- A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
- A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 80 J = M, 2, -1
- CTEMP = C( J-1 )
- STEMP = S( J-1 )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 70 I = 1, N
- TEMP = A( J, I )
- A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
- A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
- 70 CONTINUE
- END IF
- 80 CONTINUE
- END IF
- ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 100 J = 1, M - 1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 90 I = 1, N
- TEMP = A( J, I )
- A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
- A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
- 90 CONTINUE
- END IF
- 100 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 120 J = M - 1, 1, -1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 110 I = 1, N
- TEMP = A( J, I )
- A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
- A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
- 110 CONTINUE
- END IF
- 120 CONTINUE
- END IF
- END IF
- ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-* Form A * P**T
-*
- IF( LSAME( PIVOT, 'V' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 140 J = 1, N - 1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 130 I = 1, M
- TEMP = A( I, J+1 )
- A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
- A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
- 130 CONTINUE
- END IF
- 140 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 160 J = N - 1, 1, -1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 150 I = 1, M
- TEMP = A( I, J+1 )
- A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
- A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
- 150 CONTINUE
- END IF
- 160 CONTINUE
- END IF
- ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 180 J = 2, N
- CTEMP = C( J-1 )
- STEMP = S( J-1 )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 170 I = 1, M
- TEMP = A( I, J )
- A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
- A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
- 170 CONTINUE
- END IF
- 180 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 200 J = N, 2, -1
- CTEMP = C( J-1 )
- STEMP = S( J-1 )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 190 I = 1, M
- TEMP = A( I, J )
- A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
- A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
- 190 CONTINUE
- END IF
- 200 CONTINUE
- END IF
- ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
- IF( LSAME( DIRECT, 'F' ) ) THEN
- DO 220 J = 1, N - 1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 210 I = 1, M
- TEMP = A( I, J )
- A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
- A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
- 210 CONTINUE
- END IF
- 220 CONTINUE
- ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
- DO 240 J = N - 1, 1, -1
- CTEMP = C( J )
- STEMP = S( J )
- IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
- DO 230 I = 1, M
- TEMP = A( I, J )
- A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
- A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
- 230 CONTINUE
- END IF
- 240 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DLASR
-*
- END
diff --git a/mtx/lapack_src/dlasrt.f b/mtx/lapack_src/dlasrt.f
deleted file mode 100644
index fe8f526a2..000000000
--- a/mtx/lapack_src/dlasrt.f
+++ /dev/null
@@ -1,303 +0,0 @@
-*> \brief \b DLASRT
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASRT + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASRT( ID, N, D, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER ID
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION D( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ID
-*> \verbatim
-*> ID is CHARACTER*1
-*> = 'I': sort D in increasing order;
-*> = 'D': sort D in decreasing order.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The length of the array D.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is DOUBLE PRECISION array, dimension (N)
-*> On entry, the array to be sorted.
-*> On exit, D has been sorted into increasing order
-*> (D(1) <= ... <= D(N) ) or into decreasing order
-*> (D(1) >= ... >= D(N) ), depending on ID.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLASRT( ID, N, D, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER ID
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION D( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER SELECT
- PARAMETER ( SELECT = 20 )
-* ..
-* .. Local Scalars ..
- INTEGER DIR, ENDD, I, J, START, STKPNT
- DOUBLE PRECISION D1, D2, D3, DMNMX, TMP
-* ..
-* .. Local Arrays ..
- INTEGER STACK( 2, 32 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Executable Statements ..
-*
-* Test the input paramters.
-*
- INFO = 0
- DIR = -1
- IF( LSAME( ID, 'D' ) ) THEN
- DIR = 0
- ELSE IF( LSAME( ID, 'I' ) ) THEN
- DIR = 1
- END IF
- IF( DIR.EQ.-1 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLASRT', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.1 )
- $ RETURN
-*
- STKPNT = 1
- STACK( 1, 1 ) = 1
- STACK( 2, 1 ) = N
- 10 CONTINUE
- START = STACK( 1, STKPNT )
- ENDD = STACK( 2, STKPNT )
- STKPNT = STKPNT - 1
- IF( ENDD-START.LE.SELECT .AND. ENDD-START.GT.0 ) THEN
-*
-* Do Insertion sort on D( START:ENDD )
-*
- IF( DIR.EQ.0 ) THEN
-*
-* Sort into decreasing order
-*
- DO 30 I = START + 1, ENDD
- DO 20 J = I, START + 1, -1
- IF( D( J ).GT.D( J-1 ) ) THEN
- DMNMX = D( J )
- D( J ) = D( J-1 )
- D( J-1 ) = DMNMX
- ELSE
- GO TO 30
- END IF
- 20 CONTINUE
- 30 CONTINUE
-*
- ELSE
-*
-* Sort into increasing order
-*
- DO 50 I = START + 1, ENDD
- DO 40 J = I, START + 1, -1
- IF( D( J ).LT.D( J-1 ) ) THEN
- DMNMX = D( J )
- D( J ) = D( J-1 )
- D( J-1 ) = DMNMX
- ELSE
- GO TO 50
- END IF
- 40 CONTINUE
- 50 CONTINUE
-*
- END IF
-*
- ELSE IF( ENDD-START.GT.SELECT ) THEN
-*
-* Partition D( START:ENDD ) and stack parts, largest one first
-*
-* Choose partition entry as median of 3
-*
- D1 = D( START )
- D2 = D( ENDD )
- I = ( START+ENDD ) / 2
- D3 = D( I )
- IF( D1.LT.D2 ) THEN
- IF( D3.LT.D1 ) THEN
- DMNMX = D1
- ELSE IF( D3.LT.D2 ) THEN
- DMNMX = D3
- ELSE
- DMNMX = D2
- END IF
- ELSE
- IF( D3.LT.D2 ) THEN
- DMNMX = D2
- ELSE IF( D3.LT.D1 ) THEN
- DMNMX = D3
- ELSE
- DMNMX = D1
- END IF
- END IF
-*
- IF( DIR.EQ.0 ) THEN
-*
-* Sort into decreasing order
-*
- I = START - 1
- J = ENDD + 1
- 60 CONTINUE
- 70 CONTINUE
- J = J - 1
- IF( D( J ).LT.DMNMX )
- $ GO TO 70
- 80 CONTINUE
- I = I + 1
- IF( D( I ).GT.DMNMX )
- $ GO TO 80
- IF( I.LT.J ) THEN
- TMP = D( I )
- D( I ) = D( J )
- D( J ) = TMP
- GO TO 60
- END IF
- IF( J-START.GT.ENDD-J-1 ) THEN
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = START
- STACK( 2, STKPNT ) = J
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = J + 1
- STACK( 2, STKPNT ) = ENDD
- ELSE
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = J + 1
- STACK( 2, STKPNT ) = ENDD
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = START
- STACK( 2, STKPNT ) = J
- END IF
- ELSE
-*
-* Sort into increasing order
-*
- I = START - 1
- J = ENDD + 1
- 90 CONTINUE
- 100 CONTINUE
- J = J - 1
- IF( D( J ).GT.DMNMX )
- $ GO TO 100
- 110 CONTINUE
- I = I + 1
- IF( D( I ).LT.DMNMX )
- $ GO TO 110
- IF( I.LT.J ) THEN
- TMP = D( I )
- D( I ) = D( J )
- D( J ) = TMP
- GO TO 90
- END IF
- IF( J-START.GT.ENDD-J-1 ) THEN
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = START
- STACK( 2, STKPNT ) = J
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = J + 1
- STACK( 2, STKPNT ) = ENDD
- ELSE
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = J + 1
- STACK( 2, STKPNT ) = ENDD
- STKPNT = STKPNT + 1
- STACK( 1, STKPNT ) = START
- STACK( 2, STKPNT ) = J
- END IF
- END IF
- END IF
- IF( STKPNT.GT.0 )
- $ GO TO 10
- RETURN
-*
-* End of DLASRT
-*
- END
diff --git a/mtx/lapack_src/dlassq.f b/mtx/lapack_src/dlassq.f
deleted file mode 100644
index 51d5a22d2..000000000
--- a/mtx/lapack_src/dlassq.f
+++ /dev/null
@@ -1,151 +0,0 @@
-*> \brief \b DLASSQ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASSQ + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* DOUBLE PRECISION SCALE, SUMSQ
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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 and scl returns the value
-*>
-*> scl = max( scale, abs( x( i ) ) ).
-*>
-*> scale and sumsq must be supplied in SCALE and SUMSQ and
-*> scl and smsq are overwritten on SCALE and SUMSQ respectively.
-*>
-*> The routine makes only one pass through the vector x.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of elements to be used from the vector X.
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (N)
-*> The vector for which a scaled sum of squares is computed.
-*> x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between successive values of the vector X.
-*> INCX > 0.
-*> \endverbatim
-*>
-*> \param[in,out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> On entry, the value scale in the equation above.
-*> On exit, SCALE is overwritten with scl , the scaling factor
-*> for the sum of squares.
-*> \endverbatim
-*>
-*> \param[in,out] SUMSQ
-*> \verbatim
-*> SUMSQ is DOUBLE PRECISION
-*> On entry, the value sumsq in the equation above.
-*> On exit, SUMSQ is overwritten with smsq , the basic sum of
-*> squares from which scl has been factored out.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
- DOUBLE PRECISION SCALE, SUMSQ
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER IX
- DOUBLE PRECISION ABSXI
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
- IF( N.GT.0 ) THEN
- DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
- IF( X( IX ).NE.ZERO ) THEN
- ABSXI = ABS( X( IX ) )
- IF( SCALE.LT.ABSXI ) THEN
- SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
- SCALE = ABSXI
- ELSE
- SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
- END IF
- END IF
- 10 CONTINUE
- END IF
- RETURN
-*
-* End of DLASSQ
-*
- END
diff --git a/mtx/lapack_src/dlasv2.f b/mtx/lapack_src/dlasv2.f
deleted file mode 100644
index bf76ac27d..000000000
--- a/mtx/lapack_src/dlasv2.f
+++ /dev/null
@@ -1,325 +0,0 @@
-*> \brief \b DLASV2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASV2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL )
-*
-* .. Scalar Arguments ..
-* DOUBLE PRECISION CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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 ].
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] F
-*> \verbatim
-*> F is DOUBLE PRECISION
-*> The (1,1) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] G
-*> \verbatim
-*> G is DOUBLE PRECISION
-*> The (1,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[in] H
-*> \verbatim
-*> H is DOUBLE PRECISION
-*> The (2,2) element of the 2-by-2 matrix.
-*> \endverbatim
-*>
-*> \param[out] SSMIN
-*> \verbatim
-*> SSMIN is DOUBLE PRECISION
-*> abs(SSMIN) is the smaller singular value.
-*> \endverbatim
-*>
-*> \param[out] SSMAX
-*> \verbatim
-*> SSMAX is DOUBLE PRECISION
-*> abs(SSMAX) is the larger singular value.
-*> \endverbatim
-*>
-*> \param[out] SNL
-*> \verbatim
-*> SNL is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] CSL
-*> \verbatim
-*> CSL is DOUBLE PRECISION
-*> The vector (CSL, SNL) is a unit left singular vector for the
-*> singular value abs(SSMAX).
-*> \endverbatim
-*>
-*> \param[out] SNR
-*> \verbatim
-*> SNR is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] CSR
-*> \verbatim
-*> CSR is DOUBLE PRECISION
-*> The vector (CSR, SNR) is a unit right singular vector for the
-*> singular value abs(SSMAX).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Any input parameter may be aliased with any output parameter.
-*>
-*> Barring over/underflow and assuming a guard digit in subtraction, all
-*> output quantities are correct to within a few units in the last
-*> place (ulps).
-*>
-*> In IEEE arithmetic, the code works correctly if one matrix element is
-*> infinite.
-*>
-*> Overflow will not occur unless the largest singular value itself
-*> overflows or is within a few ulps of overflow. (On machines with
-*> partial overflow, like the Cray, overflow may occur if the largest
-*> singular value is within a factor of 2 of overflow.)
-*>
-*> Underflow is harmless if underflow is gradual. Otherwise, results
-*> may correspond to a matrix modified by perturbations of size near
-*> the underflow threshold.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- DOUBLE PRECISION CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
- DOUBLE PRECISION HALF
- PARAMETER ( HALF = 0.5D0 )
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D0 )
- DOUBLE PRECISION TWO
- PARAMETER ( TWO = 2.0D0 )
- DOUBLE PRECISION FOUR
- PARAMETER ( FOUR = 4.0D0 )
-* ..
-* .. Local Scalars ..
- LOGICAL GASMAL, SWAP
- INTEGER PMAX
- DOUBLE PRECISION A, CLT, CRT, D, FA, FT, GA, GT, HA, HT, L, M,
- $ MM, R, S, SLT, SRT, T, TEMP, TSIGN, TT
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, SIGN, SQRT
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Executable Statements ..
-*
- FT = F
- FA = ABS( FT )
- HT = H
- HA = ABS( H )
-*
-* PMAX points to the maximum absolute element of matrix
-* PMAX = 1 if F largest in absolute values
-* PMAX = 2 if G largest in absolute values
-* PMAX = 3 if H largest in absolute values
-*
- PMAX = 1
- SWAP = ( HA.GT.FA )
- IF( SWAP ) THEN
- PMAX = 3
- TEMP = FT
- FT = HT
- HT = TEMP
- TEMP = FA
- FA = HA
- HA = TEMP
-*
-* Now FA .ge. HA
-*
- END IF
- GT = G
- GA = ABS( GT )
- IF( GA.EQ.ZERO ) THEN
-*
-* Diagonal matrix
-*
- SSMIN = HA
- SSMAX = FA
- CLT = ONE
- CRT = ONE
- SLT = ZERO
- SRT = ZERO
- ELSE
- GASMAL = .TRUE.
- IF( GA.GT.FA ) THEN
- PMAX = 2
- IF( ( FA / GA ).LT.DLAMCH( 'EPS' ) ) THEN
-*
-* Case of very large GA
-*
- GASMAL = .FALSE.
- SSMAX = GA
- IF( HA.GT.ONE ) THEN
- SSMIN = FA / ( GA / HA )
- ELSE
- SSMIN = ( FA / GA )*HA
- END IF
- CLT = ONE
- SLT = HT / GT
- SRT = ONE
- CRT = FT / GT
- END IF
- END IF
- IF( GASMAL ) THEN
-*
-* Normal case
-*
- D = FA - HA
- IF( D.EQ.FA ) THEN
-*
-* Copes with infinite F or H
-*
- L = ONE
- ELSE
- L = D / FA
- END IF
-*
-* Note that 0 .le. L .le. 1
-*
- M = GT / FT
-*
-* Note that abs(M) .le. 1/macheps
-*
- T = TWO - L
-*
-* Note that T .ge. 1
-*
- MM = M*M
- TT = T*T
- S = SQRT( TT+MM )
-*
-* Note that 1 .le. S .le. 1 + 1/macheps
-*
- IF( L.EQ.ZERO ) THEN
- R = ABS( M )
- ELSE
- R = SQRT( L*L+MM )
- END IF
-*
-* Note that 0 .le. R .le. 1 + 1/macheps
-*
- A = HALF*( S+R )
-*
-* Note that 1 .le. A .le. 1 + abs(M)
-*
- SSMIN = HA / A
- SSMAX = FA*A
- IF( MM.EQ.ZERO ) THEN
-*
-* Note that M is very tiny
-*
- IF( L.EQ.ZERO ) THEN
- T = SIGN( TWO, FT )*SIGN( ONE, GT )
- ELSE
- T = GT / SIGN( D, FT ) + M / T
- END IF
- ELSE
- T = ( M / ( S+T )+M / ( R+L ) )*( ONE+A )
- END IF
- L = SQRT( T*T+FOUR )
- CRT = TWO / L
- SRT = T / L
- CLT = ( CRT+SRT*M ) / A
- SLT = ( HT / FT )*SRT / A
- END IF
- END IF
- IF( SWAP ) THEN
- CSL = SRT
- SNL = CRT
- CSR = SLT
- SNR = CLT
- ELSE
- CSL = CLT
- SNL = SLT
- CSR = CRT
- SNR = SRT
- END IF
-*
-* Correct signs of SSMAX and SSMIN
-*
- IF( PMAX.EQ.1 )
- $ TSIGN = SIGN( ONE, CSR )*SIGN( ONE, CSL )*SIGN( ONE, F )
- IF( PMAX.EQ.2 )
- $ TSIGN = SIGN( ONE, SNR )*SIGN( ONE, CSL )*SIGN( ONE, G )
- IF( PMAX.EQ.3 )
- $ TSIGN = SIGN( ONE, SNR )*SIGN( ONE, SNL )*SIGN( ONE, H )
- SSMAX = SIGN( SSMAX, TSIGN )
- SSMIN = SIGN( SSMIN, TSIGN*SIGN( ONE, F )*SIGN( ONE, H ) )
- RETURN
-*
-* End of DLASV2
-*
- END
diff --git a/mtx/lapack_src/dlaswp.f b/mtx/lapack_src/dlaswp.f
deleted file mode 100644
index ff0d1b04e..000000000
--- a/mtx/lapack_src/dlaswp.f
+++ /dev/null
@@ -1,191 +0,0 @@
-*> \brief \b DLASWP
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASWP + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, K1, K2, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the matrix of column dimension N to which the row
-*> interchanges will be applied.
-*> On exit, the permuted matrix.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> \endverbatim
-*>
-*> \param[in] K1
-*> \verbatim
-*> K1 is INTEGER
-*> The first element of IPIV for which a row interchange will
-*> be done.
-*> \endverbatim
-*>
-*> \param[in] K2
-*> \verbatim
-*> K2 is INTEGER
-*> The last element of IPIV for which a row interchange will
-*> be done.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (K2*abs(INCX))
-*> The vector of pivot indices. Only the elements in positions
-*> K1 through K2 of IPIV are accessed.
-*> IPIV(K) = L implies rows K and L are to be interchanged.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between successive values of IPIV. If IPIV
-*> is negative, the pivots are applied in reverse order.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Modified by
-*> R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX, K1, K2, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, I1, I2, INC, IP, IX, IX0, J, K, N32
- DOUBLE PRECISION TEMP
-* ..
-* .. Executable Statements ..
-*
-* Interchange row I with row IPIV(I) for each of rows K1 through K2.
-*
- IF( INCX.GT.0 ) THEN
- IX0 = K1
- I1 = K1
- I2 = K2
- INC = 1
- ELSE IF( INCX.LT.0 ) THEN
- IX0 = 1 + ( 1-K2 )*INCX
- I1 = K2
- I2 = K1
- INC = -1
- ELSE
- RETURN
- END IF
-*
- N32 = ( N / 32 )*32
- IF( N32.NE.0 ) THEN
- DO 30 J = 1, N32, 32
- IX = IX0
- DO 20 I = I1, I2, INC
- IP = IPIV( IX )
- IF( IP.NE.I ) THEN
- DO 10 K = J, J + 31
- TEMP = A( I, K )
- A( I, K ) = A( IP, K )
- A( IP, K ) = TEMP
- 10 CONTINUE
- END IF
- IX = IX + INCX
- 20 CONTINUE
- 30 CONTINUE
- END IF
- IF( N32.NE.N ) THEN
- N32 = N32 + 1
- IX = IX0
- DO 50 I = I1, I2, INC
- IP = IPIV( IX )
- IF( IP.NE.I ) THEN
- DO 40 K = N32, N
- TEMP = A( I, K )
- A( I, K ) = A( IP, K )
- A( IP, K ) = TEMP
- 40 CONTINUE
- END IF
- IX = IX + INCX
- 50 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DLASWP
-*
- END
diff --git a/mtx/lapack_src/dlasy2.f b/mtx/lapack_src/dlasy2.f
deleted file mode 100644
index 33b533307..000000000
--- a/mtx/lapack_src/dlasy2.f
+++ /dev/null
@@ -1,480 +0,0 @@
-*> \brief \b DLASY2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASY2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR,
-* LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO )
-*
-* .. Scalar Arguments ..
-* LOGICAL LTRANL, LTRANR
-* INTEGER INFO, ISGN, LDB, LDTL, LDTR, LDX, N1, N2
-* DOUBLE PRECISION SCALE, XNORM
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION B( LDB, * ), TL( LDTL, * ), TR( LDTR, * ),
-* $ X( LDX, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] LTRANL
-*> \verbatim
-*> LTRANL is LOGICAL
-*> On entry, LTRANL specifies the op(TL):
-*> = .FALSE., op(TL) = TL,
-*> = .TRUE., op(TL) = TL**T.
-*> \endverbatim
-*>
-*> \param[in] LTRANR
-*> \verbatim
-*> LTRANR is LOGICAL
-*> On entry, LTRANR specifies the op(TR):
-*> = .FALSE., op(TR) = TR,
-*> = .TRUE., op(TR) = TR**T.
-*> \endverbatim
-*>
-*> \param[in] ISGN
-*> \verbatim
-*> ISGN is INTEGER
-*> On entry, ISGN specifies the sign of the equation
-*> as described before. ISGN may only be 1 or -1.
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> On entry, N1 specifies the order of matrix TL.
-*> N1 may only be 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[in] N2
-*> \verbatim
-*> N2 is INTEGER
-*> On entry, N2 specifies the order of matrix TR.
-*> N2 may only be 0, 1 or 2.
-*> \endverbatim
-*>
-*> \param[in] TL
-*> \verbatim
-*> TL is DOUBLE PRECISION array, dimension (LDTL,2)
-*> On entry, TL contains an N1 by N1 matrix.
-*> \endverbatim
-*>
-*> \param[in] LDTL
-*> \verbatim
-*> LDTL is INTEGER
-*> The leading dimension of the matrix TL. LDTL >= max(1,N1).
-*> \endverbatim
-*>
-*> \param[in] TR
-*> \verbatim
-*> TR is DOUBLE PRECISION array, dimension (LDTR,2)
-*> On entry, TR contains an N2 by N2 matrix.
-*> \endverbatim
-*>
-*> \param[in] LDTR
-*> \verbatim
-*> LDTR is INTEGER
-*> The leading dimension of the matrix TR. LDTR >= max(1,N2).
-*> \endverbatim
-*>
-*> \param[in] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,2)
-*> On entry, the N1 by N2 matrix B contains the right-hand
-*> side of the equation.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the matrix B. LDB >= max(1,N1).
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> On exit, SCALE contains the scale factor. SCALE is chosen
-*> less than or equal to 1 to prevent the solution overflowing.
-*> \endverbatim
-*>
-*> \param[out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (LDX,2)
-*> On exit, X contains the N1 by N2 solution.
-*> \endverbatim
-*>
-*> \param[in] LDX
-*> \verbatim
-*> LDX is INTEGER
-*> The leading dimension of the matrix X. LDX >= max(1,N1).
-*> \endverbatim
-*>
-*> \param[out] XNORM
-*> \verbatim
-*> XNORM is DOUBLE PRECISION
-*> On exit, XNORM is the infinity-norm of the solution.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> On exit, INFO is set to
-*> 0: successful exit.
-*> 1: TL and TR have too close eigenvalues, so TL or
-*> TR is perturbed to get a nonsingular equation.
-*> NOTE: In the interests of speed, this routine does not
-*> check the inputs for errors.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleSYauxiliary
-*
-* =====================================================================
- SUBROUTINE DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR,
- $ LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- LOGICAL LTRANL, LTRANR
- INTEGER INFO, ISGN, LDB, LDTL, LDTR, LDX, N1, N2
- DOUBLE PRECISION SCALE, XNORM
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION B( LDB, * ), TL( LDTL, * ), TR( LDTR, * ),
- $ X( LDX, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
- DOUBLE PRECISION TWO, HALF, EIGHT
- PARAMETER ( TWO = 2.0D+0, HALF = 0.5D+0, EIGHT = 8.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL BSWAP, XSWAP
- INTEGER I, IP, IPIV, IPSV, J, JP, JPSV, K
- DOUBLE PRECISION BET, EPS, GAM, L21, SGN, SMIN, SMLNUM, TAU1,
- $ TEMP, U11, U12, U22, XMAX
-* ..
-* .. Local Arrays ..
- LOGICAL BSWPIV( 4 ), XSWPIV( 4 )
- INTEGER JPIV( 4 ), LOCL21( 4 ), LOCU12( 4 ),
- $ LOCU22( 4 )
- DOUBLE PRECISION BTMP( 4 ), T16( 4, 4 ), TMP( 4 ), X2( 2 )
-* ..
-* .. External Functions ..
- INTEGER IDAMAX
- DOUBLE PRECISION DLAMCH
- EXTERNAL IDAMAX, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DCOPY, DSWAP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX
-* ..
-* .. Data statements ..
- DATA LOCU12 / 3, 4, 1, 2 / , LOCL21 / 2, 1, 4, 3 / ,
- $ LOCU22 / 4, 3, 2, 1 /
- DATA XSWPIV / .FALSE., .FALSE., .TRUE., .TRUE. /
- DATA BSWPIV / .FALSE., .TRUE., .FALSE., .TRUE. /
-* ..
-* .. Executable Statements ..
-*
-* Do not check the input parameters for errors
-*
- INFO = 0
-*
-* Quick return if possible
-*
- IF( N1.EQ.0 .OR. N2.EQ.0 )
- $ RETURN
-*
-* Set constants to control overflow
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' ) / EPS
- SGN = ISGN
-*
- K = N1 + N1 + N2 - 2
- GO TO ( 10, 20, 30, 50 )K
-*
-* 1 by 1: TL11*X + SGN*X*TR11 = B11
-*
- 10 CONTINUE
- TAU1 = TL( 1, 1 ) + SGN*TR( 1, 1 )
- BET = ABS( TAU1 )
- IF( BET.LE.SMLNUM ) THEN
- TAU1 = SMLNUM
- BET = SMLNUM
- INFO = 1
- END IF
-*
- SCALE = ONE
- GAM = ABS( B( 1, 1 ) )
- IF( SMLNUM*GAM.GT.BET )
- $ SCALE = ONE / GAM
-*
- X( 1, 1 ) = ( B( 1, 1 )*SCALE ) / TAU1
- XNORM = ABS( X( 1, 1 ) )
- RETURN
-*
-* 1 by 2:
-* TL11*[X11 X12] + ISGN*[X11 X12]*op[TR11 TR12] = [B11 B12]
-* [TR21 TR22]
-*
- 20 CONTINUE
-*
- SMIN = MAX( EPS*MAX( ABS( TL( 1, 1 ) ), ABS( TR( 1, 1 ) ),
- $ ABS( TR( 1, 2 ) ), ABS( TR( 2, 1 ) ), ABS( TR( 2, 2 ) ) ),
- $ SMLNUM )
- TMP( 1 ) = TL( 1, 1 ) + SGN*TR( 1, 1 )
- TMP( 4 ) = TL( 1, 1 ) + SGN*TR( 2, 2 )
- IF( LTRANR ) THEN
- TMP( 2 ) = SGN*TR( 2, 1 )
- TMP( 3 ) = SGN*TR( 1, 2 )
- ELSE
- TMP( 2 ) = SGN*TR( 1, 2 )
- TMP( 3 ) = SGN*TR( 2, 1 )
- END IF
- BTMP( 1 ) = B( 1, 1 )
- BTMP( 2 ) = B( 1, 2 )
- GO TO 40
-*
-* 2 by 1:
-* op[TL11 TL12]*[X11] + ISGN* [X11]*TR11 = [B11]
-* [TL21 TL22] [X21] [X21] [B21]
-*
- 30 CONTINUE
- SMIN = MAX( EPS*MAX( ABS( TR( 1, 1 ) ), ABS( TL( 1, 1 ) ),
- $ ABS( TL( 1, 2 ) ), ABS( TL( 2, 1 ) ), ABS( TL( 2, 2 ) ) ),
- $ SMLNUM )
- TMP( 1 ) = TL( 1, 1 ) + SGN*TR( 1, 1 )
- TMP( 4 ) = TL( 2, 2 ) + SGN*TR( 1, 1 )
- IF( LTRANL ) THEN
- TMP( 2 ) = TL( 1, 2 )
- TMP( 3 ) = TL( 2, 1 )
- ELSE
- TMP( 2 ) = TL( 2, 1 )
- TMP( 3 ) = TL( 1, 2 )
- END IF
- BTMP( 1 ) = B( 1, 1 )
- BTMP( 2 ) = B( 2, 1 )
- 40 CONTINUE
-*
-* Solve 2 by 2 system using complete pivoting.
-* Set pivots less than SMIN to SMIN.
-*
- IPIV = IDAMAX( 4, TMP, 1 )
- U11 = TMP( IPIV )
- IF( ABS( U11 ).LE.SMIN ) THEN
- INFO = 1
- U11 = SMIN
- END IF
- U12 = TMP( LOCU12( IPIV ) )
- L21 = TMP( LOCL21( IPIV ) ) / U11
- U22 = TMP( LOCU22( IPIV ) ) - U12*L21
- XSWAP = XSWPIV( IPIV )
- BSWAP = BSWPIV( IPIV )
- IF( ABS( U22 ).LE.SMIN ) THEN
- INFO = 1
- U22 = SMIN
- END IF
- IF( BSWAP ) THEN
- TEMP = BTMP( 2 )
- BTMP( 2 ) = BTMP( 1 ) - L21*TEMP
- BTMP( 1 ) = TEMP
- ELSE
- BTMP( 2 ) = BTMP( 2 ) - L21*BTMP( 1 )
- END IF
- SCALE = ONE
- IF( ( TWO*SMLNUM )*ABS( BTMP( 2 ) ).GT.ABS( U22 ) .OR.
- $ ( TWO*SMLNUM )*ABS( BTMP( 1 ) ).GT.ABS( U11 ) ) THEN
- SCALE = HALF / MAX( ABS( BTMP( 1 ) ), ABS( BTMP( 2 ) ) )
- BTMP( 1 ) = BTMP( 1 )*SCALE
- BTMP( 2 ) = BTMP( 2 )*SCALE
- END IF
- X2( 2 ) = BTMP( 2 ) / U22
- X2( 1 ) = BTMP( 1 ) / U11 - ( U12 / U11 )*X2( 2 )
- IF( XSWAP ) THEN
- TEMP = X2( 2 )
- X2( 2 ) = X2( 1 )
- X2( 1 ) = TEMP
- END IF
- X( 1, 1 ) = X2( 1 )
- IF( N1.EQ.1 ) THEN
- X( 1, 2 ) = X2( 2 )
- XNORM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) )
- ELSE
- X( 2, 1 ) = X2( 2 )
- XNORM = MAX( ABS( X( 1, 1 ) ), ABS( X( 2, 1 ) ) )
- END IF
- RETURN
-*
-* 2 by 2:
-* op[TL11 TL12]*[X11 X12] +ISGN* [X11 X12]*op[TR11 TR12] = [B11 B12]
-* [TL21 TL22] [X21 X22] [X21 X22] [TR21 TR22] [B21 B22]
-*
-* Solve equivalent 4 by 4 system using complete pivoting.
-* Set pivots less than SMIN to SMIN.
-*
- 50 CONTINUE
- SMIN = MAX( ABS( TR( 1, 1 ) ), ABS( TR( 1, 2 ) ),
- $ ABS( TR( 2, 1 ) ), ABS( TR( 2, 2 ) ) )
- SMIN = MAX( SMIN, ABS( TL( 1, 1 ) ), ABS( TL( 1, 2 ) ),
- $ ABS( TL( 2, 1 ) ), ABS( TL( 2, 2 ) ) )
- SMIN = MAX( EPS*SMIN, SMLNUM )
- BTMP( 1 ) = ZERO
- CALL DCOPY( 16, BTMP, 0, T16, 1 )
- T16( 1, 1 ) = TL( 1, 1 ) + SGN*TR( 1, 1 )
- T16( 2, 2 ) = TL( 2, 2 ) + SGN*TR( 1, 1 )
- T16( 3, 3 ) = TL( 1, 1 ) + SGN*TR( 2, 2 )
- T16( 4, 4 ) = TL( 2, 2 ) + SGN*TR( 2, 2 )
- IF( LTRANL ) THEN
- T16( 1, 2 ) = TL( 2, 1 )
- T16( 2, 1 ) = TL( 1, 2 )
- T16( 3, 4 ) = TL( 2, 1 )
- T16( 4, 3 ) = TL( 1, 2 )
- ELSE
- T16( 1, 2 ) = TL( 1, 2 )
- T16( 2, 1 ) = TL( 2, 1 )
- T16( 3, 4 ) = TL( 1, 2 )
- T16( 4, 3 ) = TL( 2, 1 )
- END IF
- IF( LTRANR ) THEN
- T16( 1, 3 ) = SGN*TR( 1, 2 )
- T16( 2, 4 ) = SGN*TR( 1, 2 )
- T16( 3, 1 ) = SGN*TR( 2, 1 )
- T16( 4, 2 ) = SGN*TR( 2, 1 )
- ELSE
- T16( 1, 3 ) = SGN*TR( 2, 1 )
- T16( 2, 4 ) = SGN*TR( 2, 1 )
- T16( 3, 1 ) = SGN*TR( 1, 2 )
- T16( 4, 2 ) = SGN*TR( 1, 2 )
- END IF
- BTMP( 1 ) = B( 1, 1 )
- BTMP( 2 ) = B( 2, 1 )
- BTMP( 3 ) = B( 1, 2 )
- BTMP( 4 ) = B( 2, 2 )
-*
-* Perform elimination
-*
- DO 100 I = 1, 3
- XMAX = ZERO
- DO 70 IP = I, 4
- DO 60 JP = I, 4
- IF( ABS( T16( IP, JP ) ).GE.XMAX ) THEN
- XMAX = ABS( T16( IP, JP ) )
- IPSV = IP
- JPSV = JP
- END IF
- 60 CONTINUE
- 70 CONTINUE
- IF( IPSV.NE.I ) THEN
- CALL DSWAP( 4, T16( IPSV, 1 ), 4, T16( I, 1 ), 4 )
- TEMP = BTMP( I )
- BTMP( I ) = BTMP( IPSV )
- BTMP( IPSV ) = TEMP
- END IF
- IF( JPSV.NE.I )
- $ CALL DSWAP( 4, T16( 1, JPSV ), 1, T16( 1, I ), 1 )
- JPIV( I ) = JPSV
- IF( ABS( T16( I, I ) ).LT.SMIN ) THEN
- INFO = 1
- T16( I, I ) = SMIN
- END IF
- DO 90 J = I + 1, 4
- T16( J, I ) = T16( J, I ) / T16( I, I )
- BTMP( J ) = BTMP( J ) - T16( J, I )*BTMP( I )
- DO 80 K = I + 1, 4
- T16( J, K ) = T16( J, K ) - T16( J, I )*T16( I, K )
- 80 CONTINUE
- 90 CONTINUE
- 100 CONTINUE
- IF( ABS( T16( 4, 4 ) ).LT.SMIN )
- $ T16( 4, 4 ) = SMIN
- SCALE = ONE
- IF( ( EIGHT*SMLNUM )*ABS( BTMP( 1 ) ).GT.ABS( T16( 1, 1 ) ) .OR.
- $ ( EIGHT*SMLNUM )*ABS( BTMP( 2 ) ).GT.ABS( T16( 2, 2 ) ) .OR.
- $ ( EIGHT*SMLNUM )*ABS( BTMP( 3 ) ).GT.ABS( T16( 3, 3 ) ) .OR.
- $ ( EIGHT*SMLNUM )*ABS( BTMP( 4 ) ).GT.ABS( T16( 4, 4 ) ) ) THEN
- SCALE = ( ONE / EIGHT ) / MAX( ABS( BTMP( 1 ) ),
- $ ABS( BTMP( 2 ) ), ABS( BTMP( 3 ) ), ABS( BTMP( 4 ) ) )
- BTMP( 1 ) = BTMP( 1 )*SCALE
- BTMP( 2 ) = BTMP( 2 )*SCALE
- BTMP( 3 ) = BTMP( 3 )*SCALE
- BTMP( 4 ) = BTMP( 4 )*SCALE
- END IF
- DO 120 I = 1, 4
- K = 5 - I
- TEMP = ONE / T16( K, K )
- TMP( K ) = BTMP( K )*TEMP
- DO 110 J = K + 1, 4
- TMP( K ) = TMP( K ) - ( TEMP*T16( K, J ) )*TMP( J )
- 110 CONTINUE
- 120 CONTINUE
- DO 130 I = 1, 3
- IF( JPIV( 4-I ).NE.4-I ) THEN
- TEMP = TMP( 4-I )
- TMP( 4-I ) = TMP( JPIV( 4-I ) )
- TMP( JPIV( 4-I ) ) = TEMP
- END IF
- 130 CONTINUE
- X( 1, 1 ) = TMP( 1 )
- X( 2, 1 ) = TMP( 2 )
- X( 1, 2 ) = TMP( 3 )
- X( 2, 2 ) = TMP( 4 )
- XNORM = MAX( ABS( TMP( 1 ) )+ABS( TMP( 3 ) ),
- $ ABS( TMP( 2 ) )+ABS( TMP( 4 ) ) )
- RETURN
-*
-* End of DLASY2
-*
- END
diff --git a/mtx/lapack_src/dlatbs.f b/mtx/lapack_src/dlatbs.f
deleted file mode 100644
index d3fd23d32..000000000
--- a/mtx/lapack_src/dlatbs.f
+++ /dev/null
@@ -1,812 +0,0 @@
-*> \brief \b DLATBS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLATBS + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X,
-* SCALE, CNORM, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORMIN, TRANS, UPLO
-* INTEGER INFO, KD, LDAB, N
-* DOUBLE PRECISION SCALE
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION AB( LDAB, * ), CNORM( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the operation applied to A.
-*> = 'N': Solve A * x = s*b (No transpose)
-*> = 'T': Solve A**T* x = s*b (Transpose)
-*> = 'C': Solve A**T* x = s*b (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] NORMIN
-*> \verbatim
-*> NORMIN is CHARACTER*1
-*> Specifies whether CNORM has been set or not.
-*> = 'Y': CNORM contains the column norms on entry
-*> = 'N': CNORM is not set on entry. On exit, the norms will
-*> be computed and stored in CNORM.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KD
-*> \verbatim
-*> KD is INTEGER
-*> The number of subdiagonals or superdiagonals in the
-*> triangular matrix A. KD >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
-*> The upper or lower triangular band matrix A, stored in the
-*> first KD+1 rows of the array. The j-th column of A is stored
-*> in the j-th column of the array AB as follows:
-*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
-*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= KD+1.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (N)
-*> On entry, the right hand side b of the triangular system.
-*> On exit, X is overwritten by the solution vector x.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> The scaling factor s for the triangular system
-*> A * x = s*b or A**T* x = s*b.
-*> If SCALE = 0, the matrix A is singular or badly scaled, and
-*> the vector x is an exact or approximate solution to A*x = 0.
-*> \endverbatim
-*>
-*> \param[in,out] CNORM
-*> \verbatim
-*> CNORM is DOUBLE PRECISION array, dimension (N)
-*>
-*> If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
-*> contains the norm of the off-diagonal part of the j-th column
-*> of A. If TRANS = 'N', CNORM(j) must be greater than or equal
-*> to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
-*> must be greater than or equal to the 1-norm.
-*>
-*> If NORMIN = 'N', CNORM is an output argument and CNORM(j)
-*> returns the 1-norm of the offdiagonal part of the j-th column
-*> of A.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> A rough bound on x is computed; if that is less than overflow, DTBSV
-*> is called, otherwise, specific code is used which checks for possible
-*> overflow or divide-by-zero at every operation.
-*>
-*> A columnwise scheme is used for solving A*x = b. The basic algorithm
-*> if A is lower triangular is
-*>
-*> x[1:n] := b[1:n]
-*> for j = 1, ..., n
-*> x(j) := x(j) / A(j,j)
-*> x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
-*> end
-*>
-*> Define bounds on the components of x after j iterations of the loop:
-*> M(j) = bound on x[1:j]
-*> G(j) = bound on x[j+1:n]
-*> Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
-*>
-*> Then for iteration j+1 we have
-*> M(j+1) <= G(j) / | A(j+1,j+1) |
-*> G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
-*> <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
-*>
-*> where CNORM(j+1) is greater than or equal to the infinity-norm of
-*> column j+1 of A, not counting the diagonal. Hence
-*>
-*> G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
-*> 1<=i<=j
-*> and
-*>
-*> |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
-*> 1<=i< j
-*>
-*> Since |x(j)| <= M(j), we use the Level 2 BLAS routine DTBSV if the
-*> reciprocal of the largest M(j), j=1,..,n, is larger than
-*> max(underflow, 1/overflow).
-*>
-*> The bound on x(j) is also used to determine when a step in the
-*> columnwise method can be performed without fear of overflow. If
-*> the computed bound is greater than a large constant, x is scaled to
-*> prevent overflow, but if the bound overflows, x is set to 0, x(j) to
-*> 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
-*>
-*> Similarly, a row-wise scheme is used to solve A**T*x = b. The basic
-*> algorithm for A upper triangular is
-*>
-*> for j = 1, ..., n
-*> x(j) := ( b(j) - A[1:j-1,j]**T * x[1:j-1] ) / A(j,j)
-*> end
-*>
-*> We simultaneously compute two bounds
-*> G(j) = bound on ( b(i) - A[1:i-1,i]**T * x[1:i-1] ), 1<=i<=j
-*> M(j) = bound on x(i), 1<=i<=j
-*>
-*> The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
-*> add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
-*> Then the bound on x(j) is
-*>
-*> M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
-*>
-*> <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
-*> 1<=i<=j
-*>
-*> and we can safely call DTBSV if 1/M(n) and 1/G(n) are both greater
-*> than max(underflow, 1/overflow).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X,
- $ SCALE, CNORM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORMIN, TRANS, UPLO
- INTEGER INFO, KD, LDAB, N
- DOUBLE PRECISION SCALE
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION AB( LDAB, * ), CNORM( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN, NOUNIT, UPPER
- INTEGER I, IMAX, J, JFIRST, JINC, JLAST, JLEN, MAIND
- DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS,
- $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DASUM, DDOT, DLAMCH
- EXTERNAL LSAME, IDAMAX, DASUM, DDOT, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DSCAL, DTBSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOTRAN = LSAME( TRANS, 'N' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
-* Test the input parameters.
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT.
- $ LSAME( NORMIN, 'N' ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( KD.LT.0 ) THEN
- INFO = -6
- ELSE IF( LDAB.LT.KD+1 ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLATBS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine machine dependent parameters to control overflow.
-*
- SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
- BIGNUM = ONE / SMLNUM
- SCALE = ONE
-*
- IF( LSAME( NORMIN, 'N' ) ) THEN
-*
-* Compute the 1-norm of each column, not including the diagonal.
-*
- IF( UPPER ) THEN
-*
-* A is upper triangular.
-*
- DO 10 J = 1, N
- JLEN = MIN( KD, J-1 )
- CNORM( J ) = DASUM( JLEN, AB( KD+1-JLEN, J ), 1 )
- 10 CONTINUE
- ELSE
-*
-* A is lower triangular.
-*
- DO 20 J = 1, N
- JLEN = MIN( KD, N-J )
- IF( JLEN.GT.0 ) THEN
- CNORM( J ) = DASUM( JLEN, AB( 2, J ), 1 )
- ELSE
- CNORM( J ) = ZERO
- END IF
- 20 CONTINUE
- END IF
- END IF
-*
-* Scale the column norms by TSCAL if the maximum element in CNORM is
-* greater than BIGNUM.
-*
- IMAX = IDAMAX( N, CNORM, 1 )
- TMAX = CNORM( IMAX )
- IF( TMAX.LE.BIGNUM ) THEN
- TSCAL = ONE
- ELSE
- TSCAL = ONE / ( SMLNUM*TMAX )
- CALL DSCAL( N, TSCAL, CNORM, 1 )
- END IF
-*
-* Compute a bound on the computed solution vector to see if the
-* Level 2 BLAS routine DTBSV can be used.
-*
- J = IDAMAX( N, X, 1 )
- XMAX = ABS( X( J ) )
- XBND = XMAX
- IF( NOTRAN ) THEN
-*
-* Compute the growth in A * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = N
- JLAST = 1
- JINC = -1
- MAIND = KD + 1
- ELSE
- JFIRST = 1
- JLAST = N
- JINC = 1
- MAIND = 1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 50
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, G(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- DO 30 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* M(j) = G(j-1) / abs(A(j,j))
-*
- TJJ = ABS( AB( MAIND, J ) )
- XBND = MIN( XBND, MIN( ONE, TJJ )*GROW )
- IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) )
-*
- GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) )
- ELSE
-*
-* G(j) could overflow, set GROW to 0.
-*
- GROW = ZERO
- END IF
- 30 CONTINUE
- GROW = XBND
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 40 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) )
-*
- GROW = GROW*( ONE / ( ONE+CNORM( J ) ) )
- 40 CONTINUE
- END IF
- 50 CONTINUE
-*
- ELSE
-*
-* Compute the growth in A**T * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = 1
- JLAST = N
- JINC = 1
- MAIND = KD + 1
- ELSE
- JFIRST = N
- JLAST = 1
- JINC = -1
- MAIND = 1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 80
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, M(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- DO 60 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) )
-*
- XJ = ONE + CNORM( J )
- GROW = MIN( GROW, XBND / XJ )
-*
-* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j))
-*
- TJJ = ABS( AB( MAIND, J ) )
- IF( XJ.GT.TJJ )
- $ XBND = XBND*( TJJ / XJ )
- 60 CONTINUE
- GROW = MIN( GROW, XBND )
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 70 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = ( 1 + CNORM(j) )*G(j-1)
-*
- XJ = ONE + CNORM( J )
- GROW = GROW / XJ
- 70 CONTINUE
- END IF
- 80 CONTINUE
- END IF
-*
- IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN
-*
-* Use the Level 2 BLAS solve if the reciprocal of the bound on
-* elements of X is not too small.
-*
- CALL DTBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, X, 1 )
- ELSE
-*
-* Use a Level 1 BLAS solve, scaling intermediate results.
-*
- IF( XMAX.GT.BIGNUM ) THEN
-*
-* Scale X so that its components are less than or equal to
-* BIGNUM in absolute value.
-*
- SCALE = BIGNUM / XMAX
- CALL DSCAL( N, SCALE, X, 1 )
- XMAX = BIGNUM
- END IF
-*
- IF( NOTRAN ) THEN
-*
-* Solve A * x = b
-*
- DO 110 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) / A(j,j), scaling x if necessary.
-*
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
- TJJS = AB( MAIND, J )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 100
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by 1/b(j).
-*
- REC = ONE / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM
-* to avoid overflow when dividing by A(j,j).
-*
- REC = ( TJJ*BIGNUM ) / XJ
- IF( CNORM( J ).GT.ONE ) THEN
-*
-* Scale by 1/CNORM(j) to avoid overflow when
-* multiplying x(j) times column j.
-*
- REC = REC / CNORM( J )
- END IF
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A*x = 0.
-*
- DO 90 I = 1, N
- X( I ) = ZERO
- 90 CONTINUE
- X( J ) = ONE
- XJ = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 100 CONTINUE
-*
-* Scale x if necessary to avoid overflow when adding a
-* multiple of column j of A.
-*
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
-*
-* Scale x by 1/(2*abs(x(j))).
-*
- REC = REC*HALF
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
-*
-* Scale x by 1/2.
-*
- CALL DSCAL( N, HALF, X, 1 )
- SCALE = SCALE*HALF
- END IF
-*
- IF( UPPER ) THEN
- IF( J.GT.1 ) THEN
-*
-* Compute the update
-* x(max(1,j-kd):j-1) := x(max(1,j-kd):j-1) -
-* x(j)* A(max(1,j-kd):j-1,j)
-*
- JLEN = MIN( KD, J-1 )
- CALL DAXPY( JLEN, -X( J )*TSCAL,
- $ AB( KD+1-JLEN, J ), 1, X( J-JLEN ), 1 )
- I = IDAMAX( J-1, X, 1 )
- XMAX = ABS( X( I ) )
- END IF
- ELSE IF( J.LT.N ) THEN
-*
-* Compute the update
-* x(j+1:min(j+kd,n)) := x(j+1:min(j+kd,n)) -
-* x(j) * A(j+1:min(j+kd,n),j)
-*
- JLEN = MIN( KD, N-J )
- IF( JLEN.GT.0 )
- $ CALL DAXPY( JLEN, -X( J )*TSCAL, AB( 2, J ), 1,
- $ X( J+1 ), 1 )
- I = J + IDAMAX( N-J, X( J+1 ), 1 )
- XMAX = ABS( X( I ) )
- END IF
- 110 CONTINUE
-*
- ELSE
-*
-* Solve A**T * x = b
-*
- DO 160 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) - sum A(k,j)*x(k).
-* k<>j
-*
- XJ = ABS( X( J ) )
- USCAL = TSCAL
- REC = ONE / MAX( XMAX, ONE )
- IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
-*
-* If x(j) could overflow, scale x by 1/(2*XMAX).
-*
- REC = REC*HALF
- IF( NOUNIT ) THEN
- TJJS = AB( MAIND, J )*TSCAL
- ELSE
- TJJS = TSCAL
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.ONE ) THEN
-*
-* Divide by A(j,j) when scaling x if A(j,j) > 1.
-*
- REC = MIN( ONE, REC*TJJ )
- USCAL = USCAL / TJJS
- END IF
- IF( REC.LT.ONE ) THEN
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- SUMJ = ZERO
- IF( USCAL.EQ.ONE ) THEN
-*
-* If the scaling needed for A in the dot product is 1,
-* call DDOT to perform the dot product.
-*
- IF( UPPER ) THEN
- JLEN = MIN( KD, J-1 )
- SUMJ = DDOT( JLEN, AB( KD+1-JLEN, J ), 1,
- $ X( J-JLEN ), 1 )
- ELSE
- JLEN = MIN( KD, N-J )
- IF( JLEN.GT.0 )
- $ SUMJ = DDOT( JLEN, AB( 2, J ), 1, X( J+1 ), 1 )
- END IF
- ELSE
-*
-* Otherwise, use in-line code for the dot product.
-*
- IF( UPPER ) THEN
- JLEN = MIN( KD, J-1 )
- DO 120 I = 1, JLEN
- SUMJ = SUMJ + ( AB( KD+I-JLEN, J )*USCAL )*
- $ X( J-JLEN-1+I )
- 120 CONTINUE
- ELSE
- JLEN = MIN( KD, N-J )
- DO 130 I = 1, JLEN
- SUMJ = SUMJ + ( AB( I+1, J )*USCAL )*X( J+I )
- 130 CONTINUE
- END IF
- END IF
-*
- IF( USCAL.EQ.TSCAL ) THEN
-*
-* Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j)
-* was not used to scale the dotproduct.
-*
- X( J ) = X( J ) - SUMJ
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
-*
-* Compute x(j) = x(j) / A(j,j), scaling if necessary.
-*
- TJJS = AB( MAIND, J )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 150
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale X by 1/abs(x(j)).
-*
- REC = ONE / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM.
-*
- REC = ( TJJ*BIGNUM ) / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A**T*x = 0.
-*
- DO 140 I = 1, N
- X( I ) = ZERO
- 140 CONTINUE
- X( J ) = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 150 CONTINUE
- ELSE
-*
-* Compute x(j) := x(j) / A(j,j) - sumj if the dot
-* product has already been divided by 1/A(j,j).
-*
- X( J ) = X( J ) / TJJS - SUMJ
- END IF
- XMAX = MAX( XMAX, ABS( X( J ) ) )
- 160 CONTINUE
- END IF
- SCALE = SCALE / TSCAL
- END IF
-*
-* Scale the column norms by 1/TSCAL for return.
-*
- IF( TSCAL.NE.ONE ) THEN
- CALL DSCAL( N, ONE / TSCAL, CNORM, 1 )
- END IF
-*
- RETURN
-*
-* End of DLATBS
-*
- END
diff --git a/mtx/lapack_src/dlatrs.f b/mtx/lapack_src/dlatrs.f
deleted file mode 100644
index 8ed76e31a..000000000
--- a/mtx/lapack_src/dlatrs.f
+++ /dev/null
@@ -1,787 +0,0 @@
-*> \brief \b DLATRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLATRS + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
-* CNORM, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, NORMIN, TRANS, UPLO
-* INTEGER INFO, LDA, N
-* DOUBLE PRECISION SCALE
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), CNORM( * ), X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the operation applied to A.
-*> = 'N': Solve A * x = s*b (No transpose)
-*> = 'T': Solve A**T* x = s*b (Transpose)
-*> = 'C': Solve A**T* x = s*b (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] NORMIN
-*> \verbatim
-*> NORMIN is CHARACTER*1
-*> Specifies whether CNORM has been set or not.
-*> = 'Y': CNORM contains the column norms on entry
-*> = 'N': CNORM is not set on entry. On exit, the norms will
-*> be computed and stored in CNORM.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The triangular matrix A. If UPLO = 'U', the leading n by n
-*> upper triangular part of the array A contains the upper
-*> triangular matrix, and the strictly lower triangular part of
-*> A is not referenced. If UPLO = 'L', the leading n by n lower
-*> triangular part of the array A contains the lower triangular
-*> matrix, and the strictly upper triangular part of A is not
-*> referenced. If DIAG = 'U', the diagonal elements of A are
-*> also not referenced and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max (1,N).
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is DOUBLE PRECISION array, dimension (N)
-*> On entry, the right hand side b of the triangular system.
-*> On exit, X is overwritten by the solution vector x.
-*> \endverbatim
-*>
-*> \param[out] SCALE
-*> \verbatim
-*> SCALE is DOUBLE PRECISION
-*> The scaling factor s for the triangular system
-*> A * x = s*b or A**T* x = s*b.
-*> If SCALE = 0, the matrix A is singular or badly scaled, and
-*> the vector x is an exact or approximate solution to A*x = 0.
-*> \endverbatim
-*>
-*> \param[in,out] CNORM
-*> \verbatim
-*> CNORM is DOUBLE PRECISION array, dimension (N)
-*>
-*> If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
-*> contains the norm of the off-diagonal part of the j-th column
-*> of A. If TRANS = 'N', CNORM(j) must be greater than or equal
-*> to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
-*> must be greater than or equal to the 1-norm.
-*>
-*> If NORMIN = 'N', CNORM is an output argument and CNORM(j)
-*> returns the 1-norm of the offdiagonal part of the j-th column
-*> of A.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> A rough bound on x is computed; if that is less than overflow, DTRSV
-*> is called, otherwise, specific code is used which checks for possible
-*> overflow or divide-by-zero at every operation.
-*>
-*> A columnwise scheme is used for solving A*x = b. The basic algorithm
-*> if A is lower triangular is
-*>
-*> x[1:n] := b[1:n]
-*> for j = 1, ..., n
-*> x(j) := x(j) / A(j,j)
-*> x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
-*> end
-*>
-*> Define bounds on the components of x after j iterations of the loop:
-*> M(j) = bound on x[1:j]
-*> G(j) = bound on x[j+1:n]
-*> Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
-*>
-*> Then for iteration j+1 we have
-*> M(j+1) <= G(j) / | A(j+1,j+1) |
-*> G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
-*> <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
-*>
-*> where CNORM(j+1) is greater than or equal to the infinity-norm of
-*> column j+1 of A, not counting the diagonal. Hence
-*>
-*> G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
-*> 1<=i<=j
-*> and
-*>
-*> |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
-*> 1<=i< j
-*>
-*> Since |x(j)| <= M(j), we use the Level 2 BLAS routine DTRSV if the
-*> reciprocal of the largest M(j), j=1,..,n, is larger than
-*> max(underflow, 1/overflow).
-*>
-*> The bound on x(j) is also used to determine when a step in the
-*> columnwise method can be performed without fear of overflow. If
-*> the computed bound is greater than a large constant, x is scaled to
-*> prevent overflow, but if the bound overflows, x is set to 0, x(j) to
-*> 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
-*>
-*> Similarly, a row-wise scheme is used to solve A**T*x = b. The basic
-*> algorithm for A upper triangular is
-*>
-*> for j = 1, ..., n
-*> x(j) := ( b(j) - A[1:j-1,j]**T * x[1:j-1] ) / A(j,j)
-*> end
-*>
-*> We simultaneously compute two bounds
-*> G(j) = bound on ( b(i) - A[1:i-1,i]**T * x[1:i-1] ), 1<=i<=j
-*> M(j) = bound on x(i), 1<=i<=j
-*>
-*> The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
-*> add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
-*> Then the bound on x(j) is
-*>
-*> M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
-*>
-*> <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
-*> 1<=i<=j
-*>
-*> and we can safely call DTRSV if 1/M(n) and 1/G(n) are both greater
-*> than max(underflow, 1/overflow).
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
- $ CNORM, INFO )
-*
-* -- LAPACK auxiliary routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, NORMIN, TRANS, UPLO
- INTEGER INFO, LDA, N
- DOUBLE PRECISION SCALE
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), CNORM( * ), X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, HALF, ONE
- PARAMETER ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN, NOUNIT, UPPER
- INTEGER I, IMAX, J, JFIRST, JINC, JLAST
- DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS,
- $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DASUM, DDOT, DLAMCH
- EXTERNAL LSAME, IDAMAX, DASUM, DDOT, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DSCAL, DTRSV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOTRAN = LSAME( TRANS, 'N' )
- NOUNIT = LSAME( DIAG, 'N' )
-*
-* Test the input parameters.
-*
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT.
- $ LSAME( NORMIN, 'N' ) ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DLATRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Determine machine dependent parameters to control overflow.
-*
- SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
- BIGNUM = ONE / SMLNUM
- SCALE = ONE
-*
- IF( LSAME( NORMIN, 'N' ) ) THEN
-*
-* Compute the 1-norm of each column, not including the diagonal.
-*
- IF( UPPER ) THEN
-*
-* A is upper triangular.
-*
- DO 10 J = 1, N
- CNORM( J ) = DASUM( J-1, A( 1, J ), 1 )
- 10 CONTINUE
- ELSE
-*
-* A is lower triangular.
-*
- DO 20 J = 1, N - 1
- CNORM( J ) = DASUM( N-J, A( J+1, J ), 1 )
- 20 CONTINUE
- CNORM( N ) = ZERO
- END IF
- END IF
-*
-* Scale the column norms by TSCAL if the maximum element in CNORM is
-* greater than BIGNUM.
-*
- IMAX = IDAMAX( N, CNORM, 1 )
- TMAX = CNORM( IMAX )
- IF( TMAX.LE.BIGNUM ) THEN
- TSCAL = ONE
- ELSE
- TSCAL = ONE / ( SMLNUM*TMAX )
- CALL DSCAL( N, TSCAL, CNORM, 1 )
- END IF
-*
-* Compute a bound on the computed solution vector to see if the
-* Level 2 BLAS routine DTRSV can be used.
-*
- J = IDAMAX( N, X, 1 )
- XMAX = ABS( X( J ) )
- XBND = XMAX
- IF( NOTRAN ) THEN
-*
-* Compute the growth in A * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = N
- JLAST = 1
- JINC = -1
- ELSE
- JFIRST = 1
- JLAST = N
- JINC = 1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 50
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, G(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- DO 30 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* M(j) = G(j-1) / abs(A(j,j))
-*
- TJJ = ABS( A( J, J ) )
- XBND = MIN( XBND, MIN( ONE, TJJ )*GROW )
- IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) )
-*
- GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) )
- ELSE
-*
-* G(j) could overflow, set GROW to 0.
-*
- GROW = ZERO
- END IF
- 30 CONTINUE
- GROW = XBND
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 40 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 50
-*
-* G(j) = G(j-1)*( 1 + CNORM(j) )
-*
- GROW = GROW*( ONE / ( ONE+CNORM( J ) ) )
- 40 CONTINUE
- END IF
- 50 CONTINUE
-*
- ELSE
-*
-* Compute the growth in A**T * x = b.
-*
- IF( UPPER ) THEN
- JFIRST = 1
- JLAST = N
- JINC = 1
- ELSE
- JFIRST = N
- JLAST = 1
- JINC = -1
- END IF
-*
- IF( TSCAL.NE.ONE ) THEN
- GROW = ZERO
- GO TO 80
- END IF
-*
- IF( NOUNIT ) THEN
-*
-* A is non-unit triangular.
-*
-* Compute GROW = 1/G(j) and XBND = 1/M(j).
-* Initially, M(0) = max{x(i), i=1,...,n}.
-*
- GROW = ONE / MAX( XBND, SMLNUM )
- XBND = GROW
- DO 60 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) )
-*
- XJ = ONE + CNORM( J )
- GROW = MIN( GROW, XBND / XJ )
-*
-* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j))
-*
- TJJ = ABS( A( J, J ) )
- IF( XJ.GT.TJJ )
- $ XBND = XBND*( TJJ / XJ )
- 60 CONTINUE
- GROW = MIN( GROW, XBND )
- ELSE
-*
-* A is unit triangular.
-*
-* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
- GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
- DO 70 J = JFIRST, JLAST, JINC
-*
-* Exit the loop if the growth factor is too small.
-*
- IF( GROW.LE.SMLNUM )
- $ GO TO 80
-*
-* G(j) = ( 1 + CNORM(j) )*G(j-1)
-*
- XJ = ONE + CNORM( J )
- GROW = GROW / XJ
- 70 CONTINUE
- END IF
- 80 CONTINUE
- END IF
-*
- IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN
-*
-* Use the Level 2 BLAS solve if the reciprocal of the bound on
-* elements of X is not too small.
-*
- CALL DTRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 )
- ELSE
-*
-* Use a Level 1 BLAS solve, scaling intermediate results.
-*
- IF( XMAX.GT.BIGNUM ) THEN
-*
-* Scale X so that its components are less than or equal to
-* BIGNUM in absolute value.
-*
- SCALE = BIGNUM / XMAX
- CALL DSCAL( N, SCALE, X, 1 )
- XMAX = BIGNUM
- END IF
-*
- IF( NOTRAN ) THEN
-*
-* Solve A * x = b
-*
- DO 110 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) / A(j,j), scaling x if necessary.
-*
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
- TJJS = A( J, J )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 100
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by 1/b(j).
-*
- REC = ONE / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM
-* to avoid overflow when dividing by A(j,j).
-*
- REC = ( TJJ*BIGNUM ) / XJ
- IF( CNORM( J ).GT.ONE ) THEN
-*
-* Scale by 1/CNORM(j) to avoid overflow when
-* multiplying x(j) times column j.
-*
- REC = REC / CNORM( J )
- END IF
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- XJ = ABS( X( J ) )
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A*x = 0.
-*
- DO 90 I = 1, N
- X( I ) = ZERO
- 90 CONTINUE
- X( J ) = ONE
- XJ = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 100 CONTINUE
-*
-* Scale x if necessary to avoid overflow when adding a
-* multiple of column j of A.
-*
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
-*
-* Scale x by 1/(2*abs(x(j))).
-*
- REC = REC*HALF
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- END IF
- ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
-*
-* Scale x by 1/2.
-*
- CALL DSCAL( N, HALF, X, 1 )
- SCALE = SCALE*HALF
- END IF
-*
- IF( UPPER ) THEN
- IF( J.GT.1 ) THEN
-*
-* Compute the update
-* x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j)
-*
- CALL DAXPY( J-1, -X( J )*TSCAL, A( 1, J ), 1, X,
- $ 1 )
- I = IDAMAX( J-1, X, 1 )
- XMAX = ABS( X( I ) )
- END IF
- ELSE
- IF( J.LT.N ) THEN
-*
-* Compute the update
-* x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j)
-*
- CALL DAXPY( N-J, -X( J )*TSCAL, A( J+1, J ), 1,
- $ X( J+1 ), 1 )
- I = J + IDAMAX( N-J, X( J+1 ), 1 )
- XMAX = ABS( X( I ) )
- END IF
- END IF
- 110 CONTINUE
-*
- ELSE
-*
-* Solve A**T * x = b
-*
- DO 160 J = JFIRST, JLAST, JINC
-*
-* Compute x(j) = b(j) - sum A(k,j)*x(k).
-* k<>j
-*
- XJ = ABS( X( J ) )
- USCAL = TSCAL
- REC = ONE / MAX( XMAX, ONE )
- IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
-*
-* If x(j) could overflow, scale x by 1/(2*XMAX).
-*
- REC = REC*HALF
- IF( NOUNIT ) THEN
- TJJS = A( J, J )*TSCAL
- ELSE
- TJJS = TSCAL
- END IF
- TJJ = ABS( TJJS )
- IF( TJJ.GT.ONE ) THEN
-*
-* Divide by A(j,j) when scaling x if A(j,j) > 1.
-*
- REC = MIN( ONE, REC*TJJ )
- USCAL = USCAL / TJJS
- END IF
- IF( REC.LT.ONE ) THEN
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
-*
- SUMJ = ZERO
- IF( USCAL.EQ.ONE ) THEN
-*
-* If the scaling needed for A in the dot product is 1,
-* call DDOT to perform the dot product.
-*
- IF( UPPER ) THEN
- SUMJ = DDOT( J-1, A( 1, J ), 1, X, 1 )
- ELSE IF( J.LT.N ) THEN
- SUMJ = DDOT( N-J, A( J+1, J ), 1, X( J+1 ), 1 )
- END IF
- ELSE
-*
-* Otherwise, use in-line code for the dot product.
-*
- IF( UPPER ) THEN
- DO 120 I = 1, J - 1
- SUMJ = SUMJ + ( A( I, J )*USCAL )*X( I )
- 120 CONTINUE
- ELSE IF( J.LT.N ) THEN
- DO 130 I = J + 1, N
- SUMJ = SUMJ + ( A( I, J )*USCAL )*X( I )
- 130 CONTINUE
- END IF
- END IF
-*
- IF( USCAL.EQ.TSCAL ) THEN
-*
-* Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j)
-* was not used to scale the dotproduct.
-*
- X( J ) = X( J ) - SUMJ
- XJ = ABS( X( J ) )
- IF( NOUNIT ) THEN
- TJJS = A( J, J )*TSCAL
- ELSE
- TJJS = TSCAL
- IF( TSCAL.EQ.ONE )
- $ GO TO 150
- END IF
-*
-* Compute x(j) = x(j) / A(j,j), scaling if necessary.
-*
- TJJ = ABS( TJJS )
- IF( TJJ.GT.SMLNUM ) THEN
-*
-* abs(A(j,j)) > SMLNUM:
-*
- IF( TJJ.LT.ONE ) THEN
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale X by 1/abs(x(j)).
-*
- REC = ONE / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- END IF
- X( J ) = X( J ) / TJJS
- ELSE IF( TJJ.GT.ZERO ) THEN
-*
-* 0 < abs(A(j,j)) <= SMLNUM:
-*
- IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM.
-*
- REC = ( TJJ*BIGNUM ) / XJ
- CALL DSCAL( N, REC, X, 1 )
- SCALE = SCALE*REC
- XMAX = XMAX*REC
- END IF
- X( J ) = X( J ) / TJJS
- ELSE
-*
-* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
-* scale = 0, and compute a solution to A**T*x = 0.
-*
- DO 140 I = 1, N
- X( I ) = ZERO
- 140 CONTINUE
- X( J ) = ONE
- SCALE = ZERO
- XMAX = ZERO
- END IF
- 150 CONTINUE
- ELSE
-*
-* Compute x(j) := x(j) / A(j,j) - sumj if the dot
-* product has already been divided by 1/A(j,j).
-*
- X( J ) = X( J ) / TJJS - SUMJ
- END IF
- XMAX = MAX( XMAX, ABS( X( J ) ) )
- 160 CONTINUE
- END IF
- SCALE = SCALE / TSCAL
- END IF
-*
-* Scale the column norms by 1/TSCAL for return.
-*
- IF( TSCAL.NE.ONE ) THEN
- CALL DSCAL( N, ONE / TSCAL, CNORM, 1 )
- END IF
-*
- RETURN
-*
-* End of DLATRS
-*
- END
diff --git a/mtx/lapack_src/dlazq3.f b/mtx/lapack_src/dlazq3.f
deleted file mode 100644
index 784248f73..000000000
--- a/mtx/lapack_src/dlazq3.f
+++ /dev/null
@@ -1,302 +0,0 @@
- SUBROUTINE DLAZQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
- $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1,
- $ DN2, TAU )
-*
-* -- LAPACK auxiliary routine (version 3.1) --
-* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-* November 2006
-*
-* .. Scalar Arguments ..
- LOGICAL IEEE
- INTEGER I0, ITER, N0, NDIV, NFAIL, PP, TTYPE
- DOUBLE PRECISION DESIG, DMIN, DMIN1, DMIN2, DN, DN1, DN2, QMAX,
- $ SIGMA, TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Z( * )
-* ..
-*
-* Purpose
-* =======
-*
-* DLAZQ3 checks for deflation, computes a shift (TAU) and calls dqds.
-* In case of failure it changes shifts, and tries again until output
-* is positive.
-*
-* Arguments
-* =========
-*
-* I0 (input) INTEGER
-* First index.
-*
-* N0 (input) INTEGER
-* Last index.
-*
-* Z (input) DOUBLE PRECISION array, dimension ( 4*N )
-* Z holds the qd array.
-*
-* PP (input) INTEGER
-* PP=0 for ping, PP=1 for pong.
-*
-* DMIN (output) DOUBLE PRECISION
-* Minimum value of d.
-*
-* SIGMA (output) DOUBLE PRECISION
-* Sum of shifts used in current segment.
-*
-* DESIG (input/output) DOUBLE PRECISION
-* Lower order part of SIGMA
-*
-* QMAX (input) DOUBLE PRECISION
-* Maximum value of q.
-*
-* NFAIL (output) INTEGER
-* Number of times shift was too big.
-*
-* ITER (output) INTEGER
-* Number of iterations.
-*
-* NDIV (output) INTEGER
-* Number of divisions.
-*
-* IEEE (input) LOGICAL
-* Flag for IEEE or non IEEE arithmetic (passed to DLASQ5).
-*
-* TTYPE (input/output) INTEGER
-* Shift type. TTYPE is passed as an argument in order to save
-* its value between calls to DLAZQ3
-*
-* DMIN1 (input/output) REAL
-* DMIN2 (input/output) REAL
-* DN (input/output) REAL
-* DN1 (input/output) REAL
-* DN2 (input/output) REAL
-* TAU (input/output) REAL
-* These are passed as arguments in order to save their values
-* between calls to DLAZQ3
-*
-* This is a thread safe version of DLASQ3, which passes TTYPE, DMIN1,
-* DMIN2, DN, DN1. DN2 and TAU through the argument list in place of
-* declaring them in a SAVE statment.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION CBIAS
- PARAMETER ( CBIAS = 1.50D0 )
- DOUBLE PRECISION ZERO, QURTR, HALF, ONE, TWO, HUNDRD
- PARAMETER ( ZERO = 0.0D0, QURTR = 0.250D0, HALF = 0.5D0,
- $ ONE = 1.0D0, TWO = 2.0D0, HUNDRD = 100.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER IPN4, J4, N0IN, NN
- DOUBLE PRECISION EPS, G, S, SAFMIN, T, TEMP, TOL, TOL2
-* ..
-* .. External Subroutines ..
- EXTERNAL DLASQ5, DLASQ6, DLAZQ4
-* ..
-* .. External Function ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
- N0IN = N0
- EPS = DLAMCH( 'Precision' )
- SAFMIN = DLAMCH( 'Safe minimum' )
- TOL = EPS*HUNDRD
- TOL2 = TOL**2
- G = ZERO
-*
-* Check for deflation.
-*
- 10 CONTINUE
-*
- IF( N0.LT.I0 )
- $ RETURN
- IF( N0.EQ.I0 )
- $ GO TO 20
- NN = 4*N0 + PP
- IF( N0.EQ.( I0+1 ) )
- $ GO TO 40
-*
-* Check whether E(N0-1) is negligible, 1 eigenvalue.
-*
- IF( Z( NN-5 ).GT.TOL2*( SIGMA+Z( NN-3 ) ) .AND.
- $ Z( NN-2*PP-4 ).GT.TOL2*Z( NN-7 ) )
- $ GO TO 30
-*
- 20 CONTINUE
-*
- Z( 4*N0-3 ) = Z( 4*N0+PP-3 ) + SIGMA
- N0 = N0 - 1
- GO TO 10
-*
-* Check whether E(N0-2) is negligible, 2 eigenvalues.
-*
- 30 CONTINUE
-*
- IF( Z( NN-9 ).GT.TOL2*SIGMA .AND.
- $ Z( NN-2*PP-8 ).GT.TOL2*Z( NN-11 ) )
- $ GO TO 50
-*
- 40 CONTINUE
-*
- IF( Z( NN-3 ).GT.Z( NN-7 ) ) THEN
- S = Z( NN-3 )
- Z( NN-3 ) = Z( NN-7 )
- Z( NN-7 ) = S
- END IF
- IF( Z( NN-5 ).GT.Z( NN-3 )*TOL2 ) THEN
- T = HALF*( ( Z( NN-7 )-Z( NN-3 ) )+Z( NN-5 ) )
- S = Z( NN-3 )*( Z( NN-5 ) / T )
- IF( S.LE.T ) THEN
- S = Z( NN-3 )*( Z( NN-5 ) /
- $ ( T*( ONE+SQRT( ONE+S / T ) ) ) )
- ELSE
- S = Z( NN-3 )*( Z( NN-5 ) / ( T+SQRT( T )*SQRT( T+S ) ) )
- END IF
- T = Z( NN-7 ) + ( S+Z( NN-5 ) )
- Z( NN-3 ) = Z( NN-3 )*( Z( NN-7 ) / T )
- Z( NN-7 ) = T
- END IF
- Z( 4*N0-7 ) = Z( NN-7 ) + SIGMA
- Z( 4*N0-3 ) = Z( NN-3 ) + SIGMA
- N0 = N0 - 2
- GO TO 10
-*
- 50 CONTINUE
-*
-* Reverse the qd-array, if warranted.
-*
- IF( DMIN.LE.ZERO .OR. N0.LT.N0IN ) THEN
- IF( CBIAS*Z( 4*I0+PP-3 ).LT.Z( 4*N0+PP-3 ) ) THEN
- IPN4 = 4*( I0+N0 )
- DO 60 J4 = 4*I0, 2*( I0+N0-1 ), 4
- TEMP = Z( J4-3 )
- Z( J4-3 ) = Z( IPN4-J4-3 )
- Z( IPN4-J4-3 ) = TEMP
- TEMP = Z( J4-2 )
- Z( J4-2 ) = Z( IPN4-J4-2 )
- Z( IPN4-J4-2 ) = TEMP
- TEMP = Z( J4-1 )
- Z( J4-1 ) = Z( IPN4-J4-5 )
- Z( IPN4-J4-5 ) = TEMP
- TEMP = Z( J4 )
- Z( J4 ) = Z( IPN4-J4-4 )
- Z( IPN4-J4-4 ) = TEMP
- 60 CONTINUE
- IF( N0-I0.LE.4 ) THEN
- Z( 4*N0+PP-1 ) = Z( 4*I0+PP-1 )
- Z( 4*N0-PP ) = Z( 4*I0-PP )
- END IF
- DMIN2 = MIN( DMIN2, Z( 4*N0+PP-1 ) )
- Z( 4*N0+PP-1 ) = MIN( Z( 4*N0+PP-1 ), Z( 4*I0+PP-1 ),
- $ Z( 4*I0+PP+3 ) )
- Z( 4*N0-PP ) = MIN( Z( 4*N0-PP ), Z( 4*I0-PP ),
- $ Z( 4*I0-PP+4 ) )
- QMAX = MAX( QMAX, Z( 4*I0+PP-3 ), Z( 4*I0+PP+1 ) )
- DMIN = -ZERO
- END IF
- END IF
-*
- IF( DMIN.LT.ZERO .OR. SAFMIN*QMAX.LT.MIN( Z( 4*N0+PP-1 ),
- $ Z( 4*N0+PP-9 ), DMIN2+Z( 4*N0-PP ) ) ) THEN
-*
-* Choose a shift.
-*
- CALL DLAZQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, DN1,
- $ DN2, TAU, TTYPE, G )
-*
-* Call dqds until DMIN > 0.
-*
- 80 CONTINUE
-*
- CALL DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,
- $ DN1, DN2, IEEE )
-*
- NDIV = NDIV + ( N0-I0+2 )
- ITER = ITER + 1
-*
-* Check status.
-*
- IF( DMIN.GE.ZERO .AND. DMIN1.GT.ZERO ) THEN
-*
-* Success.
-*
- GO TO 100
-*
- ELSE IF( DMIN.LT.ZERO .AND. DMIN1.GT.ZERO .AND.
- $ Z( 4*( N0-1 )-PP ).LT.TOL*( SIGMA+DN1 ) .AND.
- $ ABS( DN ).LT.TOL*SIGMA ) THEN
-*
-* Convergence hidden by negative DN.
-*
- Z( 4*( N0-1 )-PP+2 ) = ZERO
- DMIN = ZERO
- GO TO 100
- ELSE IF( DMIN.LT.ZERO ) THEN
-*
-* TAU too big. Select new TAU and try again.
-*
- NFAIL = NFAIL + 1
- IF( TTYPE.LT.-22 ) THEN
-*
-* Failed twice. Play it safe.
-*
- TAU = ZERO
- ELSE IF( DMIN1.GT.ZERO ) THEN
-*
-* Late failure. Gives excellent shift.
-*
- TAU = ( TAU+DMIN )*( ONE-TWO*EPS )
- TTYPE = TTYPE - 11
- ELSE
-*
-* Early failure. Divide by 4.
-*
- TAU = QURTR*TAU
- TTYPE = TTYPE - 12
- END IF
- GO TO 80
- ELSE IF( DMIN.NE.DMIN ) THEN
-*
-* NaN.
-*
- TAU = ZERO
- GO TO 80
- ELSE
-*
-* Possible underflow. Play it safe.
-*
- GO TO 90
- END IF
- END IF
-*
-* Risk of underflow.
-*
- 90 CONTINUE
- CALL DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN, DN1, DN2 )
- NDIV = NDIV + ( N0-I0+2 )
- ITER = ITER + 1
- TAU = ZERO
-*
- 100 CONTINUE
- IF( TAU.LT.SIGMA ) THEN
- DESIG = DESIG + TAU
- T = SIGMA + DESIG
- DESIG = DESIG - ( T-SIGMA )
- ELSE
- T = SIGMA + TAU
- DESIG = SIGMA - ( T-TAU ) + DESIG
- END IF
- SIGMA = T
-*
- RETURN
-*
-* End of DLAZQ3
-*
- END
diff --git a/mtx/lapack_src/dlazq4.f b/mtx/lapack_src/dlazq4.f
deleted file mode 100644
index 7c257f8d0..000000000
--- a/mtx/lapack_src/dlazq4.f
+++ /dev/null
@@ -1,330 +0,0 @@
- SUBROUTINE DLAZQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
- $ DN1, DN2, TAU, TTYPE, G )
-*
-* -- LAPACK auxiliary routine (version 3.1) --
-* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-* November 2006
-*
-* .. Scalar Arguments ..
- INTEGER I0, N0, N0IN, PP, TTYPE
- DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DN1, DN2, G, TAU
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Z( * )
-* ..
-*
-* Purpose
-* =======
-*
-* DLAZQ4 computes an approximation TAU to the smallest eigenvalue
-* using values of d from the previous transform.
-*
-* I0 (input) INTEGER
-* First index.
-*
-* N0 (input) INTEGER
-* Last index.
-*
-* Z (input) DOUBLE PRECISION array, dimension ( 4*N )
-* Z holds the qd array.
-*
-* PP (input) INTEGER
-* PP=0 for ping, PP=1 for pong.
-*
-* N0IN (input) INTEGER
-* The value of N0 at start of EIGTEST.
-*
-* DMIN (input) DOUBLE PRECISION
-* Minimum value of d.
-*
-* DMIN1 (input) DOUBLE PRECISION
-* Minimum value of d, excluding D( N0 ).
-*
-* DMIN2 (input) DOUBLE PRECISION
-* Minimum value of d, excluding D( N0 ) and D( N0-1 ).
-*
-* DN (input) DOUBLE PRECISION
-* d(N)
-*
-* DN1 (input) DOUBLE PRECISION
-* d(N-1)
-*
-* DN2 (input) DOUBLE PRECISION
-* d(N-2)
-*
-* TAU (output) DOUBLE PRECISION
-* This is the shift.
-*
-* TTYPE (output) INTEGER
-* Shift type.
-*
-* G (input/output) DOUBLE PRECISION
-* G is passed as an argument in order to save its value between
-* calls to DLAZQ4
-*
-* Further Details
-* ===============
-* CNST1 = 9/16
-*
-* This is a thread safe version of DLASQ4, which passes G through the
-* argument list in place of declaring G in a SAVE statment.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION CNST1, CNST2, CNST3
- PARAMETER ( CNST1 = 0.5630D0, CNST2 = 1.010D0,
- $ CNST3 = 1.050D0 )
- DOUBLE PRECISION QURTR, THIRD, HALF, ZERO, ONE, TWO, HUNDRD
- PARAMETER ( QURTR = 0.250D0, THIRD = 0.3330D0,
- $ HALF = 0.50D0, ZERO = 0.0D0, ONE = 1.0D0,
- $ TWO = 2.0D0, HUNDRD = 100.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER I4, NN, NP
- DOUBLE PRECISION A2, B1, B2, GAM, GAP1, GAP2, S
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT
-* ..
-* .. Executable Statements ..
-*
-* A negative DMIN forces the shift to take that absolute value
-* TTYPE records the type of shift.
-*
- IF( DMIN.LE.ZERO ) THEN
- TAU = -DMIN
- TTYPE = -1
- RETURN
- END IF
-*
- NN = 4*N0 + PP
- IF( N0IN.EQ.N0 ) THEN
-*
-* No eigenvalues deflated.
-*
- IF( DMIN.EQ.DN .OR. DMIN.EQ.DN1 ) THEN
-*
- B1 = SQRT( Z( NN-3 ) )*SQRT( Z( NN-5 ) )
- B2 = SQRT( Z( NN-7 ) )*SQRT( Z( NN-9 ) )
- A2 = Z( NN-7 ) + Z( NN-5 )
-*
-* Cases 2 and 3.
-*
- IF( DMIN.EQ.DN .AND. DMIN1.EQ.DN1 ) THEN
- GAP2 = DMIN2 - A2 - DMIN2*QURTR
- IF( GAP2.GT.ZERO .AND. GAP2.GT.B2 ) THEN
- GAP1 = A2 - DN - ( B2 / GAP2 )*B2
- ELSE
- GAP1 = A2 - DN - ( B1+B2 )
- END IF
- IF( GAP1.GT.ZERO .AND. GAP1.GT.B1 ) THEN
- S = MAX( DN-( B1 / GAP1 )*B1, HALF*DMIN )
- TTYPE = -2
- ELSE
- S = ZERO
- IF( DN.GT.B1 )
- $ S = DN - B1
- IF( A2.GT.( B1+B2 ) )
- $ S = MIN( S, A2-( B1+B2 ) )
- S = MAX( S, THIRD*DMIN )
- TTYPE = -3
- END IF
- ELSE
-*
-* Case 4.
-*
- TTYPE = -4
- S = QURTR*DMIN
- IF( DMIN.EQ.DN ) THEN
- GAM = DN
- A2 = ZERO
- IF( Z( NN-5 ) .GT. Z( NN-7 ) )
- $ RETURN
- B2 = Z( NN-5 ) / Z( NN-7 )
- NP = NN - 9
- ELSE
- NP = NN - 2*PP
- B2 = Z( NP-2 )
- GAM = DN1
- IF( Z( NP-4 ) .GT. Z( NP-2 ) )
- $ RETURN
- A2 = Z( NP-4 ) / Z( NP-2 )
- IF( Z( NN-9 ) .GT. Z( NN-11 ) )
- $ RETURN
- B2 = Z( NN-9 ) / Z( NN-11 )
- NP = NN - 13
- END IF
-*
-* Approximate contribution to norm squared from I < NN-1.
-*
- A2 = A2 + B2
- DO 10 I4 = NP, 4*I0 - 1 + PP, -4
- IF( B2.EQ.ZERO )
- $ GO TO 20
- B1 = B2
- IF( Z( I4 ) .GT. Z( I4-2 ) )
- $ RETURN
- B2 = B2*( Z( I4 ) / Z( I4-2 ) )
- A2 = A2 + B2
- IF( HUNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 )
- $ GO TO 20
- 10 CONTINUE
- 20 CONTINUE
- A2 = CNST3*A2
-*
-* Rayleigh quotient residual bound.
-*
- IF( A2.LT.CNST1 )
- $ S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
- END IF
- ELSE IF( DMIN.EQ.DN2 ) THEN
-*
-* Case 5.
-*
- TTYPE = -5
- S = QURTR*DMIN
-*
-* Compute contribution to norm squared from I > NN-2.
-*
- NP = NN - 2*PP
- B1 = Z( NP-2 )
- B2 = Z( NP-6 )
- GAM = DN2
- IF( Z( NP-8 ).GT.B2 .OR. Z( NP-4 ).GT.B1 )
- $ RETURN
- A2 = ( Z( NP-8 ) / B2 )*( ONE+Z( NP-4 ) / B1 )
-*
-* Approximate contribution to norm squared from I < NN-2.
-*
- IF( N0-I0.GT.2 ) THEN
- B2 = Z( NN-13 ) / Z( NN-15 )
- A2 = A2 + B2
- DO 30 I4 = NN - 17, 4*I0 - 1 + PP, -4
- IF( B2.EQ.ZERO )
- $ GO TO 40
- B1 = B2
- IF( Z( I4 ) .GT. Z( I4-2 ) )
- $ RETURN
- B2 = B2*( Z( I4 ) / Z( I4-2 ) )
- A2 = A2 + B2
- IF( HUNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 )
- $ GO TO 40
- 30 CONTINUE
- 40 CONTINUE
- A2 = CNST3*A2
- END IF
-*
- IF( A2.LT.CNST1 )
- $ S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
- ELSE
-*
-* Case 6, no information to guide us.
-*
- IF( TTYPE.EQ.-6 ) THEN
- G = G + THIRD*( ONE-G )
- ELSE IF( TTYPE.EQ.-18 ) THEN
- G = QURTR*THIRD
- ELSE
- G = QURTR
- END IF
- S = G*DMIN
- TTYPE = -6
- END IF
-*
- ELSE IF( N0IN.EQ.( N0+1 ) ) THEN
-*
-* One eigenvalue just deflated. Use DMIN1, DN1 for DMIN and DN.
-*
- IF( DMIN1.EQ.DN1 .AND. DMIN2.EQ.DN2 ) THEN
-*
-* Cases 7 and 8.
-*
- TTYPE = -7
- S = THIRD*DMIN1
- IF( Z( NN-5 ).GT.Z( NN-7 ) )
- $ RETURN
- B1 = Z( NN-5 ) / Z( NN-7 )
- B2 = B1
- IF( B2.EQ.ZERO )
- $ GO TO 60
- DO 50 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
- A2 = B1
- IF( Z( I4 ).GT.Z( I4-2 ) )
- $ RETURN
- B1 = B1*( Z( I4 ) / Z( I4-2 ) )
- B2 = B2 + B1
- IF( HUNDRD*MAX( B1, A2 ).LT.B2 )
- $ GO TO 60
- 50 CONTINUE
- 60 CONTINUE
- B2 = SQRT( CNST3*B2 )
- A2 = DMIN1 / ( ONE+B2**2 )
- GAP2 = HALF*DMIN2 - A2
- IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
- S = MAX( S, A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ) )
- ELSE
- S = MAX( S, A2*( ONE-CNST2*B2 ) )
- TTYPE = -8
- END IF
- ELSE
-*
-* Case 9.
-*
- S = QURTR*DMIN1
- IF( DMIN1.EQ.DN1 )
- $ S = HALF*DMIN1
- TTYPE = -9
- END IF
-*
- ELSE IF( N0IN.EQ.( N0+2 ) ) THEN
-*
-* Two eigenvalues deflated. Use DMIN2, DN2 for DMIN and DN.
-*
-* Cases 10 and 11.
-*
- IF( DMIN2.EQ.DN2 .AND. TWO*Z( NN-5 ).LT.Z( NN-7 ) ) THEN
- TTYPE = -10
- S = THIRD*DMIN2
- IF( Z( NN-5 ).GT.Z( NN-7 ) )
- $ RETURN
- B1 = Z( NN-5 ) / Z( NN-7 )
- B2 = B1
- IF( B2.EQ.ZERO )
- $ GO TO 80
- DO 70 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
- IF( Z( I4 ).GT.Z( I4-2 ) )
- $ RETURN
- B1 = B1*( Z( I4 ) / Z( I4-2 ) )
- B2 = B2 + B1
- IF( HUNDRD*B1.LT.B2 )
- $ GO TO 80
- 70 CONTINUE
- 80 CONTINUE
- B2 = SQRT( CNST3*B2 )
- A2 = DMIN2 / ( ONE+B2**2 )
- GAP2 = Z( NN-7 ) + Z( NN-9 ) -
- $ SQRT( Z( NN-11 ) )*SQRT( Z( NN-9 ) ) - A2
- IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
- S = MAX( S, A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ) )
- ELSE
- S = MAX( S, A2*( ONE-CNST2*B2 ) )
- END IF
- ELSE
- S = QURTR*DMIN2
- TTYPE = -11
- END IF
- ELSE IF( N0IN.GT.( N0+2 ) ) THEN
-*
-* Case 12, more than two eigenvalues deflated. No information.
-*
- S = ZERO
- TTYPE = -12
- END IF
-*
- TAU = S
- RETURN
-*
-* End of DLAZQ4
-*
- END
diff --git a/mtx/lapack_src/dnrm2.f b/mtx/lapack_src/dnrm2.f
deleted file mode 100644
index 480c912a1..000000000
--- a/mtx/lapack_src/dnrm2.f
+++ /dev/null
@@ -1,67 +0,0 @@
- DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DNRM2 returns the euclidean norm of a vector via the function
-* name, so that
-*
-* DNRM2 := sqrt( x'*x )
-*
-* Further Details
-* ===============
-*
-* -- This version written on 25-October-1982.
-* Modified on 14-October-1993 to inline the call to DLASSQ.
-* Sven Hammarling, Nag Ltd.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION ABSXI,NORM,SCALE,SSQ
- INTEGER IX
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS,SQRT
-* ..
- IF (N.LT.1 .OR. INCX.LT.1) THEN
- NORM = ZERO
- ELSE IF (N.EQ.1) THEN
- NORM = ABS(X(1))
- ELSE
- SCALE = ZERO
- SSQ = ONE
-* The following loop is equivalent to this call to the LAPACK
-* auxiliary routine:
-* CALL DLASSQ( N, X, INCX, SCALE, SSQ )
-*
- DO 10 IX = 1,1 + (N-1)*INCX,INCX
- IF (X(IX).NE.ZERO) THEN
- ABSXI = ABS(X(IX))
- IF (SCALE.LT.ABSXI) THEN
- SSQ = ONE + SSQ* (SCALE/ABSXI)**2
- SCALE = ABSXI
- ELSE
- SSQ = SSQ + (ABSXI/SCALE)**2
- END IF
- END IF
- 10 CONTINUE
- NORM = SCALE*SQRT(SSQ)
- END IF
-*
- DNRM2 = NORM
- RETURN
-*
-* End of DNRM2.
-*
- END
diff --git a/mtx/lapack_src/dorg2r.f b/mtx/lapack_src/dorg2r.f
deleted file mode 100644
index 4f3844282..000000000
--- a/mtx/lapack_src/dorg2r.f
+++ /dev/null
@@ -1,200 +0,0 @@
-*> \brief \b DORG2R
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORG2R + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the i-th column must contain the vector which
-*> defines the elementary reflector H(i), for i = 1,2,...,k, as
-*> returned by DGEQRF in the first k columns of its array
-*> argument A.
-*> On exit, the m-by-n matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGEQRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, L
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORG2R', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 )
- $ RETURN
-*
-* Initialise columns k+1:n to columns of the unit matrix
-*
- DO 20 J = K + 1, N
- DO 10 L = 1, M
- A( L, J ) = ZERO
- 10 CONTINUE
- A( J, J ) = ONE
- 20 CONTINUE
-*
- DO 40 I = K, 1, -1
-*
-* Apply H(i) to A(i:m,i:n) from the left
-*
- IF( I.LT.N ) THEN
- A( I, I ) = ONE
- CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
- $ A( I, I+1 ), LDA, WORK )
- END IF
- IF( I.LT.M )
- $ CALL DSCAL( M-I, -TAU( I ), A( I+1, I ), 1 )
- A( I, I ) = ONE - TAU( I )
-*
-* Set A(1:i-1,i) to zero
-*
- DO 30 L = 1, I - 1
- A( L, I ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- RETURN
-*
-* End of DORG2R
-*
- END
diff --git a/mtx/lapack_src/dorgbr.f b/mtx/lapack_src/dorgbr.f
deleted file mode 100644
index ddfa7262a..000000000
--- a/mtx/lapack_src/dorgbr.f
+++ /dev/null
@@ -1,338 +0,0 @@
-*> \brief \b DORGBR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORGBR + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER VECT
-* INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] VECT
-*> \verbatim
-*> VECT is CHARACTER*1
-*> Specifies whether the matrix Q or the matrix P**T is
-*> required, as defined in the transformation applied by DGEBRD:
-*> = 'Q': generate Q;
-*> = 'P': generate P**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q or P**T to be returned.
-*> M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q or P**T to be returned.
-*> N >= 0.
-*> If VECT = 'Q', M >= N >= min(M,K);
-*> if VECT = 'P', N >= M >= min(N,K).
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> If VECT = 'Q', the number of columns in the original M-by-K
-*> matrix reduced by DGEBRD.
-*> If VECT = 'P', the number of rows in the original K-by-N
-*> matrix reduced by DGEBRD.
-*> K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the vectors which define the elementary reflectors,
-*> as returned by DGEBRD.
-*> On exit, the M-by-N matrix Q or P**T.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension
-*> (min(M,K)) if VECT = 'Q'
-*> (min(N,K)) if VECT = 'P'
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i) or G(i), which determines Q or P**T, as
-*> returned by DGEBRD in its array argument TAUQ or TAUP.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,min(M,N)).
-*> For optimum performance LWORK >= min(M,N)*NB, where NB
-*> is the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup doubleGBcomputational
-*
-* =====================================================================
- SUBROUTINE DORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- CHARACTER VECT
- INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY, WANTQ
- INTEGER I, IINFO, J, LWKOPT, MN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DORGLQ, DORGQR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- WANTQ = LSAME( VECT, 'Q' )
- MN = MIN( M, N )
- LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
- INFO = -1
- ELSE IF( M.LT.0 ) THEN
- INFO = -2
- ELSE IF( N.LT.0 .OR. ( WANTQ .AND. ( N.GT.M .OR. N.LT.MIN( M,
- $ K ) ) ) .OR. ( .NOT.WANTQ .AND. ( M.GT.N .OR. M.LT.
- $ MIN( N, K ) ) ) ) THEN
- INFO = -3
- ELSE IF( K.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -6
- ELSE IF( LWORK.LT.MAX( 1, MN ) .AND. .NOT.LQUERY ) THEN
- INFO = -9
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- WORK( 1 ) = 1
- IF( WANTQ ) THEN
- IF( M.GE.K ) THEN
- CALL DORGQR( M, N, K, A, LDA, TAU, WORK, -1, IINFO )
- ELSE
- IF( M.GT.1 ) THEN
- CALL DORGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK,
- $ -1, IINFO )
- END IF
- END IF
- ELSE
- IF( K.LT.N ) THEN
- CALL DORGLQ( M, N, K, A, LDA, TAU, WORK, -1, IINFO )
- ELSE
- IF( N.GT.1 ) THEN
- CALL DORGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
- $ -1, IINFO )
- END IF
- END IF
- END IF
- LWKOPT = WORK( 1 )
- LWKOPT = MAX (LWKOPT, MN)
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORGBR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- WORK( 1 ) = LWKOPT
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- IF( WANTQ ) THEN
-*
-* Form Q, determined by a call to DGEBRD to reduce an m-by-k
-* matrix
-*
- IF( M.GE.K ) THEN
-*
-* If m >= k, assume m >= n >= k
-*
- CALL DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
-*
- ELSE
-*
-* If m < k, assume m = n
-*
-* Shift the vectors which define the elementary reflectors one
-* column to the right, and set the first row and column of Q
-* to those of the unit matrix
-*
- DO 20 J = M, 2, -1
- A( 1, J ) = ZERO
- DO 10 I = J + 1, M
- A( I, J ) = A( I, J-1 )
- 10 CONTINUE
- 20 CONTINUE
- A( 1, 1 ) = ONE
- DO 30 I = 2, M
- A( I, 1 ) = ZERO
- 30 CONTINUE
- IF( M.GT.1 ) THEN
-*
-* Form Q(2:m,2:m)
-*
- CALL DORGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK,
- $ LWORK, IINFO )
- END IF
- END IF
- ELSE
-*
-* Form P**T, determined by a call to DGEBRD to reduce a k-by-n
-* matrix
-*
- IF( K.LT.N ) THEN
-*
-* If k < n, assume k <= m <= n
-*
- CALL DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
-*
- ELSE
-*
-* If k >= n, assume m = n
-*
-* Shift the vectors which define the elementary reflectors one
-* row downward, and set the first row and column of P**T to
-* those of the unit matrix
-*
- A( 1, 1 ) = ONE
- DO 40 I = 2, N
- A( I, 1 ) = ZERO
- 40 CONTINUE
- DO 60 J = 2, N
- DO 50 I = J - 1, 2, -1
- A( I, J ) = A( I-1, J )
- 50 CONTINUE
- A( 1, J ) = ZERO
- 60 CONTINUE
- IF( N.GT.1 ) THEN
-*
-* Form P**T(2:n,2:n)
-*
- CALL DORGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
- $ LWORK, IINFO )
- END IF
- END IF
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORGBR
-*
- END
diff --git a/mtx/lapack_src/dorghr.f b/mtx/lapack_src/dorghr.f
deleted file mode 100644
index 48f504ea7..000000000
--- a/mtx/lapack_src/dorghr.f
+++ /dev/null
@@ -1,240 +0,0 @@
-*> \brief \b DORGHR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORGHR + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, ILO, INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix Q. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> ILO and IHI must have the same values as in the previous call
-*> of DGEHRD. Q is equal to the unit matrix except in the
-*> submatrix Q(ilo+1:ihi,ilo+1:ihi).
-*> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the vectors which define the elementary reflectors,
-*> as returned by DGEHRD.
-*> On exit, the N-by-N orthogonal matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (N-1)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGEHRD.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= IHI-ILO.
-*> For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHI, ILO, INFO, LDA, LWORK, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IINFO, J, LWKOPT, NB, NH
-* ..
-* .. External Subroutines ..
- EXTERNAL DORGQR, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NH = IHI - ILO
- LQUERY = ( LWORK.EQ.-1 )
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
- INFO = -2
- ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LWORK.LT.MAX( 1, NH ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- NB = ILAENV( 1, 'DORGQR', ' ', NH, NH, NH, -1 )
- LWKOPT = MAX( 1, NH )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORGHR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
-* Shift the vectors which define the elementary reflectors one
-* column to the right, and set the first ilo and the last n-ihi
-* rows and columns to those of the unit matrix
-*
- DO 40 J = IHI, ILO + 1, -1
- DO 10 I = 1, J - 1
- A( I, J ) = ZERO
- 10 CONTINUE
- DO 20 I = J + 1, IHI
- A( I, J ) = A( I, J-1 )
- 20 CONTINUE
- DO 30 I = IHI + 1, N
- A( I, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- DO 60 J = 1, ILO
- DO 50 I = 1, N
- A( I, J ) = ZERO
- 50 CONTINUE
- A( J, J ) = ONE
- 60 CONTINUE
- DO 80 J = IHI + 1, N
- DO 70 I = 1, N
- A( I, J ) = ZERO
- 70 CONTINUE
- A( J, J ) = ONE
- 80 CONTINUE
-*
- IF( NH.GT.0 ) THEN
-*
-* Generate Q(ilo+1:ihi,ilo+1:ihi)
-*
- CALL DORGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ),
- $ WORK, LWORK, IINFO )
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORGHR
-*
- END
diff --git a/mtx/lapack_src/dorgl2.f b/mtx/lapack_src/dorgl2.f
deleted file mode 100644
index 3e8398b73..000000000
--- a/mtx/lapack_src/dorgl2.f
+++ /dev/null
@@ -1,204 +0,0 @@
-*> \brief \b DORGL2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORGL2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. N >= M.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. M >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the i-th row must contain the vector which defines
-*> the elementary reflector H(i), for i = 1,2,...,k, as returned
-*> by DGELQF in the first k rows of its array argument A.
-*> On exit, the m-by-n matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGELQF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (M)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, L
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORGL2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.LE.0 )
- $ RETURN
-*
- IF( K.LT.M ) THEN
-*
-* Initialise rows k+1:m to rows of the unit matrix
-*
- DO 20 J = 1, N
- DO 10 L = K + 1, M
- A( L, J ) = ZERO
- 10 CONTINUE
- IF( J.GT.K .AND. J.LE.M )
- $ A( J, J ) = ONE
- 20 CONTINUE
- END IF
-*
- DO 40 I = K, 1, -1
-*
-* Apply H(i) to A(i:m,i:n) from the right
-*
- IF( I.LT.N ) THEN
- IF( I.LT.M ) THEN
- A( I, I ) = ONE
- CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
- $ TAU( I ), A( I+1, I ), LDA, WORK )
- END IF
- CALL DSCAL( N-I, -TAU( I ), A( I, I+1 ), LDA )
- END IF
- A( I, I ) = ONE - TAU( I )
-*
-* Set A(i,1:i-1) to zero
-*
- DO 30 L = 1, I - 1
- A( I, L ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- RETURN
-*
-* End of DORGL2
-*
- END
diff --git a/mtx/lapack_src/dorglq.f b/mtx/lapack_src/dorglq.f
deleted file mode 100644
index 88aec1500..000000000
--- a/mtx/lapack_src/dorglq.f
+++ /dev/null
@@ -1,289 +0,0 @@
-*> \brief \b DORGLQ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORGLQ + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. N >= M.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. M >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the i-th row must contain the vector which defines
-*> the elementary reflector H(i), for i = 1,2,...,k, as returned
-*> by DGELQF in the first k rows of its array argument A.
-*> On exit, the M-by-N matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGELQF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,M).
-*> For optimum performance LWORK >= M*NB, where NB is
-*> the optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
- $ LWKOPT, NB, NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFB, DLARFT, DORGL2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NB = ILAENV( 1, 'DORGLQ', ' ', M, N, K, -1 )
- LWKOPT = MAX( 1, M )*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORGLQ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.LE.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = M
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'DORGLQ', ' ', M, N, K, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = M
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DORGLQ', ' ', M, N, K, -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code after the last block.
-* The first kk rows are handled by the block method.
-*
- KI = ( ( K-NX-1 ) / NB )*NB
- KK = MIN( K, KI+NB )
-*
-* Set A(kk+1:m,1:kk) to zero.
-*
- DO 20 J = 1, KK
- DO 10 I = KK + 1, M
- A( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- KK = 0
- END IF
-*
-* Use unblocked code for the last or only block.
-*
- IF( KK.LT.M )
- $ CALL DORGL2( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
- $ TAU( KK+1 ), WORK, IINFO )
-*
- IF( KK.GT.0 ) THEN
-*
-* Use blocked code
-*
- DO 50 I = KI + 1, 1, -NB
- IB = MIN( NB, K-I+1 )
- IF( I+IB.LE.M ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ),
- $ LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H**T to A(i+ib:m,i:n) from the right
-*
- CALL DLARFB( 'Right', 'Transpose', 'Forward', 'Rowwise',
- $ M-I-IB+1, N-I+1, IB, A( I, I ), LDA, WORK,
- $ LDWORK, A( I+IB, I ), LDA, WORK( IB+1 ),
- $ LDWORK )
- END IF
-*
-* Apply H**T to columns i:n of current block
-*
- CALL DORGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
-*
-* Set columns 1:i-1 of current block to zero
-*
- DO 40 J = 1, I - 1
- DO 30 L = I, I + IB - 1
- A( L, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- 50 CONTINUE
- END IF
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DORGLQ
-*
- END
diff --git a/mtx/lapack_src/dorgqr.f b/mtx/lapack_src/dorgqr.f
deleted file mode 100644
index 404ab184e..000000000
--- a/mtx/lapack_src/dorgqr.f
+++ /dev/null
@@ -1,290 +0,0 @@
-*> \brief \b DORGQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORGQR + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix Q. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix Q. M >= N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines the
-*> matrix Q. N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the i-th column must contain the vector which
-*> defines the elementary reflector H(i), for i = 1,2,...,k, as
-*> returned by DGEQRF in the first k columns of its array
-*> argument A.
-*> On exit, the M-by-N matrix Q.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The first dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGEQRF.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK. LWORK >= max(1,N).
-*> For optimum performance LWORK >= N*NB, where NB is the
-*> optimal blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument has an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, K, LDA, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LQUERY
- INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
- $ LWKOPT, NB, NBMIN, NX
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFB, DLARFT, DORG2R, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NB = ILAENV( 1, 'DORGQR', ' ', M, N, K, -1 )
- LWKOPT = MAX( 1, N )*NB
- WORK( 1 ) = LWKOPT
- LQUERY = ( LWORK.EQ.-1 )
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
- INFO = -2
- ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -5
- ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORGQR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- NX = 0
- IWS = N
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-* Determine when to cross over from blocked to unblocked code.
-*
- NX = MAX( 0, ILAENV( 3, 'DORGQR', ' ', M, N, K, -1 ) )
- IF( NX.LT.K ) THEN
-*
-* Determine if workspace is large enough for blocked code.
-*
- LDWORK = N
- IWS = LDWORK*NB
- IF( LWORK.LT.IWS ) THEN
-*
-* Not enough workspace to use optimal NB: reduce NB and
-* determine the minimum value of NB.
-*
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DORGQR', ' ', M, N, K, -1 ) )
- END IF
- END IF
- END IF
-*
- IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-* Use blocked code after the last block.
-* The first kk columns are handled by the block method.
-*
- KI = ( ( K-NX-1 ) / NB )*NB
- KK = MIN( K, KI+NB )
-*
-* Set A(1:kk,kk+1:n) to zero.
-*
- DO 20 J = KK + 1, N
- DO 10 I = 1, KK
- A( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- KK = 0
- END IF
-*
-* Use unblocked code for the last or only block.
-*
- IF( KK.LT.N )
- $ CALL DORG2R( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
- $ TAU( KK+1 ), WORK, IINFO )
-*
- IF( KK.GT.0 ) THEN
-*
-* Use blocked code
-*
- DO 50 I = KI + 1, 1, -NB
- IB = MIN( NB, K-I+1 )
- IF( I+IB.LE.N ) THEN
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB,
- $ A( I, I ), LDA, TAU( I ), WORK, LDWORK )
-*
-* Apply H to A(i:m,i+ib:n) from the left
-*
- CALL DLARFB( 'Left', 'No transpose', 'Forward',
- $ 'Columnwise', M-I+1, N-I-IB+1, IB,
- $ A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
- $ LDA, WORK( IB+1 ), LDWORK )
- END IF
-*
-* Apply H to rows i:m of current block
-*
- CALL DORG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), WORK,
- $ IINFO )
-*
-* Set rows 1:i-1 of current block to zero
-*
- DO 40 J = I, I + IB - 1
- DO 30 L = 1, I - 1
- A( L, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
- 50 CONTINUE
- END IF
-*
- WORK( 1 ) = IWS
- RETURN
-*
-* End of DORGQR
-*
- END
diff --git a/mtx/lapack_src/dorm2r.f b/mtx/lapack_src/dorm2r.f
deleted file mode 100644
index 5a0593541..000000000
--- a/mtx/lapack_src/dorm2r.f
+++ /dev/null
@@ -1,282 +0,0 @@
-*> \brief \b DORM2R
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORM2R + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left
-*> = 'R': apply Q or Q**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply Q (No transpose)
-*> = 'T': apply Q**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DGEQRF in the first k columns of its array argument A.
-*> A is modified by the routine but restored on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGEQRF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (N) if SIDE = 'L',
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, NOTRAN
- INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ
- DOUBLE PRECISION AII
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
-* NQ is the order of Q
-*
- IF( LEFT ) THEN
- NQ = M
- ELSE
- NQ = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORM2R', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
- $ RETURN
-*
- IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )
- $ THEN
- I1 = 1
- I2 = K
- I3 = 1
- ELSE
- I1 = K
- I2 = 1
- I3 = -1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- ELSE
- MI = M
- IC = 1
- END IF
-*
- DO 10 I = I1, I2, I3
- IF( LEFT ) THEN
-*
-* H(i) is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H(i) is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H(i)
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL DLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, JC ),
- $ LDC, WORK )
- A( I, I ) = AII
- 10 CONTINUE
- RETURN
-*
-* End of DORM2R
-*
- END
diff --git a/mtx/lapack_src/dormbr.f b/mtx/lapack_src/dormbr.f
deleted file mode 100644
index 7a0d9b903..000000000
--- a/mtx/lapack_src/dormbr.f
+++ /dev/null
@@ -1,372 +0,0 @@
-*> \brief \b DORMBR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORMBR + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C,
-* LDC, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS, VECT
-* INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] VECT
-*> \verbatim
-*> VECT is CHARACTER*1
-*> = 'Q': apply Q or Q**T;
-*> = 'P': apply P or P**T.
-*> \endverbatim
-*>
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q, Q**T, P or P**T from the Left;
-*> = 'R': apply Q, Q**T, P or P**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q or P;
-*> = 'T': Transpose, apply Q**T or P**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> If VECT = 'Q', the number of columns in the original
-*> matrix reduced by DGEBRD.
-*> If VECT = 'P', the number of rows in the original
-*> matrix reduced by DGEBRD.
-*> K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension
-*> (LDA,min(nq,K)) if VECT = 'Q'
-*> (LDA,nq) if VECT = 'P'
-*> The vectors which define the elementary reflectors H(i) and
-*> G(i), whose products determine the matrices Q and P, as
-*> returned by DGEBRD.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If VECT = 'Q', LDA >= max(1,nq);
-*> if VECT = 'P', LDA >= max(1,min(nq,K)).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (min(nq,K))
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i) or G(i) which determines Q or P, as returned
-*> by DGEBRD in the array argument TAUQ or TAUP.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q
-*> or P*C or P**T*C or C*P or C*P**T.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C,
- $ LDC, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS, VECT
- INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL APPLYQ, LEFT, LQUERY, NOTRAN
- CHARACTER TRANST
- INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NI, NQ, NW
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DORMLQ, DORMQR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- APPLYQ = LSAME( VECT, 'Q' )
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q or P and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = N
- ELSE
- NQ = N
- NW = M
- END IF
- IF( .NOT.APPLYQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -3
- ELSE IF( M.LT.0 ) THEN
- INFO = -4
- ELSE IF( N.LT.0 ) THEN
- INFO = -5
- ELSE IF( K.LT.0 ) THEN
- INFO = -6
- ELSE IF( ( APPLYQ .AND. LDA.LT.MAX( 1, NQ ) ) .OR.
- $ ( .NOT.APPLYQ .AND. LDA.LT.MAX( 1, MIN( NQ, K ) ) ) )
- $ THEN
- INFO = -8
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( APPLYQ ) THEN
- IF( LEFT ) THEN
- NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M-1, N, M-1,
- $ -1 )
- ELSE
- NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N-1, N-1,
- $ -1 )
- END IF
- ELSE
- IF( LEFT ) THEN
- NB = ILAENV( 1, 'DORMLQ', SIDE // TRANS, M-1, N, M-1,
- $ -1 )
- ELSE
- NB = ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N-1, N-1,
- $ -1 )
- END IF
- END IF
- LWKOPT = MAX( 1, NW )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORMBR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- WORK( 1 ) = 1
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
- IF( APPLYQ ) THEN
-*
-* Apply Q
-*
- IF( NQ.GE.K ) THEN
-*
-* Q was determined by a call to DGEBRD with nq >= k
-*
- CALL DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, IINFO )
- ELSE IF( NQ.GT.1 ) THEN
-*
-* Q was determined by a call to DGEBRD with nq < k
-*
- IF( LEFT ) THEN
- MI = M - 1
- NI = N
- I1 = 2
- I2 = 1
- ELSE
- MI = M
- NI = N - 1
- I1 = 1
- I2 = 2
- END IF
- CALL DORMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU,
- $ C( I1, I2 ), LDC, WORK, LWORK, IINFO )
- END IF
- ELSE
-*
-* Apply P
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
- IF( NQ.GT.K ) THEN
-*
-* P was determined by a call to DGEBRD with nq > k
-*
- CALL DORMLQ( SIDE, TRANST, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, IINFO )
- ELSE IF( NQ.GT.1 ) THEN
-*
-* P was determined by a call to DGEBRD with nq <= k
-*
- IF( LEFT ) THEN
- MI = M - 1
- NI = N
- I1 = 2
- I2 = 1
- ELSE
- MI = M
- NI = N - 1
- I1 = 1
- I2 = 2
- END IF
- CALL DORMLQ( SIDE, TRANST, MI, NI, NQ-1, A( 1, 2 ), LDA,
- $ TAU, C( I1, I2 ), LDC, WORK, LWORK, IINFO )
- END IF
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORMBR
-*
- END
diff --git a/mtx/lapack_src/dormhr.f b/mtx/lapack_src/dormhr.f
deleted file mode 100644
index 85bfc41b6..000000000
--- a/mtx/lapack_src/dormhr.f
+++ /dev/null
@@ -1,294 +0,0 @@
-*> \brief \b DORMHR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORMHR + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C,
-* LDC, WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER IHI, ILO, INFO, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*>
-*> ILO and IHI must have the same values as in the previous call
-*> of DGEHRD. Q is equal to the unit matrix except in the
-*> submatrix Q(ilo+1:ihi,ilo+1:ihi).
-*> If SIDE = 'L', then 1 <= ILO <= IHI <= M, if M > 0, and
-*> ILO = 1 and IHI = 0, if M = 0;
-*> if SIDE = 'R', then 1 <= ILO <= IHI <= N, if N > 0, and
-*> ILO = 1 and IHI = 0, if N = 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension
-*> (LDA,M) if SIDE = 'L'
-*> (LDA,N) if SIDE = 'R'
-*> The vectors which define the elementary reflectors, as
-*> returned by DGEHRD.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension
-*> (M-1) if SIDE = 'L'
-*> (N-1) if SIDE = 'R'
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGEHRD.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C,
- $ LDC, WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER IHI, ILO, INFO, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY
- INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NH, NI, NQ, NW
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DORMQR, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- NH = IHI - ILO
- LEFT = LSAME( SIDE, 'L' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = N
- ELSE
- NQ = N
- NW = M
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'T' ) )
- $ THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, NQ ) ) THEN
- INFO = -5
- ELSE IF( IHI.LT.MIN( ILO, NQ ) .OR. IHI.GT.NQ ) THEN
- INFO = -6
- ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
- INFO = -8
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
-*
- IF( INFO.EQ.0 ) THEN
- IF( LEFT ) THEN
- NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, NH, N, NH, -1 )
- ELSE
- NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M, NH, NH, -1 )
- END IF
- LWKOPT = MAX( 1, NW )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORMHR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. NH.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- IF( LEFT ) THEN
- MI = NH
- NI = N
- I1 = ILO + 1
- I2 = 1
- ELSE
- MI = M
- NI = NH
- I1 = 1
- I2 = ILO + 1
- END IF
-*
- CALL DORMQR( SIDE, TRANS, MI, NI, NH, A( ILO+1, ILO ), LDA,
- $ TAU( ILO ), C( I1, I2 ), LDC, WORK, LWORK, IINFO )
-*
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORMHR
-*
- END
diff --git a/mtx/lapack_src/dorml2.f b/mtx/lapack_src/dorml2.f
deleted file mode 100644
index fe85dc3aa..000000000
--- a/mtx/lapack_src/dorml2.f
+++ /dev/null
@@ -1,282 +0,0 @@
-*> \brief \b DORML2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORML2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left
-*> = 'R': apply Q or Q**T from the Right
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': apply Q (No transpose)
-*> = 'T': apply Q**T (Transpose)
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension
-*> (LDA,M) if SIDE = 'L',
-*> (LDA,N) if SIDE = 'R'
-*> The i-th row must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DGELQF in the first k rows of its array argument A.
-*> A is modified by the routine but restored on exit.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,K).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGELQF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the m by n matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension
-*> (N) if SIDE = 'L',
-*> (M) if SIDE = 'R'
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, NOTRAN
- INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ
- DOUBLE PRECISION AII
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARF, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
-*
-* NQ is the order of Q
-*
- IF( LEFT ) THEN
- NQ = M
- ELSE
- NQ = N
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORML2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
- $ RETURN
-*
- IF( ( LEFT .AND. NOTRAN ) .OR. ( .NOT.LEFT .AND. .NOT.NOTRAN ) )
- $ THEN
- I1 = 1
- I2 = K
- I3 = 1
- ELSE
- I1 = K
- I2 = 1
- I3 = -1
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- ELSE
- MI = M
- IC = 1
- END IF
-*
- DO 10 I = I1, I2, I3
- IF( LEFT ) THEN
-*
-* H(i) is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H(i) is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H(i)
-*
- AII = A( I, I )
- A( I, I ) = ONE
- CALL DLARF( SIDE, MI, NI, A( I, I ), LDA, TAU( I ),
- $ C( IC, JC ), LDC, WORK )
- A( I, I ) = AII
- 10 CONTINUE
- RETURN
-*
-* End of DORML2
-*
- END
diff --git a/mtx/lapack_src/dormlq.f b/mtx/lapack_src/dormlq.f
deleted file mode 100644
index ebbd4d26e..000000000
--- a/mtx/lapack_src/dormlq.f
+++ /dev/null
@@ -1,354 +0,0 @@
-*> \brief \b DORMLQ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORMLQ + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension
-*> (LDA,M) if SIDE = 'L',
-*> (LDA,N) if SIDE = 'R'
-*> The i-th row must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DGELQF in the first k rows of its array argument A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,K).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGELQF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NBMAX, LDT
- PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY, NOTRAN
- CHARACTER TRANST
- INTEGER I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
- $ LWKOPT, MI, NB, NBMIN, NI, NQ, NW
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION T( LDT, NBMAX )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFB, DLARFT, DORML2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = N
- ELSE
- NQ = N
- NW = M
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
-*
- IF( INFO.EQ.0 ) THEN
-*
-* Determine the block size. NB may be at most NBMAX, where NBMAX
-* is used to define the local array T.
-*
- NB = MIN( NBMAX, ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N, K,
- $ -1 ) )
- LWKOPT = MAX( 1, NW )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORMLQ', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- LDWORK = NW
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
- IWS = NW*NB
- IF( LWORK.LT.IWS ) THEN
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DORMLQ', SIDE // TRANS, M, N, K,
- $ -1 ) )
- END IF
- ELSE
- IWS = NW
- END IF
-*
- IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-* Use unblocked code
-*
- CALL DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
- $ IINFO )
- ELSE
-*
-* Use blocked code
-*
- IF( ( LEFT .AND. NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN
- I1 = 1
- I2 = K
- I3 = NB
- ELSE
- I1 = ( ( K-1 ) / NB )*NB + 1
- I2 = 1
- I3 = -NB
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- ELSE
- MI = M
- IC = 1
- END IF
-*
- IF( NOTRAN ) THEN
- TRANST = 'T'
- ELSE
- TRANST = 'N'
- END IF
-*
- DO 10 I = I1, I2, I3
- IB = MIN( NB, K-I+1 )
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL DLARFT( 'Forward', 'Rowwise', NQ-I+1, IB, A( I, I ),
- $ LDA, TAU( I ), T, LDT )
- IF( LEFT ) THEN
-*
-* H or H**T is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H or H**T is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H or H**T
-*
- CALL DLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, IB,
- $ A( I, I ), LDA, T, LDT, C( IC, JC ), LDC, WORK,
- $ LDWORK )
- 10 CONTINUE
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORMLQ
-*
- END
diff --git a/mtx/lapack_src/dormqr.f b/mtx/lapack_src/dormqr.f
deleted file mode 100644
index c0767ecf6..000000000
--- a/mtx/lapack_src/dormqr.f
+++ /dev/null
@@ -1,347 +0,0 @@
-*> \brief \b DORMQR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DORMQR + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-* WORK, LWORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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'.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
-*> \endverbatim
-*>
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix C. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix C. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] K
-*> \verbatim
-*> K is INTEGER
-*> The number of elementary reflectors whose product defines
-*> the matrix Q.
-*> If SIDE = 'L', M >= K >= 0;
-*> if SIDE = 'R', N >= K >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DGEQRF in the first k columns of its array argument A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] TAU
-*> \verbatim
-*> TAU is DOUBLE PRECISION array, dimension (K)
-*> TAU(i) must contain the scalar factor of the elementary
-*> reflector H(i), as returned by DGEQRF.
-*> \endverbatim
-*>
-*> \param[in,out] C
-*> \verbatim
-*> C is DOUBLE PRECISION array, dimension (LDC,N)
-*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*> \endverbatim
-*>
-*> \param[in] LDC
-*> \verbatim
-*> LDC is INTEGER
-*> The leading dimension of the array C. LDC >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is INTEGER
-*> The dimension of the array WORK.
-*> If SIDE = 'L', LWORK >= max(1,N);
-*> if SIDE = 'R', LWORK >= max(1,M).
-*> For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
-*> blocksize.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
- $ WORK, LWORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER SIDE, TRANS
- INTEGER INFO, K, LDA, LDC, LWORK, M, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER NBMAX, LDT
- PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- LOGICAL LEFT, LQUERY, NOTRAN
- INTEGER I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
- $ LWKOPT, MI, NB, NBMIN, NI, NQ, NW
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION T( LDT, NBMAX )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DLARFB, DLARFT, DORM2R, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input arguments
-*
- INFO = 0
- LEFT = LSAME( SIDE, 'L' )
- NOTRAN = LSAME( TRANS, 'N' )
- LQUERY = ( LWORK.EQ.-1 )
-*
-* NQ is the order of Q and NW is the minimum dimension of WORK
-*
- IF( LEFT ) THEN
- NQ = M
- NW = N
- ELSE
- NQ = N
- NW = M
- END IF
- IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
- INFO = -2
- ELSE IF( M.LT.0 ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
- INFO = -7
- ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -10
- ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
-*
- IF( INFO.EQ.0 ) THEN
-*
-* Determine the block size. NB may be at most NBMAX, where NBMAX
-* is used to define the local array T.
-*
- NB = MIN( NBMAX, ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N, K,
- $ -1 ) )
- LWKOPT = MAX( 1, NW )*NB
- WORK( 1 ) = LWKOPT
- END IF
-*
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DORMQR', -INFO )
- RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN
- WORK( 1 ) = 1
- RETURN
- END IF
-*
- NBMIN = 2
- LDWORK = NW
- IF( NB.GT.1 .AND. NB.LT.K ) THEN
- IWS = NW*NB
- IF( LWORK.LT.IWS ) THEN
- NB = LWORK / LDWORK
- NBMIN = MAX( 2, ILAENV( 2, 'DORMQR', SIDE // TRANS, M, N, K,
- $ -1 ) )
- END IF
- ELSE
- IWS = NW
- END IF
-*
- IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-* Use unblocked code
-*
- CALL DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
- $ IINFO )
- ELSE
-*
-* Use blocked code
-*
- IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
- $ ( .NOT.LEFT .AND. NOTRAN ) ) THEN
- I1 = 1
- I2 = K
- I3 = NB
- ELSE
- I1 = ( ( K-1 ) / NB )*NB + 1
- I2 = 1
- I3 = -NB
- END IF
-*
- IF( LEFT ) THEN
- NI = N
- JC = 1
- ELSE
- MI = M
- IC = 1
- END IF
-*
- DO 10 I = I1, I2, I3
- IB = MIN( NB, K-I+1 )
-*
-* Form the triangular factor of the block reflector
-* H = H(i) H(i+1) . . . H(i+ib-1)
-*
- CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ),
- $ LDA, TAU( I ), T, LDT )
- IF( LEFT ) THEN
-*
-* H or H**T is applied to C(i:m,1:n)
-*
- MI = M - I + 1
- IC = I
- ELSE
-*
-* H or H**T is applied to C(1:m,i:n)
-*
- NI = N - I + 1
- JC = I
- END IF
-*
-* Apply H or H**T
-*
- CALL DLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI,
- $ IB, A( I, I ), LDA, T, LDT, C( IC, JC ), LDC,
- $ WORK, LDWORK )
- 10 CONTINUE
- END IF
- WORK( 1 ) = LWKOPT
- RETURN
-*
-* End of DORMQR
-*
- END
diff --git a/mtx/lapack_src/drot.f b/mtx/lapack_src/drot.f
deleted file mode 100644
index a02bda37f..000000000
--- a/mtx/lapack_src/drot.f
+++ /dev/null
@@ -1,55 +0,0 @@
- SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S)
-* .. Scalar Arguments ..
- DOUBLE PRECISION C,S
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION DX(*),DY(*)
-* ..
-*
-* Purpose
-* =======
-*
-* DROT applies a plane rotation.
-*
-* Further Details
-* ===============
-*
-* jack dongarra, linpack, 3/11/78.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- DOUBLE PRECISION DTEMP
- INTEGER I,IX,IY
-* ..
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
-*
-* code for both increments equal to 1
-*
- DO I = 1,N
- DTEMP = C*DX(I) + S*DY(I)
- DY(I) = C*DY(I) - S*DX(I)
- DX(I) = DTEMP
- END DO
- ELSE
-*
-* code for unequal increments or equal increments not equal
-* to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO I = 1,N
- DTEMP = C*DX(IX) + S*DY(IY)
- DY(IY) = C*DY(IY) - S*DX(IX)
- DX(IX) = DTEMP
- IX = IX + INCX
- IY = IY + INCY
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/lapack_src/drscl.f b/mtx/lapack_src/drscl.f
deleted file mode 100644
index d850da05c..000000000
--- a/mtx/lapack_src/drscl.f
+++ /dev/null
@@ -1,174 +0,0 @@
-*> \brief \b DRSCL
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DRSCL + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DRSCL( N, SA, SX, INCX )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* DOUBLE PRECISION SA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION SX( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of components of the vector x.
-*> \endverbatim
-*>
-*> \param[in] SA
-*> \verbatim
-*> SA is DOUBLE PRECISION
-*> The scalar a which is used to divide each component of x.
-*> SA must be >= 0, or the subroutine will divide by zero.
-*> \endverbatim
-*>
-*> \param[in,out] SX
-*> \verbatim
-*> SX is DOUBLE PRECISION array, dimension
-*> (1+(N-1)*abs(INCX))
-*> The n-element vector x.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between successive values of the vector SX.
-*> > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE DRSCL( N, SA, SX, INCX )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
- DOUBLE PRECISION SA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION SX( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL DONE
- DOUBLE PRECISION BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.LE.0 )
- $ RETURN
-*
-* Get machine parameters
-*
- SMLNUM = DLAMCH( 'S' )
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
-*
-* Initialize the denominator to SA and the numerator to 1.
-*
- CDEN = SA
- CNUM = ONE
-*
- 10 CONTINUE
- CDEN1 = CDEN*SMLNUM
- CNUM1 = CNUM / BIGNUM
- IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN
-*
-* Pre-multiply X by SMLNUM if CDEN is large compared to CNUM.
-*
- MUL = SMLNUM
- DONE = .FALSE.
- CDEN = CDEN1
- ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN
-*
-* Pre-multiply X by BIGNUM if CDEN is small compared to CNUM.
-*
- MUL = BIGNUM
- DONE = .FALSE.
- CNUM = CNUM1
- ELSE
-*
-* Multiply X by CNUM / CDEN and return.
-*
- MUL = CNUM / CDEN
- DONE = .TRUE.
- END IF
-*
-* Scale the vector X by MUL
-*
- CALL DSCAL( N, MUL, SX, INCX )
-*
- IF( .NOT.DONE )
- $ GO TO 10
-*
- RETURN
-*
-* End of DRSCL
-*
- END
diff --git a/mtx/lapack_src/dtrevc.f b/mtx/lapack_src/dtrevc.f
deleted file mode 100644
index 62e502912..000000000
--- a/mtx/lapack_src/dtrevc.f
+++ /dev/null
@@ -1,1076 +0,0 @@
-*> \brief \b DTREVC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTREVC + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
-* LDVR, MM, M, WORK, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER HOWMNY, SIDE
-* INTEGER INFO, LDT, LDVL, LDVR, M, MM, N
-* ..
-* .. Array Arguments ..
-* LOGICAL SELECT( * )
-* DOUBLE PRECISION T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ),
-* $ WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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**T)*T = w*(y**T)
-*>
-*> where y**T denotes the 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] SIDE
-*> \verbatim
-*> SIDE is CHARACTER*1
-*> = 'R': compute right eigenvectors only;
-*> = 'L': compute left eigenvectors only;
-*> = 'B': compute both right and left eigenvectors.
-*> \endverbatim
-*>
-*> \param[in] HOWMNY
-*> \verbatim
-*> HOWMNY is CHARACTER*1
-*> = 'A': compute all right and/or left eigenvectors;
-*> = 'B': compute all right and/or left eigenvectors,
-*> backtransformed by the matrices in VR and/or VL;
-*> = 'S': compute selected right and/or left eigenvectors,
-*> as indicated by the logical array SELECT.
-*> \endverbatim
-*>
-*> \param[in,out] SELECT
-*> \verbatim
-*> SELECT is LOGICAL array, dimension (N)
-*> If HOWMNY = 'S', SELECT specifies the eigenvectors to be
-*> computed.
-*> If w(j) is a real eigenvalue, the corresponding real
-*> eigenvector is computed if SELECT(j) is .TRUE..
-*> If w(j) and w(j+1) are the real and imaginary parts of a
-*> complex eigenvalue, the corresponding complex eigenvector is
-*> computed if either SELECT(j) or SELECT(j+1) is .TRUE., and
-*> on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to
-*> .FALSE..
-*> Not referenced if HOWMNY = 'A' or 'B'.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,N)
-*> The upper quasi-triangular matrix T in Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] VL
-*> \verbatim
-*> VL is DOUBLE PRECISION array, dimension (LDVL,MM)
-*> On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
-*> contain an N-by-N matrix Q (usually the orthogonal matrix Q
-*> of Schur vectors returned by DHSEQR).
-*> On exit, if SIDE = 'L' or 'B', VL contains:
-*> if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
-*> if HOWMNY = 'B', the matrix Q*Y;
-*> if HOWMNY = 'S', the left eigenvectors of T specified by
-*> SELECT, stored consecutively in the columns
-*> of VL, in the same order as their
-*> eigenvalues.
-*> A complex eigenvector corresponding to a complex eigenvalue
-*> is stored in two consecutive columns, the first holding the
-*> real part, and the second the imaginary part.
-*> Not referenced if SIDE = 'R'.
-*> \endverbatim
-*>
-*> \param[in] LDVL
-*> \verbatim
-*> LDVL is INTEGER
-*> The leading dimension of the array VL. LDVL >= 1, and if
-*> SIDE = 'L' or 'B', LDVL >= N.
-*> \endverbatim
-*>
-*> \param[in,out] VR
-*> \verbatim
-*> VR is DOUBLE PRECISION array, dimension (LDVR,MM)
-*> On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
-*> contain an N-by-N matrix Q (usually the orthogonal matrix Q
-*> of Schur vectors returned by DHSEQR).
-*> On exit, if SIDE = 'R' or 'B', VR contains:
-*> if HOWMNY = 'A', the matrix X of right eigenvectors of T;
-*> if HOWMNY = 'B', the matrix Q*X;
-*> if HOWMNY = 'S', the right eigenvectors of T specified by
-*> SELECT, stored consecutively in the columns
-*> of VR, in the same order as their
-*> eigenvalues.
-*> A complex eigenvector corresponding to a complex eigenvalue
-*> is stored in two consecutive columns, the first holding the
-*> real part and the second the imaginary part.
-*> Not referenced if SIDE = 'L'.
-*> \endverbatim
-*>
-*> \param[in] LDVR
-*> \verbatim
-*> LDVR is INTEGER
-*> The leading dimension of the array VR. LDVR >= 1, and if
-*> SIDE = 'R' or 'B', LDVR >= N.
-*> \endverbatim
-*>
-*> \param[in] MM
-*> \verbatim
-*> MM is INTEGER
-*> The number of columns in the arrays VL and/or VR. MM >= M.
-*> \endverbatim
-*>
-*> \param[out] M
-*> \verbatim
-*> M is INTEGER
-*> The number of columns in the arrays VL and/or VR actually
-*> used to store the eigenvectors.
-*> If HOWMNY = 'A' or 'B', M is set to N.
-*> Each selected real eigenvector occupies one column and each
-*> selected complex eigenvector occupies two columns.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (3*N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The algorithm used in this program is basically backward (forward)
-*> substitution, with scaling to make the the code robust against
-*> possible overflow.
-*>
-*> Each eigenvector is normalized so that the element of largest
-*> magnitude has magnitude 1; here the magnitude of a complex number
-*> (x,y) is taken to be |x| + |y|.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
- $ LDVR, MM, M, WORK, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER HOWMNY, SIDE
- INTEGER INFO, LDT, LDVL, LDVR, M, MM, N
-* ..
-* .. Array Arguments ..
- LOGICAL SELECT( * )
- DOUBLE PRECISION T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ),
- $ WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL ALLV, BOTHV, LEFTV, OVER, PAIR, RIGHTV, SOMEV
- INTEGER I, IERR, II, IP, IS, J, J1, J2, JNXT, K, KI, N2
- DOUBLE PRECISION BETA, BIGNUM, EMAX, OVFL, REC, REMAX, SCALE,
- $ SMIN, SMLNUM, ULP, UNFL, VCRIT, VMAX, WI, WR,
- $ XNORM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER IDAMAX
- DOUBLE PRECISION DDOT, DLAMCH
- EXTERNAL LSAME, IDAMAX, DDOT, DLAMCH
-* ..
-* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGEMV, DLALN2, DSCAL, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, SQRT
-* ..
-* .. Local Arrays ..
- DOUBLE PRECISION X( 2, 2 )
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input parameters
-*
- BOTHV = LSAME( SIDE, 'B' )
- RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV
- LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV
-*
- ALLV = LSAME( HOWMNY, 'A' )
- OVER = LSAME( HOWMNY, 'B' )
- SOMEV = LSAME( HOWMNY, 'S' )
-*
- INFO = 0
- IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
- INFO = -1
- ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
- INFO = -6
- ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN
- INFO = -8
- ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN
- INFO = -10
- ELSE
-*
-* Set M to the number of columns required to store the selected
-* eigenvectors, standardize the array SELECT if necessary, and
-* test MM.
-*
- IF( SOMEV ) THEN
- M = 0
- PAIR = .FALSE.
- DO 10 J = 1, N
- IF( PAIR ) THEN
- PAIR = .FALSE.
- SELECT( J ) = .FALSE.
- ELSE
- IF( J.LT.N ) THEN
- IF( T( J+1, J ).EQ.ZERO ) THEN
- IF( SELECT( J ) )
- $ M = M + 1
- ELSE
- PAIR = .TRUE.
- IF( SELECT( J ) .OR. SELECT( J+1 ) ) THEN
- SELECT( J ) = .TRUE.
- M = M + 2
- END IF
- END IF
- ELSE
- IF( SELECT( N ) )
- $ M = M + 1
- END IF
- END IF
- 10 CONTINUE
- ELSE
- M = N
- END IF
-*
- IF( MM.LT.M ) THEN
- INFO = -11
- END IF
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTREVC', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Set the constants to control overflow.
-*
- UNFL = DLAMCH( 'Safe minimum' )
- OVFL = ONE / UNFL
- CALL DLABAD( UNFL, OVFL )
- ULP = DLAMCH( 'Precision' )
- SMLNUM = UNFL*( N / ULP )
- BIGNUM = ( ONE-ULP ) / SMLNUM
-*
-* Compute 1-norm of each column of strictly upper triangular
-* part of T to control overflow in triangular solver.
-*
- WORK( 1 ) = ZERO
- DO 30 J = 2, N
- WORK( J ) = ZERO
- DO 20 I = 1, J - 1
- WORK( J ) = WORK( J ) + ABS( T( I, J ) )
- 20 CONTINUE
- 30 CONTINUE
-*
-* Index IP is used to specify the real or complex eigenvalue:
-* IP = 0, real eigenvalue,
-* 1, first of conjugate complex pair: (wr,wi)
-* -1, second of conjugate complex pair: (wr,wi)
-*
- N2 = 2*N
-*
- IF( RIGHTV ) THEN
-*
-* Compute right eigenvectors.
-*
- IP = 0
- IS = M
- DO 140 KI = N, 1, -1
-*
- IF( IP.EQ.1 )
- $ GO TO 130
- IF( KI.EQ.1 )
- $ GO TO 40
- IF( T( KI, KI-1 ).EQ.ZERO )
- $ GO TO 40
- IP = -1
-*
- 40 CONTINUE
- IF( SOMEV ) THEN
- IF( IP.EQ.0 ) THEN
- IF( .NOT.SELECT( KI ) )
- $ GO TO 130
- ELSE
- IF( .NOT.SELECT( KI-1 ) )
- $ GO TO 130
- END IF
- END IF
-*
-* Compute the KI-th eigenvalue (WR,WI).
-*
- WR = T( KI, KI )
- WI = ZERO
- IF( IP.NE.0 )
- $ WI = SQRT( ABS( T( KI, KI-1 ) ) )*
- $ SQRT( ABS( T( KI-1, KI ) ) )
- SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM )
-*
- IF( IP.EQ.0 ) THEN
-*
-* Real right eigenvector
-*
- WORK( KI+N ) = ONE
-*
-* Form right-hand side
-*
- DO 50 K = 1, KI - 1
- WORK( K+N ) = -T( K, KI )
- 50 CONTINUE
-*
-* Solve the upper quasi-triangular system:
-* (T(1:KI-1,1:KI-1) - WR)*X = SCALE*WORK.
-*
- JNXT = KI - 1
- DO 60 J = KI - 1, 1, -1
- IF( J.GT.JNXT )
- $ GO TO 60
- J1 = J
- J2 = J
- JNXT = J - 1
- IF( J.GT.1 ) THEN
- IF( T( J, J-1 ).NE.ZERO ) THEN
- J1 = J - 1
- JNXT = J - 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1-by-1 diagonal block
-*
- CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR,
- $ ZERO, X, 2, SCALE, XNORM, IERR )
-*
-* Scale X(1,1) to avoid overflow when updating
-* the right-hand side.
-*
- IF( XNORM.GT.ONE ) THEN
- IF( WORK( J ).GT.BIGNUM / XNORM ) THEN
- X( 1, 1 ) = X( 1, 1 ) / XNORM
- SCALE = SCALE / XNORM
- END IF
- END IF
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE )
- $ CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
- WORK( J+N ) = X( 1, 1 )
-*
-* Update right-hand side
-*
- CALL DAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1,
- $ WORK( 1+N ), 1 )
-*
- ELSE
-*
-* 2-by-2 diagonal block
-*
- CALL DLALN2( .FALSE., 2, 1, SMIN, ONE,
- $ T( J-1, J-1 ), LDT, ONE, ONE,
- $ WORK( J-1+N ), N, WR, ZERO, X, 2,
- $ SCALE, XNORM, IERR )
-*
-* Scale X(1,1) and X(2,1) to avoid overflow when
-* updating the right-hand side.
-*
- IF( XNORM.GT.ONE ) THEN
- BETA = MAX( WORK( J-1 ), WORK( J ) )
- IF( BETA.GT.BIGNUM / XNORM ) THEN
- X( 1, 1 ) = X( 1, 1 ) / XNORM
- X( 2, 1 ) = X( 2, 1 ) / XNORM
- SCALE = SCALE / XNORM
- END IF
- END IF
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE )
- $ CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
- WORK( J-1+N ) = X( 1, 1 )
- WORK( J+N ) = X( 2, 1 )
-*
-* Update right-hand side
-*
- CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1,
- $ WORK( 1+N ), 1 )
- CALL DAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1,
- $ WORK( 1+N ), 1 )
- END IF
- 60 CONTINUE
-*
-* Copy the vector x or Q*x to VR and normalize.
-*
- IF( .NOT.OVER ) THEN
- CALL DCOPY( KI, WORK( 1+N ), 1, VR( 1, IS ), 1 )
-*
- II = IDAMAX( KI, VR( 1, IS ), 1 )
- REMAX = ONE / ABS( VR( II, IS ) )
- CALL DSCAL( KI, REMAX, VR( 1, IS ), 1 )
-*
- DO 70 K = KI + 1, N
- VR( K, IS ) = ZERO
- 70 CONTINUE
- ELSE
- IF( KI.GT.1 )
- $ CALL DGEMV( 'N', N, KI-1, ONE, VR, LDVR,
- $ WORK( 1+N ), 1, WORK( KI+N ),
- $ VR( 1, KI ), 1 )
-*
- II = IDAMAX( N, VR( 1, KI ), 1 )
- REMAX = ONE / ABS( VR( II, KI ) )
- CALL DSCAL( N, REMAX, VR( 1, KI ), 1 )
- END IF
-*
- ELSE
-*
-* Complex right eigenvector.
-*
-* Initial solve
-* [ (T(KI-1,KI-1) T(KI-1,KI) ) - (WR + I* WI)]*X = 0.
-* [ (T(KI,KI-1) T(KI,KI) ) ]
-*
- IF( ABS( T( KI-1, KI ) ).GE.ABS( T( KI, KI-1 ) ) ) THEN
- WORK( KI-1+N ) = ONE
- WORK( KI+N2 ) = WI / T( KI-1, KI )
- ELSE
- WORK( KI-1+N ) = -WI / T( KI, KI-1 )
- WORK( KI+N2 ) = ONE
- END IF
- WORK( KI+N ) = ZERO
- WORK( KI-1+N2 ) = ZERO
-*
-* Form right-hand side
-*
- DO 80 K = 1, KI - 2
- WORK( K+N ) = -WORK( KI-1+N )*T( K, KI-1 )
- WORK( K+N2 ) = -WORK( KI+N2 )*T( K, KI )
- 80 CONTINUE
-*
-* Solve upper quasi-triangular system:
-* (T(1:KI-2,1:KI-2) - (WR+i*WI))*X = SCALE*(WORK+i*WORK2)
-*
- JNXT = KI - 2
- DO 90 J = KI - 2, 1, -1
- IF( J.GT.JNXT )
- $ GO TO 90
- J1 = J
- J2 = J
- JNXT = J - 1
- IF( J.GT.1 ) THEN
- IF( T( J, J-1 ).NE.ZERO ) THEN
- J1 = J - 1
- JNXT = J - 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1-by-1 diagonal block
-*
- CALL DLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR, WI,
- $ X, 2, SCALE, XNORM, IERR )
-*
-* Scale X(1,1) and X(1,2) to avoid overflow when
-* updating the right-hand side.
-*
- IF( XNORM.GT.ONE ) THEN
- IF( WORK( J ).GT.BIGNUM / XNORM ) THEN
- X( 1, 1 ) = X( 1, 1 ) / XNORM
- X( 1, 2 ) = X( 1, 2 ) / XNORM
- SCALE = SCALE / XNORM
- END IF
- END IF
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE ) THEN
- CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
- CALL DSCAL( KI, SCALE, WORK( 1+N2 ), 1 )
- END IF
- WORK( J+N ) = X( 1, 1 )
- WORK( J+N2 ) = X( 1, 2 )
-*
-* Update the right-hand side
-*
- CALL DAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1,
- $ WORK( 1+N ), 1 )
- CALL DAXPY( J-1, -X( 1, 2 ), T( 1, J ), 1,
- $ WORK( 1+N2 ), 1 )
-*
- ELSE
-*
-* 2-by-2 diagonal block
-*
- CALL DLALN2( .FALSE., 2, 2, SMIN, ONE,
- $ T( J-1, J-1 ), LDT, ONE, ONE,
- $ WORK( J-1+N ), N, WR, WI, X, 2, SCALE,
- $ XNORM, IERR )
-*
-* Scale X to avoid overflow when updating
-* the right-hand side.
-*
- IF( XNORM.GT.ONE ) THEN
- BETA = MAX( WORK( J-1 ), WORK( J ) )
- IF( BETA.GT.BIGNUM / XNORM ) THEN
- REC = ONE / XNORM
- X( 1, 1 ) = X( 1, 1 )*REC
- X( 1, 2 ) = X( 1, 2 )*REC
- X( 2, 1 ) = X( 2, 1 )*REC
- X( 2, 2 ) = X( 2, 2 )*REC
- SCALE = SCALE*REC
- END IF
- END IF
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE ) THEN
- CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
- CALL DSCAL( KI, SCALE, WORK( 1+N2 ), 1 )
- END IF
- WORK( J-1+N ) = X( 1, 1 )
- WORK( J+N ) = X( 2, 1 )
- WORK( J-1+N2 ) = X( 1, 2 )
- WORK( J+N2 ) = X( 2, 2 )
-*
-* Update the right-hand side
-*
- CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1,
- $ WORK( 1+N ), 1 )
- CALL DAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1,
- $ WORK( 1+N ), 1 )
- CALL DAXPY( J-2, -X( 1, 2 ), T( 1, J-1 ), 1,
- $ WORK( 1+N2 ), 1 )
- CALL DAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1,
- $ WORK( 1+N2 ), 1 )
- END IF
- 90 CONTINUE
-*
-* Copy the vector x or Q*x to VR and normalize.
-*
- IF( .NOT.OVER ) THEN
- CALL DCOPY( KI, WORK( 1+N ), 1, VR( 1, IS-1 ), 1 )
- CALL DCOPY( KI, WORK( 1+N2 ), 1, VR( 1, IS ), 1 )
-*
- EMAX = ZERO
- DO 100 K = 1, KI
- EMAX = MAX( EMAX, ABS( VR( K, IS-1 ) )+
- $ ABS( VR( K, IS ) ) )
- 100 CONTINUE
-*
- REMAX = ONE / EMAX
- CALL DSCAL( KI, REMAX, VR( 1, IS-1 ), 1 )
- CALL DSCAL( KI, REMAX, VR( 1, IS ), 1 )
-*
- DO 110 K = KI + 1, N
- VR( K, IS-1 ) = ZERO
- VR( K, IS ) = ZERO
- 110 CONTINUE
-*
- ELSE
-*
- IF( KI.GT.2 ) THEN
- CALL DGEMV( 'N', N, KI-2, ONE, VR, LDVR,
- $ WORK( 1+N ), 1, WORK( KI-1+N ),
- $ VR( 1, KI-1 ), 1 )
- CALL DGEMV( 'N', N, KI-2, ONE, VR, LDVR,
- $ WORK( 1+N2 ), 1, WORK( KI+N2 ),
- $ VR( 1, KI ), 1 )
- ELSE
- CALL DSCAL( N, WORK( KI-1+N ), VR( 1, KI-1 ), 1 )
- CALL DSCAL( N, WORK( KI+N2 ), VR( 1, KI ), 1 )
- END IF
-*
- EMAX = ZERO
- DO 120 K = 1, N
- EMAX = MAX( EMAX, ABS( VR( K, KI-1 ) )+
- $ ABS( VR( K, KI ) ) )
- 120 CONTINUE
- REMAX = ONE / EMAX
- CALL DSCAL( N, REMAX, VR( 1, KI-1 ), 1 )
- CALL DSCAL( N, REMAX, VR( 1, KI ), 1 )
- END IF
- END IF
-*
- IS = IS - 1
- IF( IP.NE.0 )
- $ IS = IS - 1
- 130 CONTINUE
- IF( IP.EQ.1 )
- $ IP = 0
- IF( IP.EQ.-1 )
- $ IP = 1
- 140 CONTINUE
- END IF
-*
- IF( LEFTV ) THEN
-*
-* Compute left eigenvectors.
-*
- IP = 0
- IS = 1
- DO 260 KI = 1, N
-*
- IF( IP.EQ.-1 )
- $ GO TO 250
- IF( KI.EQ.N )
- $ GO TO 150
- IF( T( KI+1, KI ).EQ.ZERO )
- $ GO TO 150
- IP = 1
-*
- 150 CONTINUE
- IF( SOMEV ) THEN
- IF( .NOT.SELECT( KI ) )
- $ GO TO 250
- END IF
-*
-* Compute the KI-th eigenvalue (WR,WI).
-*
- WR = T( KI, KI )
- WI = ZERO
- IF( IP.NE.0 )
- $ WI = SQRT( ABS( T( KI, KI+1 ) ) )*
- $ SQRT( ABS( T( KI+1, KI ) ) )
- SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM )
-*
- IF( IP.EQ.0 ) THEN
-*
-* Real left eigenvector.
-*
- WORK( KI+N ) = ONE
-*
-* Form right-hand side
-*
- DO 160 K = KI + 1, N
- WORK( K+N ) = -T( KI, K )
- 160 CONTINUE
-*
-* Solve the quasi-triangular system:
-* (T(KI+1:N,KI+1:N) - WR)**T*X = SCALE*WORK
-*
- VMAX = ONE
- VCRIT = BIGNUM
-*
- JNXT = KI + 1
- DO 170 J = KI + 1, N
- IF( J.LT.JNXT )
- $ GO TO 170
- J1 = J
- J2 = J
- JNXT = J + 1
- IF( J.LT.N ) THEN
- IF( T( J+1, J ).NE.ZERO ) THEN
- J2 = J + 1
- JNXT = J + 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1-by-1 diagonal block
-*
-* Scale if necessary to avoid overflow when forming
-* the right-hand side.
-*
- IF( WORK( J ).GT.VCRIT ) THEN
- REC = ONE / VMAX
- CALL DSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
-*
- WORK( J+N ) = WORK( J+N ) -
- $ DDOT( J-KI-1, T( KI+1, J ), 1,
- $ WORK( KI+1+N ), 1 )
-*
-* Solve (T(J,J)-WR)**T*X = WORK
-*
- CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR,
- $ ZERO, X, 2, SCALE, XNORM, IERR )
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE )
- $ CALL DSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
- WORK( J+N ) = X( 1, 1 )
- VMAX = MAX( ABS( WORK( J+N ) ), VMAX )
- VCRIT = BIGNUM / VMAX
-*
- ELSE
-*
-* 2-by-2 diagonal block
-*
-* Scale if necessary to avoid overflow when forming
-* the right-hand side.
-*
- BETA = MAX( WORK( J ), WORK( J+1 ) )
- IF( BETA.GT.VCRIT ) THEN
- REC = ONE / VMAX
- CALL DSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
-*
- WORK( J+N ) = WORK( J+N ) -
- $ DDOT( J-KI-1, T( KI+1, J ), 1,
- $ WORK( KI+1+N ), 1 )
-*
- WORK( J+1+N ) = WORK( J+1+N ) -
- $ DDOT( J-KI-1, T( KI+1, J+1 ), 1,
- $ WORK( KI+1+N ), 1 )
-*
-* Solve
-* [T(J,J)-WR T(J,J+1) ]**T * X = SCALE*( WORK1 )
-* [T(J+1,J) T(J+1,J+1)-WR] ( WORK2 )
-*
- CALL DLALN2( .TRUE., 2, 1, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR,
- $ ZERO, X, 2, SCALE, XNORM, IERR )
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE )
- $ CALL DSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
- WORK( J+N ) = X( 1, 1 )
- WORK( J+1+N ) = X( 2, 1 )
-*
- VMAX = MAX( ABS( WORK( J+N ) ),
- $ ABS( WORK( J+1+N ) ), VMAX )
- VCRIT = BIGNUM / VMAX
-*
- END IF
- 170 CONTINUE
-*
-* Copy the vector x or Q*x to VL and normalize.
-*
- IF( .NOT.OVER ) THEN
- CALL DCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), 1 )
-*
- II = IDAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1
- REMAX = ONE / ABS( VL( II, IS ) )
- CALL DSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 )
-*
- DO 180 K = 1, KI - 1
- VL( K, IS ) = ZERO
- 180 CONTINUE
-*
- ELSE
-*
- IF( KI.LT.N )
- $ CALL DGEMV( 'N', N, N-KI, ONE, VL( 1, KI+1 ), LDVL,
- $ WORK( KI+1+N ), 1, WORK( KI+N ),
- $ VL( 1, KI ), 1 )
-*
- II = IDAMAX( N, VL( 1, KI ), 1 )
- REMAX = ONE / ABS( VL( II, KI ) )
- CALL DSCAL( N, REMAX, VL( 1, KI ), 1 )
-*
- END IF
-*
- ELSE
-*
-* Complex left eigenvector.
-*
-* Initial solve:
-* ((T(KI,KI) T(KI,KI+1) )**T - (WR - I* WI))*X = 0.
-* ((T(KI+1,KI) T(KI+1,KI+1)) )
-*
- IF( ABS( T( KI, KI+1 ) ).GE.ABS( T( KI+1, KI ) ) ) THEN
- WORK( KI+N ) = WI / T( KI, KI+1 )
- WORK( KI+1+N2 ) = ONE
- ELSE
- WORK( KI+N ) = ONE
- WORK( KI+1+N2 ) = -WI / T( KI+1, KI )
- END IF
- WORK( KI+1+N ) = ZERO
- WORK( KI+N2 ) = ZERO
-*
-* Form right-hand side
-*
- DO 190 K = KI + 2, N
- WORK( K+N ) = -WORK( KI+N )*T( KI, K )
- WORK( K+N2 ) = -WORK( KI+1+N2 )*T( KI+1, K )
- 190 CONTINUE
-*
-* Solve complex quasi-triangular system:
-* ( T(KI+2,N:KI+2,N) - (WR-i*WI) )*X = WORK1+i*WORK2
-*
- VMAX = ONE
- VCRIT = BIGNUM
-*
- JNXT = KI + 2
- DO 200 J = KI + 2, N
- IF( J.LT.JNXT )
- $ GO TO 200
- J1 = J
- J2 = J
- JNXT = J + 1
- IF( J.LT.N ) THEN
- IF( T( J+1, J ).NE.ZERO ) THEN
- J2 = J + 1
- JNXT = J + 2
- END IF
- END IF
-*
- IF( J1.EQ.J2 ) THEN
-*
-* 1-by-1 diagonal block
-*
-* Scale if necessary to avoid overflow when
-* forming the right-hand side elements.
-*
- IF( WORK( J ).GT.VCRIT ) THEN
- REC = ONE / VMAX
- CALL DSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
- CALL DSCAL( N-KI+1, REC, WORK( KI+N2 ), 1 )
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
-*
- WORK( J+N ) = WORK( J+N ) -
- $ DDOT( J-KI-2, T( KI+2, J ), 1,
- $ WORK( KI+2+N ), 1 )
- WORK( J+N2 ) = WORK( J+N2 ) -
- $ DDOT( J-KI-2, T( KI+2, J ), 1,
- $ WORK( KI+2+N2 ), 1 )
-*
-* Solve (T(J,J)-(WR-i*WI))*(X11+i*X12)= WK+I*WK2
-*
- CALL DLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR,
- $ -WI, X, 2, SCALE, XNORM, IERR )
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE ) THEN
- CALL DSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
- CALL DSCAL( N-KI+1, SCALE, WORK( KI+N2 ), 1 )
- END IF
- WORK( J+N ) = X( 1, 1 )
- WORK( J+N2 ) = X( 1, 2 )
- VMAX = MAX( ABS( WORK( J+N ) ),
- $ ABS( WORK( J+N2 ) ), VMAX )
- VCRIT = BIGNUM / VMAX
-*
- ELSE
-*
-* 2-by-2 diagonal block
-*
-* Scale if necessary to avoid overflow when forming
-* the right-hand side elements.
-*
- BETA = MAX( WORK( J ), WORK( J+1 ) )
- IF( BETA.GT.VCRIT ) THEN
- REC = ONE / VMAX
- CALL DSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
- CALL DSCAL( N-KI+1, REC, WORK( KI+N2 ), 1 )
- VMAX = ONE
- VCRIT = BIGNUM
- END IF
-*
- WORK( J+N ) = WORK( J+N ) -
- $ DDOT( J-KI-2, T( KI+2, J ), 1,
- $ WORK( KI+2+N ), 1 )
-*
- WORK( J+N2 ) = WORK( J+N2 ) -
- $ DDOT( J-KI-2, T( KI+2, J ), 1,
- $ WORK( KI+2+N2 ), 1 )
-*
- WORK( J+1+N ) = WORK( J+1+N ) -
- $ DDOT( J-KI-2, T( KI+2, J+1 ), 1,
- $ WORK( KI+2+N ), 1 )
-*
- WORK( J+1+N2 ) = WORK( J+1+N2 ) -
- $ DDOT( J-KI-2, T( KI+2, J+1 ), 1,
- $ WORK( KI+2+N2 ), 1 )
-*
-* Solve 2-by-2 complex linear equation
-* ([T(j,j) T(j,j+1) ]**T-(wr-i*wi)*I)*X = SCALE*B
-* ([T(j+1,j) T(j+1,j+1)] )
-*
- CALL DLALN2( .TRUE., 2, 2, SMIN, ONE, T( J, J ),
- $ LDT, ONE, ONE, WORK( J+N ), N, WR,
- $ -WI, X, 2, SCALE, XNORM, IERR )
-*
-* Scale if necessary
-*
- IF( SCALE.NE.ONE ) THEN
- CALL DSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
- CALL DSCAL( N-KI+1, SCALE, WORK( KI+N2 ), 1 )
- END IF
- WORK( J+N ) = X( 1, 1 )
- WORK( J+N2 ) = X( 1, 2 )
- WORK( J+1+N ) = X( 2, 1 )
- WORK( J+1+N2 ) = X( 2, 2 )
- VMAX = MAX( ABS( X( 1, 1 ) ), ABS( X( 1, 2 ) ),
- $ ABS( X( 2, 1 ) ), ABS( X( 2, 2 ) ), VMAX )
- VCRIT = BIGNUM / VMAX
-*
- END IF
- 200 CONTINUE
-*
-* Copy the vector x or Q*x to VL and normalize.
-*
- IF( .NOT.OVER ) THEN
- CALL DCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), 1 )
- CALL DCOPY( N-KI+1, WORK( KI+N2 ), 1, VL( KI, IS+1 ),
- $ 1 )
-*
- EMAX = ZERO
- DO 220 K = KI, N
- EMAX = MAX( EMAX, ABS( VL( K, IS ) )+
- $ ABS( VL( K, IS+1 ) ) )
- 220 CONTINUE
- REMAX = ONE / EMAX
- CALL DSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 )
- CALL DSCAL( N-KI+1, REMAX, VL( KI, IS+1 ), 1 )
-*
- DO 230 K = 1, KI - 1
- VL( K, IS ) = ZERO
- VL( K, IS+1 ) = ZERO
- 230 CONTINUE
- ELSE
- IF( KI.LT.N-1 ) THEN
- CALL DGEMV( 'N', N, N-KI-1, ONE, VL( 1, KI+2 ),
- $ LDVL, WORK( KI+2+N ), 1, WORK( KI+N ),
- $ VL( 1, KI ), 1 )
- CALL DGEMV( 'N', N, N-KI-1, ONE, VL( 1, KI+2 ),
- $ LDVL, WORK( KI+2+N2 ), 1,
- $ WORK( KI+1+N2 ), VL( 1, KI+1 ), 1 )
- ELSE
- CALL DSCAL( N, WORK( KI+N ), VL( 1, KI ), 1 )
- CALL DSCAL( N, WORK( KI+1+N2 ), VL( 1, KI+1 ), 1 )
- END IF
-*
- EMAX = ZERO
- DO 240 K = 1, N
- EMAX = MAX( EMAX, ABS( VL( K, KI ) )+
- $ ABS( VL( K, KI+1 ) ) )
- 240 CONTINUE
- REMAX = ONE / EMAX
- CALL DSCAL( N, REMAX, VL( 1, KI ), 1 )
- CALL DSCAL( N, REMAX, VL( 1, KI+1 ), 1 )
-*
- END IF
-*
- END IF
-*
- IS = IS + 1
- IF( IP.NE.0 )
- $ IS = IS + 1
- 250 CONTINUE
- IF( IP.EQ.-1 )
- $ IP = 0
- IF( IP.EQ.1 )
- $ IP = -1
-*
- 260 CONTINUE
-*
- END IF
-*
- RETURN
-*
-* End of DTREVC
-*
- END
diff --git a/mtx/lapack_src/dtrexc.f b/mtx/lapack_src/dtrexc.f
deleted file mode 100644
index 4ac8d9d59..000000000
--- a/mtx/lapack_src/dtrexc.f
+++ /dev/null
@@ -1,426 +0,0 @@
-*> \brief \b DTREXC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTREXC + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER COMPQ
-* INTEGER IFST, ILST, INFO, LDQ, LDT, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WORK( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] COMPQ
-*> \verbatim
-*> COMPQ is CHARACTER*1
-*> = 'V': update the matrix Q of Schur vectors;
-*> = 'N': do not update Q.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix T. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] T
-*> \verbatim
-*> T is DOUBLE PRECISION array, dimension (LDT,N)
-*> On entry, the upper quasi-triangular matrix T, in Schur
-*> Schur canonical form.
-*> On exit, the reordered upper quasi-triangular matrix, again
-*> in Schur canonical form.
-*> \endverbatim
-*>
-*> \param[in] LDT
-*> \verbatim
-*> LDT is INTEGER
-*> The leading dimension of the array T. LDT >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] Q
-*> \verbatim
-*> Q is DOUBLE PRECISION array, dimension (LDQ,N)
-*> On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
-*> On exit, if COMPQ = 'V', Q has been postmultiplied by the
-*> orthogonal transformation matrix Z which reorders T.
-*> If COMPQ = 'N', Q is not referenced.
-*> \endverbatim
-*>
-*> \param[in] LDQ
-*> \verbatim
-*> LDQ is INTEGER
-*> The leading dimension of the array Q. LDQ >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] IFST
-*> \verbatim
-*> IFST is INTEGER
-*> \endverbatim
-*>
-*> \param[in,out] ILST
-*> \verbatim
-*> ILST is INTEGER
-*>
-*> Specify the reordering of the diagonal blocks of T.
-*> The block with row index IFST is moved to row ILST, by a
-*> sequence of transpositions between adjacent blocks.
-*> On exit, if IFST pointed on entry to the second row of a
-*> 2-by-2 block, it is changed to point to the first row; ILST
-*> always points to the first row of the block in its final
-*> position (which may differ from its input value by +1 or -1).
-*> 1 <= IFST <= N; 1 <= ILST <= N.
-*> \endverbatim
-*>
-*> \param[out] WORK
-*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N)
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> = 1: two adjacent blocks were too close to swap (the problem
-*> is very ill-conditioned); T may have been partially
-*> reordered, and ILST points to the first row of the
-*> current position of the block being moved.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER COMPQ
- INTEGER IFST, ILST, INFO, LDQ, LDT, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WORK( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL WANTQ
- INTEGER HERE, NBF, NBL, NBNEXT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DLAEXC, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Decode and test the input arguments.
-*
- INFO = 0
- WANTQ = LSAME( COMPQ, 'V' )
- IF( .NOT.WANTQ .AND. .NOT.LSAME( COMPQ, 'N' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.MAX( 1, N ) ) ) THEN
- INFO = -6
- ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
- INFO = -7
- ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTREXC', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.LE.1 )
- $ RETURN
-*
-* Determine the first row of specified block
-* and find out it is 1 by 1 or 2 by 2.
-*
- IF( IFST.GT.1 ) THEN
- IF( T( IFST, IFST-1 ).NE.ZERO )
- $ IFST = IFST - 1
- END IF
- NBF = 1
- IF( IFST.LT.N ) THEN
- IF( T( IFST+1, IFST ).NE.ZERO )
- $ NBF = 2
- END IF
-*
-* Determine the first row of the final block
-* and find out it is 1 by 1 or 2 by 2.
-*
- IF( ILST.GT.1 ) THEN
- IF( T( ILST, ILST-1 ).NE.ZERO )
- $ ILST = ILST - 1
- END IF
- NBL = 1
- IF( ILST.LT.N ) THEN
- IF( T( ILST+1, ILST ).NE.ZERO )
- $ NBL = 2
- END IF
-*
- IF( IFST.EQ.ILST )
- $ RETURN
-*
- IF( IFST.LT.ILST ) THEN
-*
-* Update ILST
-*
- IF( NBF.EQ.2 .AND. NBL.EQ.1 )
- $ ILST = ILST - 1
- IF( NBF.EQ.1 .AND. NBL.EQ.2 )
- $ ILST = ILST + 1
-*
- HERE = IFST
-*
- 10 CONTINUE
-*
-* Swap block with next one below
-*
- IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
-*
-* Current block either 1 by 1 or 2 by 2
-*
- NBNEXT = 1
- IF( HERE+NBF+1.LE.N ) THEN
- IF( T( HERE+NBF+1, HERE+NBF ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, NBF, NBNEXT,
- $ WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + NBNEXT
-*
-* Test if 2 by 2 block breaks into two 1 by 1 blocks
-*
- IF( NBF.EQ.2 ) THEN
- IF( T( HERE+1, HERE ).EQ.ZERO )
- $ NBF = 3
- END IF
-*
- ELSE
-*
-* Current block consists of two 1 by 1 blocks each of which
-* must be swapped individually
-*
- NBNEXT = 1
- IF( HERE+3.LE.N ) THEN
- IF( T( HERE+3, HERE+2 ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE+1, 1, NBNEXT,
- $ WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- IF( NBNEXT.EQ.1 ) THEN
-*
-* Swap two 1 by 1 blocks, no problems possible
-*
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, NBNEXT,
- $ WORK, INFO )
- HERE = HERE + 1
- ELSE
-*
-* Recompute NBNEXT in case 2 by 2 split
-*
- IF( T( HERE+2, HERE+1 ).EQ.ZERO )
- $ NBNEXT = 1
- IF( NBNEXT.EQ.2 ) THEN
-*
-* 2 by 2 Block did not split
-*
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1,
- $ NBNEXT, WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE + 2
- ELSE
-*
-* 2 by 2 Block did split
-*
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, 1,
- $ WORK, INFO )
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE+1, 1, 1,
- $ WORK, INFO )
- HERE = HERE + 2
- END IF
- END IF
- END IF
- IF( HERE.LT.ILST )
- $ GO TO 10
-*
- ELSE
-*
- HERE = IFST
- 20 CONTINUE
-*
-* Swap block with next one above
-*
- IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
-*
-* Current block either 1 by 1 or 2 by 2
-*
- NBNEXT = 1
- IF( HERE.GE.3 ) THEN
- IF( T( HERE-1, HERE-2 ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, NBNEXT,
- $ NBF, WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - NBNEXT
-*
-* Test if 2 by 2 block breaks into two 1 by 1 blocks
-*
- IF( NBF.EQ.2 ) THEN
- IF( T( HERE+1, HERE ).EQ.ZERO )
- $ NBF = 3
- END IF
-*
- ELSE
-*
-* Current block consists of two 1 by 1 blocks each of which
-* must be swapped individually
-*
- NBNEXT = 1
- IF( HERE.GE.3 ) THEN
- IF( T( HERE-1, HERE-2 ).NE.ZERO )
- $ NBNEXT = 2
- END IF
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, NBNEXT,
- $ 1, WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- IF( NBNEXT.EQ.1 ) THEN
-*
-* Swap two 1 by 1 blocks, no problems possible
-*
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, NBNEXT, 1,
- $ WORK, INFO )
- HERE = HERE - 1
- ELSE
-*
-* Recompute NBNEXT in case 2 by 2 split
-*
- IF( T( HERE, HERE-1 ).EQ.ZERO )
- $ NBNEXT = 1
- IF( NBNEXT.EQ.2 ) THEN
-*
-* 2 by 2 Block did not split
-*
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 2, 1,
- $ WORK, INFO )
- IF( INFO.NE.0 ) THEN
- ILST = HERE
- RETURN
- END IF
- HERE = HERE - 2
- ELSE
-*
-* 2 by 2 Block did split
-*
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, 1,
- $ WORK, INFO )
- CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 1, 1,
- $ WORK, INFO )
- HERE = HERE - 2
- END IF
- END IF
- END IF
- IF( HERE.GT.ILST )
- $ GO TO 20
- END IF
- ILST = HERE
-*
- RETURN
-*
-* End of DTREXC
-*
- END
diff --git a/mtx/lapack_src/dtrmm.f b/mtx/lapack_src/dtrmm.f
deleted file mode 100644
index fc03769f2..000000000
--- a/mtx/lapack_src/dtrmm.f
+++ /dev/null
@@ -1,349 +0,0 @@
- SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
-* .. Scalar Arguments ..
- DOUBLE PRECISION ALPHA
- INTEGER LDA,LDB,M,N
- CHARACTER DIAG,SIDE,TRANSA,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),B(LDB,*)
-* ..
-*
-* Purpose
-* =======
-*
-* 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.
-*
-* Arguments
-* ==========
-*
-* SIDE - CHARACTER*1.
-* On entry, SIDE specifies whether op( A ) multiplies B from
-* the left or right as follows:
-*
-* SIDE = 'L' or 'l' B := alpha*op( A )*B.
-*
-* SIDE = 'R' or 'r' B := alpha*B*op( A ).
-*
-* Unchanged on exit.
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix A is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANSA - CHARACTER*1.
-* On entry, TRANSA specifies the form of op( A ) to be used in
-* the matrix multiplication as follows:
-*
-* TRANSA = 'N' or 'n' op( A ) = A.
-*
-* TRANSA = 'T' or 't' op( A ) = A**T.
-*
-* TRANSA = 'C' or 'c' op( A ) = A**T.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit triangular
-* as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of B. M must be at
-* least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of B. N must be
-* at least zero.
-* Unchanged on exit.
-*
-* ALPHA - DOUBLE PRECISION.
-* On entry, ALPHA specifies the scalar alpha. When alpha is
-* zero then A is not referenced and B need not be set before
-* entry.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
-* when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
-* Before entry with UPLO = 'U' or 'u', the leading k by k
-* upper triangular part of the array A must contain the upper
-* triangular matrix and the strictly lower triangular part of
-* A is not referenced.
-* Before entry with UPLO = 'L' or 'l', the leading k by k
-* lower triangular part of the array A must contain the lower
-* triangular matrix and the strictly upper triangular part of
-* A is not referenced.
-* Note that when DIAG = 'U' or 'u', the diagonal elements of
-* A are not referenced either, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When SIDE = 'L' or 'l' then
-* LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
-* then LDA must be at least max( 1, n ).
-* Unchanged on exit.
-*
-* B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
-* Before entry, the leading m by n part of the array B must
-* contain the matrix B, and on exit is overwritten by the
-* transformed matrix.
-*
-* LDB - INTEGER.
-* On entry, LDB specifies the first dimension of B as declared
-* in the calling (sub) program. LDB must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 3 Blas routine.
-*
-* -- Written on 8-February-1989.
-* Jack Dongarra, Argonne National Laboratory.
-* Iain Duff, AERE Harwell.
-* Jeremy Du Croz, Numerical Algorithms Group Ltd.
-* Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-* =====================================================================
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,J,K,NROWA
- LOGICAL LSIDE,NOUNIT,UPPER
-* ..
-* .. Parameters ..
- DOUBLE PRECISION ONE,ZERO
- PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-* ..
-*
-* Test the input parameters.
-*
- LSIDE = LSAME(SIDE,'L')
- IF (LSIDE) THEN
- NROWA = M
- ELSE
- NROWA = N
- END IF
- NOUNIT = LSAME(DIAG,'N')
- UPPER = LSAME(UPLO,'U')
-*
- INFO = 0
- IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
- INFO = 1
- ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
- INFO = 2
- ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
- + (.NOT.LSAME(TRANSA,'T')) .AND.
- + (.NOT.LSAME(TRANSA,'C'))) THEN
- INFO = 3
- ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
- INFO = 4
- ELSE IF (M.LT.0) THEN
- INFO = 5
- ELSE IF (N.LT.0) THEN
- INFO = 6
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 9
- ELSE IF (LDB.LT.MAX(1,M)) THEN
- INFO = 11
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DTRMM ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (M.EQ.0 .OR. N.EQ.0) RETURN
-*
-* And when alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,M
- B(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (LSIDE) THEN
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*A*B.
-*
- IF (UPPER) THEN
- DO 50 J = 1,N
- DO 40 K = 1,M
- IF (B(K,J).NE.ZERO) THEN
- TEMP = ALPHA*B(K,J)
- DO 30 I = 1,K - 1
- B(I,J) = B(I,J) + TEMP*A(I,K)
- 30 CONTINUE
- IF (NOUNIT) TEMP = TEMP*A(K,K)
- B(K,J) = TEMP
- END IF
- 40 CONTINUE
- 50 CONTINUE
- ELSE
- DO 80 J = 1,N
- DO 70 K = M,1,-1
- IF (B(K,J).NE.ZERO) THEN
- TEMP = ALPHA*B(K,J)
- B(K,J) = TEMP
- IF (NOUNIT) B(K,J) = B(K,J)*A(K,K)
- DO 60 I = K + 1,M
- B(I,J) = B(I,J) + TEMP*A(I,K)
- 60 CONTINUE
- END IF
- 70 CONTINUE
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*A**T*B.
-*
- IF (UPPER) THEN
- DO 110 J = 1,N
- DO 100 I = M,1,-1
- TEMP = B(I,J)
- IF (NOUNIT) TEMP = TEMP*A(I,I)
- DO 90 K = 1,I - 1
- TEMP = TEMP + A(K,I)*B(K,J)
- 90 CONTINUE
- B(I,J) = ALPHA*TEMP
- 100 CONTINUE
- 110 CONTINUE
- ELSE
- DO 140 J = 1,N
- DO 130 I = 1,M
- TEMP = B(I,J)
- IF (NOUNIT) TEMP = TEMP*A(I,I)
- DO 120 K = I + 1,M
- TEMP = TEMP + A(K,I)*B(K,J)
- 120 CONTINUE
- B(I,J) = ALPHA*TEMP
- 130 CONTINUE
- 140 CONTINUE
- END IF
- END IF
- ELSE
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*B*A.
-*
- IF (UPPER) THEN
- DO 180 J = N,1,-1
- TEMP = ALPHA
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 150 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 150 CONTINUE
- DO 170 K = 1,J - 1
- IF (A(K,J).NE.ZERO) THEN
- TEMP = ALPHA*A(K,J)
- DO 160 I = 1,M
- B(I,J) = B(I,J) + TEMP*B(I,K)
- 160 CONTINUE
- END IF
- 170 CONTINUE
- 180 CONTINUE
- ELSE
- DO 220 J = 1,N
- TEMP = ALPHA
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 190 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 190 CONTINUE
- DO 210 K = J + 1,N
- IF (A(K,J).NE.ZERO) THEN
- TEMP = ALPHA*A(K,J)
- DO 200 I = 1,M
- B(I,J) = B(I,J) + TEMP*B(I,K)
- 200 CONTINUE
- END IF
- 210 CONTINUE
- 220 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*B*A**T.
-*
- IF (UPPER) THEN
- DO 260 K = 1,N
- DO 240 J = 1,K - 1
- IF (A(J,K).NE.ZERO) THEN
- TEMP = ALPHA*A(J,K)
- DO 230 I = 1,M
- B(I,J) = B(I,J) + TEMP*B(I,K)
- 230 CONTINUE
- END IF
- 240 CONTINUE
- TEMP = ALPHA
- IF (NOUNIT) TEMP = TEMP*A(K,K)
- IF (TEMP.NE.ONE) THEN
- DO 250 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 250 CONTINUE
- END IF
- 260 CONTINUE
- ELSE
- DO 300 K = N,1,-1
- DO 280 J = K + 1,N
- IF (A(J,K).NE.ZERO) THEN
- TEMP = ALPHA*A(J,K)
- DO 270 I = 1,M
- B(I,J) = B(I,J) + TEMP*B(I,K)
- 270 CONTINUE
- END IF
- 280 CONTINUE
- TEMP = ALPHA
- IF (NOUNIT) TEMP = TEMP*A(K,K)
- IF (TEMP.NE.ONE) THEN
- DO 290 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 290 CONTINUE
- END IF
- 300 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DTRMM .
-*
- END
diff --git a/mtx/lapack_src/dtrmv.f b/mtx/lapack_src/dtrmv.f
deleted file mode 100644
index 5356cbbc2..000000000
--- a/mtx/lapack_src/dtrmv.f
+++ /dev/null
@@ -1,282 +0,0 @@
- SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,LDA,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A(LDA,*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* 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.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' x := A*x.
-*
-* TRANS = 'T' or 't' x := A**T*x.
-*
-* TRANS = 'C' or 'c' x := A**T*x.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit
-* triangular as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading n by n
-* upper triangular part of the array A must contain the upper
-* triangular matrix and the strictly lower triangular part of
-* A is not referenced.
-* Before entry with UPLO = 'L' or 'l', the leading n by n
-* lower triangular part of the array A must contain the lower
-* triangular matrix and the strictly upper triangular part of
-* A is not referenced.
-* Note that when DIAG = 'U' or 'u', the diagonal elements of
-* A are not referenced either, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, n ).
-* Unchanged on exit.
-*
-* X - DOUBLE PRECISION array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element vector x. On exit, X is overwritten with the
-* tranformed vector x.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Further Details
-* ===============
-*
-* Level 2 Blas routine.
-* The vector and matrix arguments are not referenced when N = 0, or M = 0
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER (ZERO=0.0D+0)
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION TEMP
- INTEGER I,INFO,IX,J,JX,KX
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (LDA.LT.MAX(1,N)) THEN
- INFO = 6
- ELSE IF (INCX.EQ.0) THEN
- INFO = 8
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('DTRMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x := A*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (X(J).NE.ZERO) THEN
- TEMP = X(J)
- DO 10 I = 1,J - 1
- X(I) = X(I) + TEMP*A(I,J)
- 10 CONTINUE
- IF (NOUNIT) X(J) = X(J)*A(J,J)
- END IF
- 20 CONTINUE
- ELSE
- JX = KX
- DO 40 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = X(JX)
- IX = KX
- DO 30 I = 1,J - 1
- X(IX) = X(IX) + TEMP*A(I,J)
- IX = IX + INCX
- 30 CONTINUE
- IF (NOUNIT) X(JX) = X(JX)*A(J,J)
- END IF
- JX = JX + INCX
- 40 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 60 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- TEMP = X(J)
- DO 50 I = N,J + 1,-1
- X(I) = X(I) + TEMP*A(I,J)
- 50 CONTINUE
- IF (NOUNIT) X(J) = X(J)*A(J,J)
- END IF
- 60 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 80 J = N,1,-1
- IF (X(JX).NE.ZERO) THEN
- TEMP = X(JX)
- IX = KX
- DO 70 I = N,J + 1,-1
- X(IX) = X(IX) + TEMP*A(I,J)
- IX = IX - INCX
- 70 CONTINUE
- IF (NOUNIT) X(JX) = X(JX)*A(J,J)
- END IF
- JX = JX - INCX
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := A**T*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- IF (INCX.EQ.1) THEN
- DO 100 J = N,1,-1
- TEMP = X(J)
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 90 I = J - 1,1,-1
- TEMP = TEMP + A(I,J)*X(I)
- 90 CONTINUE
- X(J) = TEMP
- 100 CONTINUE
- ELSE
- JX = KX + (N-1)*INCX
- DO 120 J = N,1,-1
- TEMP = X(JX)
- IX = JX
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 110 I = J - 1,1,-1
- IX = IX - INCX
- TEMP = TEMP + A(I,J)*X(IX)
- 110 CONTINUE
- X(JX) = TEMP
- JX = JX - INCX
- 120 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 140 J = 1,N
- TEMP = X(J)
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 130 I = J + 1,N
- TEMP = TEMP + A(I,J)*X(I)
- 130 CONTINUE
- X(J) = TEMP
- 140 CONTINUE
- ELSE
- JX = KX
- DO 160 J = 1,N
- TEMP = X(JX)
- IX = JX
- IF (NOUNIT) TEMP = TEMP*A(J,J)
- DO 150 I = J + 1,N
- IX = IX + INCX
- TEMP = TEMP + A(I,J)*X(IX)
- 150 CONTINUE
- X(JX) = TEMP
- JX = JX + INCX
- 160 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of DTRMV .
-*
- END
diff --git a/mtx/lapack_src/dtrti2.f b/mtx/lapack_src/dtrti2.f
deleted file mode 100644
index bc5a388d7..000000000
--- a/mtx/lapack_src/dtrti2.f
+++ /dev/null
@@ -1,212 +0,0 @@
-*> \brief \b DTRTI2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTRTI2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTRTI2( UPLO, DIAG, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTRTI2 computes the inverse of a real upper or lower triangular
-*> matrix.
-*>
-*> This is the Level 2 BLAS version of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> Specifies whether the matrix A is upper or lower triangular.
-*> = 'U': Upper triangular
-*> = 'L': Lower triangular
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> Specifies whether or not the matrix A is unit triangular.
-*> = 'N': Non-unit triangular
-*> = 'U': Unit triangular
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the triangular matrix A. If UPLO = 'U', the
-*> leading n by n upper triangular part of the array A contains
-*> the upper triangular matrix, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading n by n lower triangular part of the array A contains
-*> the lower triangular matrix, and the strictly upper
-*> triangular part of A is not referenced. If DIAG = 'U', the
-*> diagonal elements of A are also not referenced and are
-*> assumed to be 1.
-*>
-*> On exit, the (triangular) inverse of the original matrix, in
-*> the same storage format.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTRTI2( UPLO, DIAG, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE
- PARAMETER ( ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, UPPER
- INTEGER J
- DOUBLE PRECISION AJJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DSCAL, DTRMV, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOUNIT = LSAME( DIAG, 'N' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTRTI2', -INFO )
- RETURN
- END IF
-*
- IF( UPPER ) THEN
-*
-* Compute inverse of upper triangular matrix.
-*
- DO 10 J = 1, N
- IF( NOUNIT ) THEN
- A( J, J ) = ONE / A( J, J )
- AJJ = -A( J, J )
- ELSE
- AJJ = -ONE
- END IF
-*
-* Compute elements 1:j-1 of j-th column.
-*
- CALL DTRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA,
- $ A( 1, J ), 1 )
- CALL DSCAL( J-1, AJJ, A( 1, J ), 1 )
- 10 CONTINUE
- ELSE
-*
-* Compute inverse of lower triangular matrix.
-*
- DO 20 J = N, 1, -1
- IF( NOUNIT ) THEN
- A( J, J ) = ONE / A( J, J )
- AJJ = -A( J, J )
- ELSE
- AJJ = -ONE
- END IF
- IF( J.LT.N ) THEN
-*
-* Compute elements j+1:n of j-th column.
-*
- CALL DTRMV( 'Lower', 'No transpose', DIAG, N-J,
- $ A( J+1, J+1 ), LDA, A( J+1, J ), 1 )
- CALL DSCAL( N-J, AJJ, A( J+1, J ), 1 )
- END IF
- 20 CONTINUE
- END IF
-*
- RETURN
-*
-* End of DTRTI2
-*
- END
diff --git a/mtx/lapack_src/dtrtri.f b/mtx/lapack_src/dtrtri.f
deleted file mode 100644
index 5d27ca56a..000000000
--- a/mtx/lapack_src/dtrtri.f
+++ /dev/null
@@ -1,242 +0,0 @@
-*> \brief \b DTRTRI
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTRTRI + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTRTRI( UPLO, DIAG, N, A, LDA, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, UPLO
-* INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DTRTRI computes the inverse of a real upper or lower triangular
-*> matrix A.
-*>
-*> This is the Level 3 BLAS version of the algorithm.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the triangular matrix A. If UPLO = 'U', the
-*> leading N-by-N upper triangular part of the array A contains
-*> the upper triangular matrix, and the strictly lower
-*> triangular part of A is not referenced. If UPLO = 'L', the
-*> leading N-by-N lower triangular part of the array A contains
-*> the lower triangular matrix, and the strictly upper
-*> triangular part of A is not referenced. If DIAG = 'U', the
-*> diagonal elements of A are also not referenced and are
-*> assumed to be 1.
-*> On exit, the (triangular) inverse of the original matrix, in
-*> the same storage format.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, A(i,i) is exactly zero. The triangular
-*> matrix is singular and its inverse can not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTRTRI( UPLO, DIAG, N, A, LDA, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, UPLO
- INTEGER INFO, LDA, N
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ONE, ZERO
- PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT, UPPER
- INTEGER J, JB, NB, NN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL DTRMM, DTRSM, DTRTI2, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- UPPER = LSAME( UPLO, 'U' )
- NOUNIT = LSAME( DIAG, 'N' )
- IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -2
- ELSE IF( N.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTRTRI', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Check for singularity if non-unit.
-*
- IF( NOUNIT ) THEN
- DO 10 INFO = 1, N
- IF( A( INFO, INFO ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
- INFO = 0
- END IF
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'DTRTRI', UPLO // DIAG, N, -1, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-* Use unblocked code
-*
- CALL DTRTI2( UPLO, DIAG, N, A, LDA, INFO )
- ELSE
-*
-* Use blocked code
-*
- IF( UPPER ) THEN
-*
-* Compute inverse of upper triangular matrix
-*
- DO 20 J = 1, N, NB
- JB = MIN( NB, N-J+1 )
-*
-* Compute rows 1:j-1 of current block column
-*
- CALL DTRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1,
- $ JB, ONE, A, LDA, A( 1, J ), LDA )
- CALL DTRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1,
- $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA )
-*
-* Compute inverse of current diagonal block
-*
- CALL DTRTI2( 'Upper', DIAG, JB, A( J, J ), LDA, INFO )
- 20 CONTINUE
- ELSE
-*
-* Compute inverse of lower triangular matrix
-*
- NN = ( ( N-1 ) / NB )*NB + 1
- DO 30 J = NN, 1, -NB
- JB = MIN( NB, N-J+1 )
- IF( J+JB.LE.N ) THEN
-*
-* Compute rows j+jb:n of current block column
-*
- CALL DTRMM( 'Left', 'Lower', 'No transpose', DIAG,
- $ N-J-JB+1, JB, ONE, A( J+JB, J+JB ), LDA,
- $ A( J+JB, J ), LDA )
- CALL DTRSM( 'Right', 'Lower', 'No transpose', DIAG,
- $ N-J-JB+1, JB, -ONE, A( J, J ), LDA,
- $ A( J+JB, J ), LDA )
- END IF
-*
-* Compute inverse of current diagonal block
-*
- CALL DTRTI2( 'Lower', DIAG, JB, A( J, J ), LDA, INFO )
- 30 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of DTRTRI
-*
- END
diff --git a/mtx/lapack_src/dtrtrs.f b/mtx/lapack_src/dtrtrs.f
deleted file mode 100644
index 416a66e7c..000000000
--- a/mtx/lapack_src/dtrtrs.f
+++ /dev/null
@@ -1,226 +0,0 @@
-*> \brief \b DTRTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DTRTRS + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG, TRANS, UPLO
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*> UPLO is CHARACTER*1
-*> = 'U': A is upper triangular;
-*> = 'L': A is lower triangular.
-*> \endverbatim
-*>
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] DIAG
-*> \verbatim
-*> DIAG is CHARACTER*1
-*> = 'N': A is non-unit triangular;
-*> = 'U': A is unit triangular.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The triangular matrix A. If UPLO = 'U', the leading N-by-N
-*> upper triangular part of the array A contains the upper
-*> triangular matrix, and the strictly lower triangular part of
-*> A is not referenced. If UPLO = 'L', the leading N-by-N lower
-*> triangular part of the array A contains the lower triangular
-*> matrix, and the strictly upper triangular part of A is not
-*> referenced. If DIAG = 'U', the diagonal elements of A are
-*> also not referenced and are assumed to be 1.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, if INFO = 0, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, the i-th diagonal element of A is zero,
-*> indicating that the matrix is singular and the solutions
-*> X have not been computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup doubleOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG, TRANS, UPLO
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL DTRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOUNIT = LSAME( DIAG, 'N' )
- IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
- INFO = -1
- ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
- $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
- INFO = -2
- ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
- INFO = -3
- ELSE IF( N.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -9
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DTRTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Check for singularity.
-*
- IF( NOUNIT ) THEN
- DO 10 INFO = 1, N
- IF( A( INFO, INFO ).EQ.ZERO )
- $ RETURN
- 10 CONTINUE
- END IF
- INFO = 0
-*
-* Solve A * x = b or A**T * x = b.
-*
- CALL DTRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B,
- $ LDB )
-*
- RETURN
-*
-* End of DTRTRS
-*
- END
diff --git a/mtx/lapack_src/icmax1.f b/mtx/lapack_src/icmax1.f
deleted file mode 100644
index ffc80c822..000000000
--- a/mtx/lapack_src/icmax1.f
+++ /dev/null
@@ -1,154 +0,0 @@
-*> \brief \b ICMAX1
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ICMAX1 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ICMAX1( N, CX, INCX )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* ..
-* .. Array Arguments ..
-* COMPLEX CX( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ICMAX1 finds the index of the element whose real part has maximum
-*> absolute value.
-*>
-*> Based on ICAMAX from Level 1 BLAS.
-*> The change is to use the 'genuine' absolute value.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of elements in the vector CX.
-*> \endverbatim
-*>
-*> \param[in] CX
-*> \verbatim
-*> CX is COMPLEX array, dimension (N)
-*> The vector whose elements will be summed.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The spacing between successive values of CX. INCX >= 1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complexOTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Nick Higham for use with CLACON.
-*
-* =====================================================================
- INTEGER FUNCTION ICMAX1( N, CX, INCX )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
-* ..
-* .. Array Arguments ..
- COMPLEX CX( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IX
- REAL SMAX
- COMPLEX ZDUM
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Statement Functions ..
- REAL CABS1
-* ..
-* .. Statement Function definitions ..
-*
-* NEXT LINE IS THE ONLY MODIFICATION.
- CABS1( ZDUM ) = ABS( ZDUM )
-* ..
-* .. Executable Statements ..
-*
- ICMAX1 = 0
- IF( N.LT.1 )
- $ RETURN
- ICMAX1 = 1
- IF( N.EQ.1 )
- $ RETURN
- IF( INCX.EQ.1 )
- $ GO TO 30
-*
-* CODE FOR INCREMENT NOT EQUAL TO 1
-*
- IX = 1
- SMAX = CABS1( CX( 1 ) )
- IX = IX + INCX
- DO 20 I = 2, N
- IF( CABS1( CX( IX ) ).LE.SMAX )
- $ GO TO 10
- ICMAX1 = I
- SMAX = CABS1( CX( IX ) )
- 10 CONTINUE
- IX = IX + INCX
- 20 CONTINUE
- RETURN
-*
-* CODE FOR INCREMENT EQUAL TO 1
-*
- 30 CONTINUE
- SMAX = CABS1( CX( 1 ) )
- DO 40 I = 2, N
- IF( CABS1( CX( I ) ).LE.SMAX )
- $ GO TO 40
- ICMAX1 = I
- SMAX = CABS1( CX( I ) )
- 40 CONTINUE
- RETURN
-*
-* End of ICMAX1
-*
- END
diff --git a/mtx/lapack_src/ieeeck.f b/mtx/lapack_src/ieeeck.f
deleted file mode 100644
index 132e43677..000000000
--- a/mtx/lapack_src/ieeeck.f
+++ /dev/null
@@ -1,203 +0,0 @@
-*> \brief \b IEEECK
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download IEEECK + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE )
-*
-* .. Scalar Arguments ..
-* INTEGER ISPEC
-* REAL ONE, ZERO
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> IEEECK is called from the ILAENV to verify that Infinity and
-*> possibly NaN arithmetic is safe (i.e. will not trap).
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ISPEC
-*> \verbatim
-*> ISPEC is INTEGER
-*> Specifies whether to test just for inifinity arithmetic
-*> or whether to test for infinity and NaN arithmetic.
-*> = 0: Verify infinity arithmetic only.
-*> = 1: Verify infinity and NaN arithmetic.
-*> \endverbatim
-*>
-*> \param[in] ZERO
-*> \verbatim
-*> ZERO is REAL
-*> Must contain the value 0.0
-*> This is passed to prevent the compiler from optimizing
-*> away this code.
-*> \endverbatim
-*>
-*> \param[in] ONE
-*> \verbatim
-*> ONE is REAL
-*> Must contain the value 1.0
-*> This is passed to prevent the compiler from optimizing
-*> away this code.
-*>
-*> RETURN VALUE: INTEGER
-*> = 0: Arithmetic failed to produce the correct answers
-*> = 1: Arithmetic produced the correct answers
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER ISPEC
- REAL ONE, ZERO
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- REAL NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF,
- $ NEGZRO, NEWZRO, POSINF
-* ..
-* .. Executable Statements ..
- IEEECK = 1
-*
- POSINF = ONE / ZERO
- IF( POSINF.LE.ONE ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- NEGINF = -ONE / ZERO
- IF( NEGINF.GE.ZERO ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- NEGZRO = ONE / ( NEGINF+ONE )
- IF( NEGZRO.NE.ZERO ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- NEGINF = ONE / NEGZRO
- IF( NEGINF.GE.ZERO ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- NEWZRO = NEGZRO + ZERO
- IF( NEWZRO.NE.ZERO ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- POSINF = ONE / NEWZRO
- IF( POSINF.LE.ONE ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- NEGINF = NEGINF*POSINF
- IF( NEGINF.GE.ZERO ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- POSINF = POSINF*POSINF
- IF( POSINF.LE.ONE ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
-*
-*
-*
-* Return if we were only asked to check infinity arithmetic
-*
- IF( ISPEC.EQ.0 )
- $ RETURN
-*
- NAN1 = POSINF + NEGINF
-*
- NAN2 = POSINF / NEGINF
-*
- NAN3 = POSINF / POSINF
-*
- NAN4 = POSINF*ZERO
-*
- NAN5 = NEGINF*NEGZRO
-*
- NAN6 = NAN5*ZERO
-*
- IF( NAN1.EQ.NAN1 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- IF( NAN2.EQ.NAN2 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- IF( NAN3.EQ.NAN3 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- IF( NAN4.EQ.NAN4 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- IF( NAN5.EQ.NAN5 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- IF( NAN6.EQ.NAN6 ) THEN
- IEEECK = 0
- RETURN
- END IF
-*
- RETURN
- END
diff --git a/mtx/lapack_src/ilaclc.f b/mtx/lapack_src/ilaclc.f
deleted file mode 100644
index 4ceb61c52..000000000
--- a/mtx/lapack_src/ilaclc.f
+++ /dev/null
@@ -1,118 +0,0 @@
-*> \brief \b ILACLC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILACLC + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILACLC( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* COMPLEX A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILACLC scans A for its last non-zero column.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is COMPLEX array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complexOTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILACLC( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- COMPLEX A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX ZERO
- PARAMETER ( ZERO = (0.0E+0, 0.0E+0) )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( N.EQ.0 ) THEN
- ILACLC = N
- ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILACLC = N
- ELSE
-* Now scan each column from the end, returning with the first non-zero.
- DO ILACLC = N, 1, -1
- DO I = 1, M
- IF( A(I, ILACLC).NE.ZERO ) RETURN
- END DO
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/lapack_src/ilaclr.f b/mtx/lapack_src/ilaclr.f
deleted file mode 100644
index d8ab09c55..000000000
--- a/mtx/lapack_src/ilaclr.f
+++ /dev/null
@@ -1,121 +0,0 @@
-*> \brief \b ILACLR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILACLR + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILACLR( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* COMPLEX A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILACLR scans A for its last non-zero row.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup complexOTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILACLR( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- COMPLEX A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX ZERO
- PARAMETER ( ZERO = (0.0E+0, 0.0E+0) )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( M.EQ.0 ) THEN
- ILACLR = M
- ELSE IF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILACLR = M
- ELSE
-* Scan up each column tracking the last zero row seen.
- ILACLR = 0
- DO J = 1, N
- I=M
- DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
- I=I-1
- ENDDO
- ILACLR = MAX( ILACLR, I )
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/lapack_src/iladiag.f b/mtx/lapack_src/iladiag.f
deleted file mode 100644
index 1d5c5bff1..000000000
--- a/mtx/lapack_src/iladiag.f
+++ /dev/null
@@ -1,92 +0,0 @@
-*> \brief \b ILADIAG
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILADIAG + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILADIAG( DIAG )
-*
-* .. Scalar Arguments ..
-* CHARACTER DIAG
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- INTEGER FUNCTION ILADIAG( DIAG )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER DIAG
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER BLAS_NON_UNIT_DIAG, BLAS_UNIT_DIAG
- PARAMETER ( BLAS_NON_UNIT_DIAG = 131, BLAS_UNIT_DIAG = 132 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
- IF( LSAME( DIAG, 'N' ) ) THEN
- ILADIAG = BLAS_NON_UNIT_DIAG
- ELSE IF( LSAME( DIAG, 'U' ) ) THEN
- ILADIAG = BLAS_UNIT_DIAG
- ELSE
- ILADIAG = -1
- END IF
- RETURN
-*
-* End of ILADIAG
-*
- END
diff --git a/mtx/lapack_src/iladlc.f b/mtx/lapack_src/iladlc.f
deleted file mode 100644
index f84bd833a..000000000
--- a/mtx/lapack_src/iladlc.f
+++ /dev/null
@@ -1,118 +0,0 @@
-*> \brief \b ILADLC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILADLC + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILADLC( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILADLC scans A for its last non-zero column.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILADLC( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( N.EQ.0 ) THEN
- ILADLC = N
- ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILADLC = N
- ELSE
-* Now scan each column from the end, returning with the first non-zero.
- DO ILADLC = N, 1, -1
- DO I = 1, M
- IF( A(I, ILADLC).NE.ZERO ) RETURN
- END DO
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/lapack_src/iladlr.f b/mtx/lapack_src/iladlr.f
deleted file mode 100644
index 2114c6164..000000000
--- a/mtx/lapack_src/iladlr.f
+++ /dev/null
@@ -1,121 +0,0 @@
-*> \brief \b ILADLR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILADLR + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILADLR( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILADLR scans A for its last non-zero row.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILADLR( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( M.EQ.0 ) THEN
- ILADLR = M
- ELSE IF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILADLR = M
- ELSE
-* Scan up each column tracking the last zero row seen.
- ILADLR = 0
- DO J = 1, N
- I=M
- DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
- I=I-1
- ENDDO
- ILADLR = MAX( ILADLR, I )
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/lapack_src/ilaenv.f b/mtx/lapack_src/ilaenv.f
deleted file mode 100644
index 867464de3..000000000
--- a/mtx/lapack_src/ilaenv.f
+++ /dev/null
@@ -1,624 +0,0 @@
-*> \brief \b ILAENV
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILAENV + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
-*
-* .. Scalar Arguments ..
-* CHARACTER*( * ) NAME, OPTS
-* INTEGER ISPEC, N1, N2, N3, N4
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ISPEC
-*> \verbatim
-*> ISPEC is INTEGER
-*> Specifies the parameter to be returned as the value of
-*> ILAENV.
-*> = 1: the optimal blocksize; if this value is 1, an unblocked
-*> algorithm will give the best performance.
-*> = 2: the minimum block size for which the block routine
-*> should be used; if the usable block size is less than
-*> this value, an unblocked routine should be used.
-*> = 3: the crossover point (in a block routine, for N less
-*> than this value, an unblocked routine should be used)
-*> = 4: the number of shifts, used in the nonsymmetric
-*> eigenvalue routines (DEPRECATED)
-*> = 5: the minimum column dimension for blocking to be used;
-*> rectangular blocks must have dimension at least k by m,
-*> where k is given by ILAENV(2,...) and m by ILAENV(5,...)
-*> = 6: the crossover point for the SVD (when reducing an m by n
-*> matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
-*> this value, a QR factorization is used first to reduce
-*> the matrix to a triangular form.)
-*> = 7: the number of processors
-*> = 8: the crossover point for the multishift QR method
-*> for nonsymmetric eigenvalue problems (DEPRECATED)
-*> = 9: maximum size of the subproblems at the bottom of the
-*> computation tree in the divide-and-conquer algorithm
-*> (used by xGELSD and xGESDD)
-*> =10: ieee NaN arithmetic can be trusted not to trap
-*> =11: infinity arithmetic can be trusted not to trap
-*> 12 <= ISPEC <= 16:
-*> xHSEQR or one of its subroutines,
-*> see IPARMQ for detailed explanation
-*> \endverbatim
-*>
-*> \param[in] NAME
-*> \verbatim
-*> NAME is CHARACTER*(*)
-*> The name of the calling subroutine, in either upper case or
-*> lower case.
-*> \endverbatim
-*>
-*> \param[in] OPTS
-*> \verbatim
-*> OPTS is CHARACTER*(*)
-*> The character options to the subroutine NAME, concatenated
-*> into a single character string. For example, UPLO = 'U',
-*> TRANS = 'T', and DIAG = 'N' for a triangular routine would
-*> be specified as OPTS = 'UTN'.
-*> \endverbatim
-*>
-*> \param[in] N1
-*> \verbatim
-*> N1 is INTEGER
-*> \endverbatim
-*>
-*> \param[in] N2
-*> \verbatim
-*> N2 is INTEGER
-*> \endverbatim
-*>
-*> \param[in] N3
-*> \verbatim
-*> N3 is INTEGER
-*> \endverbatim
-*>
-*> \param[in] N4
-*> \verbatim
-*> N4 is INTEGER
-*> Problem dimensions for the subroutine NAME; these may not all
-*> be required.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The following conventions have been used when calling ILAENV from the
-*> LAPACK routines:
-*> 1) OPTS is a concatenation of all of the character options to
-*> subroutine NAME, in the same order that they appear in the
-*> argument list for NAME, even if they are not used in determining
-*> the value of the parameter specified by ISPEC.
-*> 2) The problem dimensions N1, N2, N3, N4 are specified in the order
-*> that they appear in the argument list for NAME. N1 is used
-*> first, N2 second, and so on, and unused problem dimensions are
-*> passed a value of -1.
-*> 3) The parameter value returned by ILAENV is checked for validity in
-*> the calling subroutine. For example, ILAENV is used to retrieve
-*> the optimal blocksize for STRTRI as follows:
-*>
-*> NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
-*> IF( NB.LE.1 ) NB = MAX( 1, N )
-*> \endverbatim
-*>
-* =====================================================================
- INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER*( * ) NAME, OPTS
- INTEGER ISPEC, N1, N2, N3, N4
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IC, IZ, NB, NBMIN, NX
- LOGICAL CNAME, SNAME
- CHARACTER C1*1, C2*2, C4*2, C3*3, SUBNAM*6
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC CHAR, ICHAR, INT, MIN, REAL
-* ..
-* .. External Functions ..
- INTEGER IEEECK, IPARMQ
- EXTERNAL IEEECK, IPARMQ
-* ..
-* .. Executable Statements ..
-*
- GO TO ( 10, 10, 10, 80, 90, 100, 110, 120,
- $ 130, 140, 150, 160, 160, 160, 160, 160 )ISPEC
-*
-* Invalid value for ISPEC
-*
- ILAENV = -1
- RETURN
-*
- 10 CONTINUE
-*
-* Convert NAME to upper case if the first character is lower case.
-*
- ILAENV = 1
- SUBNAM = NAME
- IC = ICHAR( SUBNAM( 1: 1 ) )
- IZ = ICHAR( 'Z' )
- IF( IZ.EQ.90 .OR. IZ.EQ.122 ) THEN
-*
-* ASCII character set
-*
- IF( IC.GE.97 .AND. IC.LE.122 ) THEN
- SUBNAM( 1: 1 ) = CHAR( IC-32 )
- DO 20 I = 2, 6
- IC = ICHAR( SUBNAM( I: I ) )
- IF( IC.GE.97 .AND. IC.LE.122 )
- $ SUBNAM( I: I ) = CHAR( IC-32 )
- 20 CONTINUE
- END IF
-*
- ELSE IF( IZ.EQ.233 .OR. IZ.EQ.169 ) THEN
-*
-* EBCDIC character set
-*
- IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
- $ ( IC.GE.145 .AND. IC.LE.153 ) .OR.
- $ ( IC.GE.162 .AND. IC.LE.169 ) ) THEN
- SUBNAM( 1: 1 ) = CHAR( IC+64 )
- DO 30 I = 2, 6
- IC = ICHAR( SUBNAM( I: I ) )
- IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
- $ ( IC.GE.145 .AND. IC.LE.153 ) .OR.
- $ ( IC.GE.162 .AND. IC.LE.169 ) )SUBNAM( I:
- $ I ) = CHAR( IC+64 )
- 30 CONTINUE
- END IF
-*
- ELSE IF( IZ.EQ.218 .OR. IZ.EQ.250 ) THEN
-*
-* Prime machines: ASCII+128
-*
- IF( IC.GE.225 .AND. IC.LE.250 ) THEN
- SUBNAM( 1: 1 ) = CHAR( IC-32 )
- DO 40 I = 2, 6
- IC = ICHAR( SUBNAM( I: I ) )
- IF( IC.GE.225 .AND. IC.LE.250 )
- $ SUBNAM( I: I ) = CHAR( IC-32 )
- 40 CONTINUE
- END IF
- END IF
-*
- C1 = SUBNAM( 1: 1 )
- SNAME = C1.EQ.'S' .OR. C1.EQ.'D'
- CNAME = C1.EQ.'C' .OR. C1.EQ.'Z'
- IF( .NOT.( CNAME .OR. SNAME ) )
- $ RETURN
- C2 = SUBNAM( 2: 3 )
- C3 = SUBNAM( 4: 6 )
- C4 = C3( 2: 3 )
-*
- GO TO ( 50, 60, 70 )ISPEC
-*
- 50 CONTINUE
-*
-* ISPEC = 1: block size
-*
-* In these examples, separate code is provided for setting NB for
-* real and complex. We assume that NB will take the same value in
-* single or double precision.
-*
- NB = 1
-*
- IF( C2.EQ.'GE' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- ELSE IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
- $ C3.EQ.'QLF' ) THEN
- IF( SNAME ) THEN
- NB = 32
- ELSE
- NB = 32
- END IF
- ELSE IF( C3.EQ.'HRD' ) THEN
- IF( SNAME ) THEN
- NB = 32
- ELSE
- NB = 32
- END IF
- ELSE IF( C3.EQ.'BRD' ) THEN
- IF( SNAME ) THEN
- NB = 32
- ELSE
- NB = 32
- END IF
- ELSE IF( C3.EQ.'TRI' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- END IF
- ELSE IF( C2.EQ.'PO' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- END IF
- ELSE IF( C2.EQ.'SY' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
- NB = 32
- ELSE IF( SNAME .AND. C3.EQ.'GST' ) THEN
- NB = 64
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- NB = 64
- ELSE IF( C3.EQ.'TRD' ) THEN
- NB = 32
- ELSE IF( C3.EQ.'GST' ) THEN
- NB = 64
- END IF
- ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
- IF( C3( 1: 1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NB = 32
- END IF
- ELSE IF( C3( 1: 1 ).EQ.'M' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NB = 32
- END IF
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
- IF( C3( 1: 1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NB = 32
- END IF
- ELSE IF( C3( 1: 1 ).EQ.'M' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NB = 32
- END IF
- END IF
- ELSE IF( C2.EQ.'GB' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- IF( N4.LE.64 ) THEN
- NB = 1
- ELSE
- NB = 32
- END IF
- ELSE
- IF( N4.LE.64 ) THEN
- NB = 1
- ELSE
- NB = 32
- END IF
- END IF
- END IF
- ELSE IF( C2.EQ.'PB' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- IF( N2.LE.64 ) THEN
- NB = 1
- ELSE
- NB = 32
- END IF
- ELSE
- IF( N2.LE.64 ) THEN
- NB = 1
- ELSE
- NB = 32
- END IF
- END IF
- END IF
- ELSE IF( C2.EQ.'TR' ) THEN
- IF( C3.EQ.'TRI' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- END IF
- ELSE IF( C2.EQ.'LA' ) THEN
- IF( C3.EQ.'UUM' ) THEN
- IF( SNAME ) THEN
- NB = 64
- ELSE
- NB = 64
- END IF
- END IF
- ELSE IF( SNAME .AND. C2.EQ.'ST' ) THEN
- IF( C3.EQ.'EBZ' ) THEN
- NB = 1
- END IF
- END IF
- ILAENV = NB
- RETURN
-*
- 60 CONTINUE
-*
-* ISPEC = 2: minimum block size
-*
- NBMIN = 2
- IF( C2.EQ.'GE' ) THEN
- IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. C3.EQ.
- $ 'QLF' ) THEN
- IF( SNAME ) THEN
- NBMIN = 2
- ELSE
- NBMIN = 2
- END IF
- ELSE IF( C3.EQ.'HRD' ) THEN
- IF( SNAME ) THEN
- NBMIN = 2
- ELSE
- NBMIN = 2
- END IF
- ELSE IF( C3.EQ.'BRD' ) THEN
- IF( SNAME ) THEN
- NBMIN = 2
- ELSE
- NBMIN = 2
- END IF
- ELSE IF( C3.EQ.'TRI' ) THEN
- IF( SNAME ) THEN
- NBMIN = 2
- ELSE
- NBMIN = 2
- END IF
- END IF
- ELSE IF( C2.EQ.'SY' ) THEN
- IF( C3.EQ.'TRF' ) THEN
- IF( SNAME ) THEN
- NBMIN = 8
- ELSE
- NBMIN = 8
- END IF
- ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
- NBMIN = 2
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
- IF( C3.EQ.'TRD' ) THEN
- NBMIN = 2
- END IF
- ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
- IF( C3( 1: 1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NBMIN = 2
- END IF
- ELSE IF( C3( 1: 1 ).EQ.'M' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NBMIN = 2
- END IF
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
- IF( C3( 1: 1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NBMIN = 2
- END IF
- ELSE IF( C3( 1: 1 ).EQ.'M' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NBMIN = 2
- END IF
- END IF
- END IF
- ILAENV = NBMIN
- RETURN
-*
- 70 CONTINUE
-*
-* ISPEC = 3: crossover point
-*
- NX = 0
- IF( C2.EQ.'GE' ) THEN
- IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. C3.EQ.
- $ 'QLF' ) THEN
- IF( SNAME ) THEN
- NX = 128
- ELSE
- NX = 128
- END IF
- ELSE IF( C3.EQ.'HRD' ) THEN
- IF( SNAME ) THEN
- NX = 128
- ELSE
- NX = 128
- END IF
- ELSE IF( C3.EQ.'BRD' ) THEN
- IF( SNAME ) THEN
- NX = 128
- ELSE
- NX = 128
- END IF
- END IF
- ELSE IF( C2.EQ.'SY' ) THEN
- IF( SNAME .AND. C3.EQ.'TRD' ) THEN
- NX = 32
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
- IF( C3.EQ.'TRD' ) THEN
- NX = 32
- END IF
- ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
- IF( C3( 1: 1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NX = 128
- END IF
- END IF
- ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
- IF( C3( 1: 1 ).EQ.'G' ) THEN
- IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
- $ 'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
- $ THEN
- NX = 128
- END IF
- END IF
- END IF
- ILAENV = NX
- RETURN
-*
- 80 CONTINUE
-*
-* ISPEC = 4: number of shifts (used by xHSEQR)
-*
- ILAENV = 6
- RETURN
-*
- 90 CONTINUE
-*
-* ISPEC = 5: minimum column dimension (not used)
-*
- ILAENV = 2
- RETURN
-*
- 100 CONTINUE
-*
-* ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD)
-*
- ILAENV = INT( REAL( MIN( N1, N2 ) )*1.6E0 )
- RETURN
-*
- 110 CONTINUE
-*
-* ISPEC = 7: number of processors (not used)
-*
- ILAENV = 1
- RETURN
-*
- 120 CONTINUE
-*
-* ISPEC = 8: crossover point for multishift (used by xHSEQR)
-*
- ILAENV = 50
- RETURN
-*
- 130 CONTINUE
-*
-* ISPEC = 9: maximum size of the subproblems at the bottom of the
-* computation tree in the divide-and-conquer algorithm
-* (used by xGELSD and xGESDD)
-*
- ILAENV = 25
- RETURN
-*
- 140 CONTINUE
-*
-* ISPEC = 10: ieee NaN arithmetic can be trusted not to trap
-*
-* ILAENV = 0
- ILAENV = 1
- IF( ILAENV.EQ.1 ) THEN
- ILAENV = IEEECK( 1, 0.0, 1.0 )
- END IF
- RETURN
-*
- 150 CONTINUE
-*
-* ISPEC = 11: infinity arithmetic can be trusted not to trap
-*
-* ILAENV = 0
- ILAENV = 1
- IF( ILAENV.EQ.1 ) THEN
- ILAENV = IEEECK( 0, 0.0, 1.0 )
- END IF
- RETURN
-*
- 160 CONTINUE
-*
-* 12 <= ISPEC <= 16: xHSEQR or one of its subroutines.
-*
- ILAENV = IPARMQ( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
- RETURN
-*
-* End of ILAENV
-*
- END
diff --git a/mtx/lapack_src/ilaprec.f b/mtx/lapack_src/ilaprec.f
deleted file mode 100644
index 88ae77e4d..000000000
--- a/mtx/lapack_src/ilaprec.f
+++ /dev/null
@@ -1,98 +0,0 @@
-*> \brief \b ILAPREC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILAPREC + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILAPREC( PREC )
-*
-* .. Scalar Arguments ..
-* CHARACTER PREC
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- INTEGER FUNCTION ILAPREC( PREC )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER PREC
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER BLAS_PREC_SINGLE, BLAS_PREC_DOUBLE, BLAS_PREC_INDIGENOUS,
- $ BLAS_PREC_EXTRA
- PARAMETER ( BLAS_PREC_SINGLE = 211, BLAS_PREC_DOUBLE = 212,
- $ BLAS_PREC_INDIGENOUS = 213, BLAS_PREC_EXTRA = 214 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
- IF( LSAME( PREC, 'S' ) ) THEN
- ILAPREC = BLAS_PREC_SINGLE
- ELSE IF( LSAME( PREC, 'D' ) ) THEN
- ILAPREC = BLAS_PREC_DOUBLE
- ELSE IF( LSAME( PREC, 'I' ) ) THEN
- ILAPREC = BLAS_PREC_INDIGENOUS
- ELSE IF( LSAME( PREC, 'X' ) .OR. LSAME( PREC, 'E' ) ) THEN
- ILAPREC = BLAS_PREC_EXTRA
- ELSE
- ILAPREC = -1
- END IF
- RETURN
-*
-* End of ILAPREC
-*
- END
diff --git a/mtx/lapack_src/ilaslc.f b/mtx/lapack_src/ilaslc.f
deleted file mode 100644
index e3db0f4ae..000000000
--- a/mtx/lapack_src/ilaslc.f
+++ /dev/null
@@ -1,118 +0,0 @@
-*> \brief \b ILASLC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILASLC + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILASLC( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILASLC scans A for its last non-zero column.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILASLC( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( N.EQ.0 ) THEN
- ILASLC = N
- ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILASLC = N
- ELSE
-* Now scan each column from the end, returning with the first non-zero.
- DO ILASLC = N, 1, -1
- DO I = 1, M
- IF( A(I, ILASLC).NE.ZERO ) RETURN
- END DO
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/lapack_src/ilaslr.f b/mtx/lapack_src/ilaslr.f
deleted file mode 100644
index 48b73f44d..000000000
--- a/mtx/lapack_src/ilaslr.f
+++ /dev/null
@@ -1,121 +0,0 @@
-*> \brief \b ILASLR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILASLR + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILASLR( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILASLR scans A for its last non-zero row.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup realOTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILASLR( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ZERO
- PARAMETER ( ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( M.EQ.0 ) THEN
- ILASLR = M
- ELSEIF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILASLR = M
- ELSE
-* Scan up each column tracking the last zero row seen.
- ILASLR = 0
- DO J = 1, N
- I=M
- DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
- I=I-1
- ENDDO
- ILASLR = MAX( ILASLR, I )
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/lapack_src/ilatrans.f b/mtx/lapack_src/ilatrans.f
deleted file mode 100644
index d8fc9bc64..000000000
--- a/mtx/lapack_src/ilatrans.f
+++ /dev/null
@@ -1,95 +0,0 @@
-*> \brief \b ILATRANS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILATRANS + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILATRANS( TRANS )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- INTEGER FUNCTION ILATRANS( TRANS )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER BLAS_NO_TRANS, BLAS_TRANS, BLAS_CONJ_TRANS
- PARAMETER ( BLAS_NO_TRANS = 111, BLAS_TRANS = 112,
- $ BLAS_CONJ_TRANS = 113 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
- IF( LSAME( TRANS, 'N' ) ) THEN
- ILATRANS = BLAS_NO_TRANS
- ELSE IF( LSAME( TRANS, 'T' ) ) THEN
- ILATRANS = BLAS_TRANS
- ELSE IF( LSAME( TRANS, 'C' ) ) THEN
- ILATRANS = BLAS_CONJ_TRANS
- ELSE
- ILATRANS = -1
- END IF
- RETURN
-*
-* End of ILATRANS
-*
- END
diff --git a/mtx/lapack_src/ilauplo.f b/mtx/lapack_src/ilauplo.f
deleted file mode 100644
index e65c103e7..000000000
--- a/mtx/lapack_src/ilauplo.f
+++ /dev/null
@@ -1,92 +0,0 @@
-*> \brief \b ILAUPLO
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILAUPLO + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILAUPLO( UPLO )
-*
-* .. Scalar Arguments ..
-* CHARACTER UPLO
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- INTEGER FUNCTION ILAUPLO( UPLO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER UPLO
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- INTEGER BLAS_UPPER, BLAS_LOWER
- PARAMETER ( BLAS_UPPER = 121, BLAS_LOWER = 122 )
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. Executable Statements ..
- IF( LSAME( UPLO, 'U' ) ) THEN
- ILAUPLO = BLAS_UPPER
- ELSE IF( LSAME( UPLO, 'L' ) ) THEN
- ILAUPLO = BLAS_LOWER
- ELSE
- ILAUPLO = -1
- END IF
- RETURN
-*
-* End of ILAUPLO
-*
- END
diff --git a/mtx/lapack_src/ilaver.f b/mtx/lapack_src/ilaver.f
deleted file mode 100644
index 56abb66a6..000000000
--- a/mtx/lapack_src/ilaver.f
+++ /dev/null
@@ -1,66 +0,0 @@
-*> \brief \b ILAVER returns the LAPACK version.
-**
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
-*
-* INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine returns the LAPACK version.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[out] VERS_MAJOR
-*> return the lapack major version
-*>
-*> \param[out] VERS_MINOR
-*> return the lapack minor version from the major version
-*>
-*> \param[out] VERS_PATCH
-*> return the lapack patch version from the minor version
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
-*
-* -- LAPACK computational routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* =====================================================================
-*
- INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH
-* =====================================================================
- VERS_MAJOR = 3
- VERS_MINOR = 4
- VERS_PATCH = 1
-* =====================================================================
-*
- RETURN
- END
diff --git a/mtx/lapack_src/ilazlc.f b/mtx/lapack_src/ilazlc.f
deleted file mode 100644
index 15b149022..000000000
--- a/mtx/lapack_src/ilazlc.f
+++ /dev/null
@@ -1,118 +0,0 @@
-*> \brief \b ILAZLC
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILAZLC + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILAZLC( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* COMPLEX*16 A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILAZLC scans A for its last non-zero column.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is COMPLEX*16 array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16OTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILAZLC( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- COMPLEX*16 A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX*16 ZERO
- PARAMETER ( ZERO = (0.0D+0, 0.0D+0) )
-* ..
-* .. Local Scalars ..
- INTEGER I
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( N.EQ.0 ) THEN
- ILAZLC = N
- ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILAZLC = N
- ELSE
-* Now scan each column from the end, returning with the first non-zero.
- DO ILAZLC = N, 1, -1
- DO I = 1, M
- IF( A(I, ILAZLC).NE.ZERO ) RETURN
- END DO
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/lapack_src/ilazlr.f b/mtx/lapack_src/ilazlr.f
deleted file mode 100644
index b2ab943ca..000000000
--- a/mtx/lapack_src/ilazlr.f
+++ /dev/null
@@ -1,121 +0,0 @@
-*> \brief \b ILAZLR
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ILAZLR + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION ILAZLR( M, N, A, LDA )
-*
-* .. Scalar Arguments ..
-* INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
-* COMPLEX*16 A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ILAZLR scans A for its last non-zero row.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is COMPLEX*16 array, dimension (LDA,N)
-*> The m by n matrix A.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date April 2012
-*
-*> \ingroup complex16OTHERauxiliary
-*
-* =====================================================================
- INTEGER FUNCTION ILAZLR( M, N, A, LDA )
-*
-* -- LAPACK auxiliary routine (version 3.4.1) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* April 2012
-*
-* .. Scalar Arguments ..
- INTEGER M, N, LDA
-* ..
-* .. Array Arguments ..
- COMPLEX*16 A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX*16 ZERO
- PARAMETER ( ZERO = (0.0D+0, 0.0D+0) )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
-* ..
-* .. Executable Statements ..
-*
-* Quick test for the common case where one corner is non-zero.
- IF( M.EQ.0 ) THEN
- ILAZLR = M
- ELSE IF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
- ILAZLR = M
- ELSE
-* Scan up each column tracking the last zero row seen.
- ILAZLR = 0
- DO J = 1, N
- I=M
- DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
- I=I-1
- ENDDO
- ILAZLR = MAX( ILAZLR, I )
- END DO
- END IF
- RETURN
- END
diff --git a/mtx/lapack_src/iparmq.f b/mtx/lapack_src/iparmq.f
deleted file mode 100644
index bd5bd7a0d..000000000
--- a/mtx/lapack_src/iparmq.f
+++ /dev/null
@@ -1,322 +0,0 @@
-*> \brief \b IPARMQ
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download IPARMQ + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION IPARMQ( ISPEC, NAME, OPTS, N, ILO, IHI, LWORK )
-*
-* .. Scalar Arguments ..
-* INTEGER IHI, ILO, ISPEC, LWORK, N
-* CHARACTER NAME*( * ), OPTS*( * )
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This program sets problem and machine dependent parameters
-*> useful for xHSEQR and its subroutines. It is called whenever
-*> ILAENV is called with 12 <= ISPEC <= 16
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ISPEC
-*> \verbatim
-*> ISPEC is integer scalar
-*> ISPEC specifies which tunable parameter IPARMQ should
-*> return.
-*>
-*> ISPEC=12: (INMIN) Matrices of order nmin or less
-*> are sent directly to xLAHQR, the implicit
-*> double shift QR algorithm. NMIN must be
-*> at least 11.
-*>
-*> ISPEC=13: (INWIN) Size of the deflation window.
-*> This is best set greater than or equal to
-*> the number of simultaneous shifts NS.
-*> Larger matrices benefit from larger deflation
-*> windows.
-*>
-*> ISPEC=14: (INIBL) Determines when to stop nibbling and
-*> invest in an (expensive) multi-shift QR sweep.
-*> If the aggressive early deflation subroutine
-*> finds LD converged eigenvalues from an order
-*> NW deflation window and LD.GT.(NW*NIBBLE)/100,
-*> then the next QR sweep is skipped and early
-*> deflation is applied immediately to the
-*> remaining active diagonal block. Setting
-*> IPARMQ(ISPEC=14) = 0 causes TTQRE to skip a
-*> multi-shift QR sweep whenever early deflation
-*> finds a converged eigenvalue. Setting
-*> IPARMQ(ISPEC=14) greater than or equal to 100
-*> prevents TTQRE from skipping a multi-shift
-*> QR sweep.
-*>
-*> ISPEC=15: (NSHFTS) The number of simultaneous shifts in
-*> a multi-shift QR iteration.
-*>
-*> ISPEC=16: (IACC22) IPARMQ is set to 0, 1 or 2 with the
-*> following meanings.
-*> 0: During the multi-shift QR sweep,
-*> xLAQR5 does not accumulate reflections and
-*> does not use matrix-matrix multiply to
-*> update the far-from-diagonal matrix
-*> entries.
-*> 1: During the multi-shift QR sweep,
-*> xLAQR5 and/or xLAQRaccumulates reflections and uses
-*> matrix-matrix multiply to update the
-*> far-from-diagonal matrix entries.
-*> 2: During the multi-shift QR sweep.
-*> xLAQR5 accumulates reflections and takes
-*> advantage of 2-by-2 block structure during
-*> matrix-matrix multiplies.
-*> (If xTRMM is slower than xGEMM, then
-*> IPARMQ(ISPEC=16)=1 may be more efficient than
-*> IPARMQ(ISPEC=16)=2 despite the greater level of
-*> arithmetic work implied by the latter choice.)
-*> \endverbatim
-*>
-*> \param[in] NAME
-*> \verbatim
-*> NAME is character string
-*> Name of the calling subroutine
-*> \endverbatim
-*>
-*> \param[in] OPTS
-*> \verbatim
-*> OPTS is character string
-*> This is a concatenation of the string arguments to
-*> TTQRE.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is integer scalar
-*> N is the order of the Hessenberg matrix H.
-*> \endverbatim
-*>
-*> \param[in] ILO
-*> \verbatim
-*> ILO is INTEGER
-*> \endverbatim
-*>
-*> \param[in] IHI
-*> \verbatim
-*> IHI is INTEGER
-*> It is assumed that H is already upper triangular
-*> in rows and columns 1:ILO-1 and IHI+1:N.
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*> LWORK is integer scalar
-*> The amount of workspace available.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup auxOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Little is known about how best to choose these parameters.
-*> It is possible to use different values of the parameters
-*> for each of CHSEQR, DHSEQR, SHSEQR and ZHSEQR.
-*>
-*> It is probably best to choose different parameters for
-*> different matrices and different parameters at different
-*> times during the iteration, but this has not been
-*> implemented --- yet.
-*>
-*>
-*> The best choices of most of the parameters depend
-*> in an ill-understood way on the relative execution
-*> rate of xLAQR3 and xLAQR5 and on the nature of each
-*> particular eigenvalue problem. Experiment may be the
-*> only practical way to determine which choices are most
-*> effective.
-*>
-*> Following is a list of default values supplied by IPARMQ.
-*> These defaults may be adjusted in order to attain better
-*> performance in any particular computational environment.
-*>
-*> IPARMQ(ISPEC=12) The xLAHQR vs xLAQR0 crossover point.
-*> Default: 75. (Must be at least 11.)
-*>
-*> IPARMQ(ISPEC=13) Recommended deflation window size.
-*> This depends on ILO, IHI and NS, the
-*> number of simultaneous shifts returned
-*> by IPARMQ(ISPEC=15). The default for
-*> (IHI-ILO+1).LE.500 is NS. The default
-*> for (IHI-ILO+1).GT.500 is 3*NS/2.
-*>
-*> IPARMQ(ISPEC=14) Nibble crossover point. Default: 14.
-*>
-*> IPARMQ(ISPEC=15) Number of simultaneous shifts, NS.
-*> a multi-shift QR iteration.
-*>
-*> If IHI-ILO+1 is ...
-*>
-*> greater than ...but less ... the
-*> or equal to ... than default is
-*>
-*> 0 30 NS = 2+
-*> 30 60 NS = 4+
-*> 60 150 NS = 10
-*> 150 590 NS = **
-*> 590 3000 NS = 64
-*> 3000 6000 NS = 128
-*> 6000 infinity NS = 256
-*>
-*> (+) By default matrices of this order are
-*> passed to the implicit double shift routine
-*> xLAHQR. See IPARMQ(ISPEC=12) above. These
-*> values of NS are used only in case of a rare
-*> xLAHQR failure.
-*>
-*> (**) The asterisks (**) indicate an ad-hoc
-*> function increasing from 10 to 64.
-*>
-*> IPARMQ(ISPEC=16) Select structured matrix multiply.
-*> (See ISPEC=16 above for details.)
-*> Default: 3.
-*> \endverbatim
-*>
-* =====================================================================
- INTEGER FUNCTION IPARMQ( ISPEC, NAME, OPTS, N, ILO, IHI, LWORK )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER IHI, ILO, ISPEC, LWORK, N
- CHARACTER NAME*( * ), OPTS*( * )
-*
-* ================================================================
-* .. Parameters ..
- INTEGER INMIN, INWIN, INIBL, ISHFTS, IACC22
- PARAMETER ( INMIN = 12, INWIN = 13, INIBL = 14,
- $ ISHFTS = 15, IACC22 = 16 )
- INTEGER NMIN, K22MIN, KACMIN, NIBBLE, KNWSWP
- PARAMETER ( NMIN = 75, K22MIN = 14, KACMIN = 14,
- $ NIBBLE = 14, KNWSWP = 500 )
- REAL TWO
- PARAMETER ( TWO = 2.0 )
-* ..
-* .. Local Scalars ..
- INTEGER NH, NS
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC LOG, MAX, MOD, NINT, REAL
-* ..
-* .. Executable Statements ..
- IF( ( ISPEC.EQ.ISHFTS ) .OR. ( ISPEC.EQ.INWIN ) .OR.
- $ ( ISPEC.EQ.IACC22 ) ) THEN
-*
-* ==== Set the number simultaneous shifts ====
-*
- NH = IHI - ILO + 1
- NS = 2
- IF( NH.GE.30 )
- $ NS = 4
- IF( NH.GE.60 )
- $ NS = 10
- IF( NH.GE.150 )
- $ NS = MAX( 10, NH / NINT( LOG( REAL( NH ) ) / LOG( TWO ) ) )
- IF( NH.GE.590 )
- $ NS = 64
- IF( NH.GE.3000 )
- $ NS = 128
- IF( NH.GE.6000 )
- $ NS = 256
- NS = MAX( 2, NS-MOD( NS, 2 ) )
- END IF
-*
- IF( ISPEC.EQ.INMIN ) THEN
-*
-*
-* ===== Matrices of order smaller than NMIN get sent
-* . to xLAHQR, the classic double shift algorithm.
-* . This must be at least 11. ====
-*
- IPARMQ = NMIN
-*
- ELSE IF( ISPEC.EQ.INIBL ) THEN
-*
-* ==== INIBL: skip a multi-shift qr iteration and
-* . whenever aggressive early deflation finds
-* . at least (NIBBLE*(window size)/100) deflations. ====
-*
- IPARMQ = NIBBLE
-*
- ELSE IF( ISPEC.EQ.ISHFTS ) THEN
-*
-* ==== NSHFTS: The number of simultaneous shifts =====
-*
- IPARMQ = NS
-*
- ELSE IF( ISPEC.EQ.INWIN ) THEN
-*
-* ==== NW: deflation window size. ====
-*
- IF( NH.LE.KNWSWP ) THEN
- IPARMQ = NS
- ELSE
- IPARMQ = 3*NS / 2
- END IF
-*
- ELSE IF( ISPEC.EQ.IACC22 ) THEN
-*
-* ==== IACC22: Whether to accumulate reflections
-* . before updating the far-from-diagonal elements
-* . and whether to use 2-by-2 block structure while
-* . doing it. A small amount of work could be saved
-* . by making this choice dependent also upon the
-* . NH=IHI-ILO+1.
-*
- IPARMQ = 0
- IF( NS.GE.KACMIN )
- $ IPARMQ = 1
- IF( NS.GE.K22MIN )
- $ IPARMQ = 2
-*
- ELSE
-* ===== invalid value of ispec =====
- IPARMQ = -1
-*
- END IF
-*
-* ==== End of IPARMQ ====
-*
- END
diff --git a/mtx/lapack_src/izamax.f b/mtx/lapack_src/izamax.f
deleted file mode 100644
index 9bd7fdd4c..000000000
--- a/mtx/lapack_src/izamax.f
+++ /dev/null
@@ -1,55 +0,0 @@
- INTEGER FUNCTION IZAMAX(N,ZX,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- DOUBLE COMPLEX ZX(*)
-* ..
-*
-* Purpose
-* =======
-*
-* finds the index of element having max. absolute value.
-* jack dongarra, 1/15/85.
-* modified 3/93 to return if incx .le. 0.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-*
-* .. Local Scalars ..
- DOUBLE PRECISION SMAX
- INTEGER I,IX
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DCABS1
- EXTERNAL DCABS1
-* ..
- IZAMAX = 0
- IF (N.LT.1 .OR. INCX.LE.0) RETURN
- IZAMAX = 1
- IF (N.EQ.1) RETURN
- IF (INCX.EQ.1) GO TO 20
-*
-* code for increment not equal to 1
-*
- IX = 1
- SMAX = DCABS1(ZX(1))
- IX = IX + INCX
- DO 10 I = 2,N
- IF (DCABS1(ZX(IX)).LE.SMAX) GO TO 5
- IZAMAX = I
- SMAX = DCABS1(ZX(IX))
- 5 IX = IX + INCX
- 10 CONTINUE
- RETURN
-*
-* code for increment equal to 1
-*
- 20 SMAX = DCABS1(ZX(1))
- DO 30 I = 2,N
- IF (DCABS1(ZX(I)).LE.SMAX) GO TO 30
- IZAMAX = I
- SMAX = DCABS1(ZX(I))
- 30 CONTINUE
- RETURN
- END
-
diff --git a/mtx/lapack_src/izmax1.f b/mtx/lapack_src/izmax1.f
deleted file mode 100644
index a156c923f..000000000
--- a/mtx/lapack_src/izmax1.f
+++ /dev/null
@@ -1,154 +0,0 @@
-*> \brief \b IZMAX1
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download IZMAX1 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* INTEGER FUNCTION IZMAX1( N, CX, INCX )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* ..
-* .. Array Arguments ..
-* COMPLEX*16 CX( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> IZMAX1 finds the index of the element whose real part has maximum
-*> absolute value.
-*>
-*> Based on IZAMAX from Level 1 BLAS.
-*> The change is to use the 'genuine' absolute value.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of elements in the vector CX.
-*> \endverbatim
-*>
-*> \param[in] CX
-*> \verbatim
-*> CX is COMPLEX*16 array, dimension (N)
-*> The vector whose elements will be summed.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The spacing between successive values of CX. INCX >= 1.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16OTHERauxiliary
-*
-*> \par Contributors:
-* ==================
-*>
-*> Nick Higham for use with ZLACON.
-*
-* =====================================================================
- INTEGER FUNCTION IZMAX1( N, CX, INCX )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
-* ..
-* .. Array Arguments ..
- COMPLEX*16 CX( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IX
- DOUBLE PRECISION SMAX
- COMPLEX*16 ZDUM
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS
-* ..
-* .. Statement Functions ..
- DOUBLE PRECISION CABS1
-* ..
-* .. Statement Function definitions ..
-*
-* NEXT LINE IS THE ONLY MODIFICATION.
- CABS1( ZDUM ) = ABS( ZDUM )
-* ..
-* .. Executable Statements ..
-*
- IZMAX1 = 0
- IF( N.LT.1 )
- $ RETURN
- IZMAX1 = 1
- IF( N.EQ.1 )
- $ RETURN
- IF( INCX.EQ.1 )
- $ GO TO 30
-*
-* CODE FOR INCREMENT NOT EQUAL TO 1
-*
- IX = 1
- SMAX = CABS1( CX( 1 ) )
- IX = IX + INCX
- DO 20 I = 2, N
- IF( CABS1( CX( IX ) ).LE.SMAX )
- $ GO TO 10
- IZMAX1 = I
- SMAX = CABS1( CX( IX ) )
- 10 CONTINUE
- IX = IX + INCX
- 20 CONTINUE
- RETURN
-*
-* CODE FOR INCREMENT EQUAL TO 1
-*
- 30 CONTINUE
- SMAX = CABS1( CX( 1 ) )
- DO 40 I = 2, N
- IF( CABS1( CX( I ) ).LE.SMAX )
- $ GO TO 40
- IZMAX1 = I
- SMAX = CABS1( CX( I ) )
- 40 CONTINUE
- RETURN
-*
-* End of IZMAX1
-*
- END
diff --git a/mtx/lapack_src/sgesv.f b/mtx/lapack_src/sgesv.f
deleted file mode 100644
index 40509d3cd..000000000
--- a/mtx/lapack_src/sgesv.f
+++ /dev/null
@@ -1,179 +0,0 @@
-*> \brief SGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver)
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGESV + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of linear equations, i.e., the order of the
-*> matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the N-by-N coefficient matrix A.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U; the unit diagonal elements of L are not stored.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices that define the permutation matrix P;
-*> row i of the matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the N-by-NRHS matrix of right hand side matrix B.
-*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, so the solution could not be computed.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEsolve
-*
-* =====================================================================
- SUBROUTINE SGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* -- LAPACK driver routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. External Subroutines ..
- EXTERNAL SGETRF, SGETRS, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -4
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -7
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGESV ', -INFO )
- RETURN
- END IF
-*
-* Compute the LU factorization of A.
-*
- CALL SGETRF( N, N, A, LDA, IPIV, INFO )
- IF( INFO.EQ.0 ) THEN
-*
-* Solve the system A*X = B, overwriting B with X.
-*
- CALL SGETRS( 'No transpose', N, NRHS, A, LDA, IPIV, B, LDB,
- $ INFO )
- END IF
- RETURN
-*
-* End of SGESV
-*
- END
diff --git a/mtx/lapack_src/sgetf2.f b/mtx/lapack_src/sgetf2.f
deleted file mode 100644
index 0cab948b5..000000000
--- a/mtx/lapack_src/sgetf2.f
+++ /dev/null
@@ -1,213 +0,0 @@
-*> \brief \b SGETF2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGETF2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGETF2( M, N, A, LDA, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the m by n matrix to be factored.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U; the unit diagonal elements of L are not stored.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, U(k,k) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGETF2( M, N, A, LDA, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE, ZERO
- PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-* ..
-* .. Local Scalars ..
- REAL SFMIN
- INTEGER I, J, JP
-* ..
-* .. External Functions ..
- REAL SLAMCH
- INTEGER ISAMAX
- EXTERNAL SLAMCH, ISAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL SGER, SSCAL, SSWAP, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGETF2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Compute machine safe minimum
-*
- SFMIN = SLAMCH('S')
-*
- DO 10 J = 1, MIN( M, N )
-*
-* Find pivot and test for singularity.
-*
- JP = J - 1 + ISAMAX( M-J+1, A( J, J ), 1 )
- IPIV( J ) = JP
- IF( A( JP, J ).NE.ZERO ) THEN
-*
-* Apply the interchange to columns 1:N.
-*
- IF( JP.NE.J )
- $ CALL SSWAP( N, A( J, 1 ), LDA, A( JP, 1 ), LDA )
-*
-* Compute elements J+1:M of J-th column.
-*
- IF( J.LT.M ) THEN
- IF( ABS(A( J, J )) .GE. SFMIN ) THEN
- CALL SSCAL( M-J, ONE / A( J, J ), A( J+1, J ), 1 )
- ELSE
- DO 20 I = 1, M-J
- A( J+I, J ) = A( J+I, J ) / A( J, J )
- 20 CONTINUE
- END IF
- END IF
-*
- ELSE IF( INFO.EQ.0 ) THEN
-*
- INFO = J
- END IF
-*
- IF( J.LT.MIN( M, N ) ) THEN
-*
-* Update trailing submatrix.
-*
- CALL SGER( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ), LDA,
- $ A( J+1, J+1 ), LDA )
- END IF
- 10 CONTINUE
- RETURN
-*
-* End of SGETF2
-*
- END
diff --git a/mtx/lapack_src/sgetrf.f b/mtx/lapack_src/sgetrf.f
deleted file mode 100644
index b7ac344de..000000000
--- a/mtx/lapack_src/sgetrf.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b SGETRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGETRF + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGETRF( M, N, A, LDA, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the M-by-N matrix to be factored.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U; the unit diagonal elements of L are not stored.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGETRF( M, N, A, LDA, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, IINFO, J, JB, NB
-* ..
-* .. External Subroutines ..
- EXTERNAL SGEMM, SGETF2, SLASWP, STRSM, XERBLA
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGETRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'SGETRF', ' ', M, N, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN
-*
-* Use unblocked code.
-*
- CALL SGETF2( M, N, A, LDA, IPIV, INFO )
- ELSE
-*
-* Use blocked code.
-*
- DO 20 J = 1, MIN( M, N ), NB
- JB = MIN( MIN( M, N )-J+1, NB )
-*
-* Factor diagonal and subdiagonal blocks and test for exact
-* singularity.
-*
- CALL SGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
-*
-* Adjust INFO and the pivot indices.
-*
- IF( INFO.EQ.0 .AND. IINFO.GT.0 )
- $ INFO = IINFO + J - 1
- DO 10 I = J, MIN( M, J+JB-1 )
- IPIV( I ) = J - 1 + IPIV( I )
- 10 CONTINUE
-*
-* Apply interchanges to columns 1:J-1.
-*
- CALL SLASWP( J-1, A, LDA, J, J+JB-1, IPIV, 1 )
-*
- IF( J+JB.LE.N ) THEN
-*
-* Apply interchanges to columns J+JB:N.
-*
- CALL SLASWP( N-J-JB+1, A( 1, J+JB ), LDA, J, J+JB-1,
- $ IPIV, 1 )
-*
-* Compute block row of U.
-*
- CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB,
- $ N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ),
- $ LDA )
- IF( J+JB.LE.M ) THEN
-*
-* Update trailing submatrix.
-*
- CALL SGEMM( 'No transpose', 'No transpose', M-J-JB+1,
- $ N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA,
- $ A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ),
- $ LDA )
- END IF
- END IF
- 20 CONTINUE
- END IF
- RETURN
-*
-* End of SGETRF
-*
- END
diff --git a/mtx/lapack_src/sgetrs.f b/mtx/lapack_src/sgetrs.f
deleted file mode 100644
index caa45670c..000000000
--- a/mtx/lapack_src/sgetrs.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b SGETRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SGETRS + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T* X = B (Transpose)
-*> = 'C': A**T* X = B (Conjugate transpose = Transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> The factors L and U from the factorization A = P*L*U
-*> as computed by SGETRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from SGETRF; for 1<=i<=N, row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is REAL array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realGEcomputational
-*
-* =====================================================================
- SUBROUTINE SGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- REAL ONE
- PARAMETER ( ONE = 1.0E+0 )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL SLASWP, STRSM, XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'SGETRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( NOTRAN ) THEN
-*
-* Solve A * X = B.
-*
-* Apply row interchanges to the right hand sides.
-*
- CALL SLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
-*
-* Solve L*X = B, overwriting B with X.
-*
- CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
- $ ONE, A, LDA, B, LDB )
-*
-* Solve U*X = B, overwriting B with X.
-*
- CALL STRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
- $ NRHS, ONE, A, LDA, B, LDB )
- ELSE
-*
-* Solve A**T * X = B.
-*
-* Solve U**T *X = B, overwriting B with X.
-*
- CALL STRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS,
- $ ONE, A, LDA, B, LDB )
-*
-* Solve L**T *X = B, overwriting B with X.
-*
- CALL STRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, ONE,
- $ A, LDA, B, LDB )
-*
-* Apply row interchanges to the solution vectors.
-*
- CALL SLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
- END IF
-*
- RETURN
-*
-* End of SGETRS
-*
- END
diff --git a/mtx/lapack_src/slaswp.f b/mtx/lapack_src/slaswp.f
deleted file mode 100644
index 6fba8d624..000000000
--- a/mtx/lapack_src/slaswp.f
+++ /dev/null
@@ -1,191 +0,0 @@
-*> \brief \b SLASWP
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download SLASWP + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE SLASWP( N, A, LDA, K1, K2, IPIV, INCX )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, K1, K2, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* REAL A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the matrix of column dimension N to which the row
-*> interchanges will be applied.
-*> On exit, the permuted matrix.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> \endverbatim
-*>
-*> \param[in] K1
-*> \verbatim
-*> K1 is INTEGER
-*> The first element of IPIV for which a row interchange will
-*> be done.
-*> \endverbatim
-*>
-*> \param[in] K2
-*> \verbatim
-*> K2 is INTEGER
-*> The last element of IPIV for which a row interchange will
-*> be done.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (K2*abs(INCX))
-*> The vector of pivot indices. Only the elements in positions
-*> K1 through K2 of IPIV are accessed.
-*> IPIV(K) = L implies rows K and L are to be interchanged.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between successive values of IPIV. If IPIV
-*> is negative, the pivots are applied in reverse order.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup realOTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Modified by
-*> R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE SLASWP( N, A, LDA, K1, K2, IPIV, INCX )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX, K1, K2, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- REAL A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, I1, I2, INC, IP, IX, IX0, J, K, N32
- REAL TEMP
-* ..
-* .. Executable Statements ..
-*
-* Interchange row I with row IPIV(I) for each of rows K1 through K2.
-*
- IF( INCX.GT.0 ) THEN
- IX0 = K1
- I1 = K1
- I2 = K2
- INC = 1
- ELSE IF( INCX.LT.0 ) THEN
- IX0 = 1 + ( 1-K2 )*INCX
- I1 = K2
- I2 = K1
- INC = -1
- ELSE
- RETURN
- END IF
-*
- N32 = ( N / 32 )*32
- IF( N32.NE.0 ) THEN
- DO 30 J = 1, N32, 32
- IX = IX0
- DO 20 I = I1, I2, INC
- IP = IPIV( IX )
- IF( IP.NE.I ) THEN
- DO 10 K = J, J + 31
- TEMP = A( I, K )
- A( I, K ) = A( IP, K )
- A( IP, K ) = TEMP
- 10 CONTINUE
- END IF
- IX = IX + INCX
- 20 CONTINUE
- 30 CONTINUE
- END IF
- IF( N32.NE.N ) THEN
- N32 = N32 + 1
- IX = IX0
- DO 50 I = I1, I2, INC
- IP = IPIV( IX )
- IF( IP.NE.I ) THEN
- DO 40 K = N32, N
- TEMP = A( I, K )
- A( I, K ) = A( IP, K )
- A( IP, K ) = TEMP
- 40 CONTINUE
- END IF
- IX = IX + INCX
- 50 CONTINUE
- END IF
-*
- RETURN
-*
-* End of SLASWP
-*
- END
diff --git a/mtx/lapack_src/zcopy.f b/mtx/lapack_src/zcopy.f
deleted file mode 100644
index f9a264f3d..000000000
--- a/mtx/lapack_src/zcopy.f
+++ /dev/null
@@ -1,44 +0,0 @@
- SUBROUTINE ZCOPY(N,ZX,INCX,ZY,INCY)
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- DOUBLE COMPLEX ZX(*),ZY(*)
-* ..
-*
-* Purpose
-* =======
-*
-* copies a vector, x, to a vector, y.
-* jack dongarra, linpack, 4/11/78.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-*
-* .. Local Scalars ..
- INTEGER I,IX,IY
-* ..
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20
-*
-* code for unequal increments or equal increments
-* not equal to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO 10 I = 1,N
- ZY(IY) = ZX(IX)
- IX = IX + INCX
- IY = IY + INCY
- 10 CONTINUE
- RETURN
-*
-* code for both increments equal to 1
-*
- 20 DO 30 I = 1,N
- ZY(I) = ZX(I)
- 30 CONTINUE
- RETURN
- END
-
diff --git a/mtx/lapack_src/zgbtf2.f b/mtx/lapack_src/zgbtf2.f
deleted file mode 100644
index 508314c65..000000000
--- a/mtx/lapack_src/zgbtf2.f
+++ /dev/null
@@ -1,277 +0,0 @@
-*> \brief \b ZGBTF2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ZGBTF2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* COMPLEX*16 AB( LDAB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is COMPLEX*16 array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows KL+1 to
-*> 2*KL+KU+1; rows 1 to KL of the array need not be set.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
-*>
-*> On exit, details of the factorization: U is stored as an
-*> upper triangular band matrix with KL+KU superdiagonals in
-*> rows 1 to KL+KU+1, and the multipliers used during the
-*> factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16GBcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> M = N = 6, KL = 2, KU = 1:
-*>
-*> On entry: On exit:
-*>
-*> * * * + + + * * * u14 u25 u36
-*> * * + + + + * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*> a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
-*> a31 a42 a53 a64 * * m31 m42 m53 m64 * *
-*>
-*> Array elements marked * are not used by the routine; elements marked
-*> + need not be set on entry, but are required by the routine to store
-*> elements of U, because of fill-in resulting from the row
-*> interchanges.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE ZGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- COMPLEX*16 AB( LDAB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX*16 ONE, ZERO
- PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
- $ ZERO = ( 0.0D+0, 0.0D+0 ) )
-* ..
-* .. Local Scalars ..
- INTEGER I, J, JP, JU, KM, KV
-* ..
-* .. External Functions ..
- INTEGER IZAMAX
- EXTERNAL IZAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, ZGERU, ZSCAL, ZSWAP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* KV is the number of superdiagonals in the factor U, allowing for
-* fill-in.
-*
- KV = KU + KL
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KL+KV+1 ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'ZGBTF2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Gaussian elimination with partial pivoting
-*
-* Set fill-in elements in columns KU+2 to KV to zero.
-*
- DO 20 J = KU + 2, MIN( KV, N )
- DO 10 I = KV - J + 2, KL
- AB( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
-*
-* JU is the index of the last column affected by the current stage
-* of the factorization.
-*
- JU = 1
-*
- DO 40 J = 1, MIN( M, N )
-*
-* Set fill-in elements in column J+KV to zero.
-*
- IF( J+KV.LE.N ) THEN
- DO 30 I = 1, KL
- AB( I, J+KV ) = ZERO
- 30 CONTINUE
- END IF
-*
-* Find pivot and test for singularity. KM is the number of
-* subdiagonal elements in the current column.
-*
- KM = MIN( KL, M-J )
- JP = IZAMAX( KM+1, AB( KV+1, J ), 1 )
- IPIV( J ) = JP + J - 1
- IF( AB( KV+JP, J ).NE.ZERO ) THEN
- JU = MAX( JU, MIN( J+KU+JP-1, N ) )
-*
-* Apply interchange to columns J to JU.
-*
- IF( JP.NE.1 )
- $ CALL ZSWAP( JU-J+1, AB( KV+JP, J ), LDAB-1,
- $ AB( KV+1, J ), LDAB-1 )
- IF( KM.GT.0 ) THEN
-*
-* Compute multipliers.
-*
- CALL ZSCAL( KM, ONE / AB( KV+1, J ), AB( KV+2, J ), 1 )
-*
-* Update trailing submatrix within the band.
-*
- IF( JU.GT.J )
- $ CALL ZGERU( KM, JU-J, -ONE, AB( KV+2, J ), 1,
- $ AB( KV, J+1 ), LDAB-1, AB( KV+1, J+1 ),
- $ LDAB-1 )
- END IF
- ELSE
-*
-* If pivot is zero, set INFO to the index of the pivot
-* unless a zero pivot has already been found.
-*
- IF( INFO.EQ.0 )
- $ INFO = J
- END IF
- 40 CONTINUE
- RETURN
-*
-* End of ZGBTF2
-*
- END
diff --git a/mtx/lapack_src/zgbtrf.f b/mtx/lapack_src/zgbtrf.f
deleted file mode 100644
index bbdd986d4..000000000
--- a/mtx/lapack_src/zgbtrf.f
+++ /dev/null
@@ -1,517 +0,0 @@
-*> \brief \b ZGBTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ZGBTRF + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* COMPLEX*16 AB( LDAB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] AB
-*> \verbatim
-*> AB is COMPLEX*16 array, dimension (LDAB,N)
-*> On entry, the matrix A in band storage, in rows KL+1 to
-*> 2*KL+KU+1; rows 1 to KL of the array need not be set.
-*> The j-th column of A is stored in the j-th column of the
-*> array AB as follows:
-*> AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
-*>
-*> On exit, details of the factorization: U is stored as an
-*> upper triangular band matrix with KL+KU superdiagonals in
-*> rows 1 to KL+KU+1, and the multipliers used during the
-*> factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
-*> See below for further details.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = +i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16GBcomputational
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> The band storage scheme is illustrated by the following example, when
-*> M = N = 6, KL = 2, KU = 1:
-*>
-*> On entry: On exit:
-*>
-*> * * * + + + * * * u14 u25 u36
-*> * * + + + + * * u13 u24 u35 u46
-*> * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-*> a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-*> a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
-*> a31 a42 a53 a64 * * m31 m42 m53 m64 * *
-*>
-*> Array elements marked * are not used by the routine; elements marked
-*> + need not be set on entry, but are required by the routine to store
-*> elements of U because of fill-in resulting from the row interchanges.
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE ZGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, KL, KU, LDAB, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- COMPLEX*16 AB( LDAB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX*16 ONE, ZERO
- PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
- $ ZERO = ( 0.0D+0, 0.0D+0 ) )
- INTEGER NBMAX, LDWORK
- PARAMETER ( NBMAX = 64, LDWORK = NBMAX+1 )
-* ..
-* .. Local Scalars ..
- INTEGER I, I2, I3, II, IP, J, J2, J3, JB, JJ, JM, JP,
- $ JU, K2, KM, KV, NB, NW
- COMPLEX*16 TEMP
-* ..
-* .. Local Arrays ..
- COMPLEX*16 WORK13( LDWORK, NBMAX ),
- $ WORK31( LDWORK, NBMAX )
-* ..
-* .. External Functions ..
- INTEGER ILAENV, IZAMAX
- EXTERNAL ILAENV, IZAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, ZCOPY, ZGBTF2, ZGEMM, ZGERU, ZLASWP,
- $ ZSCAL, ZSWAP, ZTRSM
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* KV is the number of superdiagonals in the factor U, allowing for
-* fill-in
-*
- KV = KU + KL
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( LDAB.LT.KL+KV+1 ) THEN
- INFO = -6
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'ZGBTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment
-*
- NB = ILAENV( 1, 'ZGBTRF', ' ', M, N, KL, KU )
-*
-* The block size must not exceed the limit set by the size of the
-* local arrays WORK13 and WORK31.
-*
- NB = MIN( NB, NBMAX )
-*
- IF( NB.LE.1 .OR. NB.GT.KL ) THEN
-*
-* Use unblocked code
-*
- CALL ZGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO )
- ELSE
-*
-* Use blocked code
-*
-* Zero the superdiagonal elements of the work array WORK13
-*
- DO 20 J = 1, NB
- DO 10 I = 1, J - 1
- WORK13( I, J ) = ZERO
- 10 CONTINUE
- 20 CONTINUE
-*
-* Zero the subdiagonal elements of the work array WORK31
-*
- DO 40 J = 1, NB
- DO 30 I = J + 1, NB
- WORK31( I, J ) = ZERO
- 30 CONTINUE
- 40 CONTINUE
-*
-* Gaussian elimination with partial pivoting
-*
-* Set fill-in elements in columns KU+2 to KV to zero
-*
- DO 60 J = KU + 2, MIN( KV, N )
- DO 50 I = KV - J + 2, KL
- AB( I, J ) = ZERO
- 50 CONTINUE
- 60 CONTINUE
-*
-* JU is the index of the last column affected by the current
-* stage of the factorization
-*
- JU = 1
-*
- DO 180 J = 1, MIN( M, N ), NB
- JB = MIN( NB, MIN( M, N )-J+1 )
-*
-* The active part of the matrix is partitioned
-*
-* A11 A12 A13
-* A21 A22 A23
-* A31 A32 A33
-*
-* Here A11, A21 and A31 denote the current block of JB columns
-* which is about to be factorized. The number of rows in the
-* partitioning are JB, I2, I3 respectively, and the numbers
-* of columns are JB, J2, J3. The superdiagonal elements of A13
-* and the subdiagonal elements of A31 lie outside the band.
-*
- I2 = MIN( KL-JB, M-J-JB+1 )
- I3 = MIN( JB, M-J-KL+1 )
-*
-* J2 and J3 are computed after JU has been updated.
-*
-* Factorize the current block of JB columns
-*
- DO 80 JJ = J, J + JB - 1
-*
-* Set fill-in elements in column JJ+KV to zero
-*
- IF( JJ+KV.LE.N ) THEN
- DO 70 I = 1, KL
- AB( I, JJ+KV ) = ZERO
- 70 CONTINUE
- END IF
-*
-* Find pivot and test for singularity. KM is the number of
-* subdiagonal elements in the current column.
-*
- KM = MIN( KL, M-JJ )
- JP = IZAMAX( KM+1, AB( KV+1, JJ ), 1 )
- IPIV( JJ ) = JP + JJ - J
- IF( AB( KV+JP, JJ ).NE.ZERO ) THEN
- JU = MAX( JU, MIN( JJ+KU+JP-1, N ) )
- IF( JP.NE.1 ) THEN
-*
-* Apply interchange to columns J to J+JB-1
-*
- IF( JP+JJ-1.LT.J+KL ) THEN
-*
- CALL ZSWAP( JB, AB( KV+1+JJ-J, J ), LDAB-1,
- $ AB( KV+JP+JJ-J, J ), LDAB-1 )
- ELSE
-*
-* The interchange affects columns J to JJ-1 of A31
-* which are stored in the work array WORK31
-*
- CALL ZSWAP( JJ-J, AB( KV+1+JJ-J, J ), LDAB-1,
- $ WORK31( JP+JJ-J-KL, 1 ), LDWORK )
- CALL ZSWAP( J+JB-JJ, AB( KV+1, JJ ), LDAB-1,
- $ AB( KV+JP, JJ ), LDAB-1 )
- END IF
- END IF
-*
-* Compute multipliers
-*
- CALL ZSCAL( KM, ONE / AB( KV+1, JJ ), AB( KV+2, JJ ),
- $ 1 )
-*
-* Update trailing submatrix within the band and within
-* the current block. JM is the index of the last column
-* which needs to be updated.
-*
- JM = MIN( JU, J+JB-1 )
- IF( JM.GT.JJ )
- $ CALL ZGERU( KM, JM-JJ, -ONE, AB( KV+2, JJ ), 1,
- $ AB( KV, JJ+1 ), LDAB-1,
- $ AB( KV+1, JJ+1 ), LDAB-1 )
- ELSE
-*
-* If pivot is zero, set INFO to the index of the pivot
-* unless a zero pivot has already been found.
-*
- IF( INFO.EQ.0 )
- $ INFO = JJ
- END IF
-*
-* Copy current column of A31 into the work array WORK31
-*
- NW = MIN( JJ-J+1, I3 )
- IF( NW.GT.0 )
- $ CALL ZCOPY( NW, AB( KV+KL+1-JJ+J, JJ ), 1,
- $ WORK31( 1, JJ-J+1 ), 1 )
- 80 CONTINUE
- IF( J+JB.LE.N ) THEN
-*
-* Apply the row interchanges to the other blocks.
-*
- J2 = MIN( JU-J+1, KV ) - JB
- J3 = MAX( 0, JU-J-KV+1 )
-*
-* Use ZLASWP to apply the row interchanges to A12, A22, and
-* A32.
-*
- CALL ZLASWP( J2, AB( KV+1-JB, J+JB ), LDAB-1, 1, JB,
- $ IPIV( J ), 1 )
-*
-* Adjust the pivot indices.
-*
- DO 90 I = J, J + JB - 1
- IPIV( I ) = IPIV( I ) + J - 1
- 90 CONTINUE
-*
-* Apply the row interchanges to A13, A23, and A33
-* columnwise.
-*
- K2 = J - 1 + JB + J2
- DO 110 I = 1, J3
- JJ = K2 + I
- DO 100 II = J + I - 1, J + JB - 1
- IP = IPIV( II )
- IF( IP.NE.II ) THEN
- TEMP = AB( KV+1+II-JJ, JJ )
- AB( KV+1+II-JJ, JJ ) = AB( KV+1+IP-JJ, JJ )
- AB( KV+1+IP-JJ, JJ ) = TEMP
- END IF
- 100 CONTINUE
- 110 CONTINUE
-*
-* Update the relevant part of the trailing submatrix
-*
- IF( J2.GT.0 ) THEN
-*
-* Update A12
-*
- CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit',
- $ JB, J2, ONE, AB( KV+1, J ), LDAB-1,
- $ AB( KV+1-JB, J+JB ), LDAB-1 )
-*
- IF( I2.GT.0 ) THEN
-*
-* Update A22
-*
- CALL ZGEMM( 'No transpose', 'No transpose', I2, J2,
- $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1,
- $ AB( KV+1-JB, J+JB ), LDAB-1, ONE,
- $ AB( KV+1, J+JB ), LDAB-1 )
- END IF
-*
- IF( I3.GT.0 ) THEN
-*
-* Update A32
-*
- CALL ZGEMM( 'No transpose', 'No transpose', I3, J2,
- $ JB, -ONE, WORK31, LDWORK,
- $ AB( KV+1-JB, J+JB ), LDAB-1, ONE,
- $ AB( KV+KL+1-JB, J+JB ), LDAB-1 )
- END IF
- END IF
-*
- IF( J3.GT.0 ) THEN
-*
-* Copy the lower triangle of A13 into the work array
-* WORK13
-*
- DO 130 JJ = 1, J3
- DO 120 II = JJ, JB
- WORK13( II, JJ ) = AB( II-JJ+1, JJ+J+KV-1 )
- 120 CONTINUE
- 130 CONTINUE
-*
-* Update A13 in the work array
-*
- CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit',
- $ JB, J3, ONE, AB( KV+1, J ), LDAB-1,
- $ WORK13, LDWORK )
-*
- IF( I2.GT.0 ) THEN
-*
-* Update A23
-*
- CALL ZGEMM( 'No transpose', 'No transpose', I2, J3,
- $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1,
- $ WORK13, LDWORK, ONE, AB( 1+JB, J+KV ),
- $ LDAB-1 )
- END IF
-*
- IF( I3.GT.0 ) THEN
-*
-* Update A33
-*
- CALL ZGEMM( 'No transpose', 'No transpose', I3, J3,
- $ JB, -ONE, WORK31, LDWORK, WORK13,
- $ LDWORK, ONE, AB( 1+KL, J+KV ), LDAB-1 )
- END IF
-*
-* Copy the lower triangle of A13 back into place
-*
- DO 150 JJ = 1, J3
- DO 140 II = JJ, JB
- AB( II-JJ+1, JJ+J+KV-1 ) = WORK13( II, JJ )
- 140 CONTINUE
- 150 CONTINUE
- END IF
- ELSE
-*
-* Adjust the pivot indices.
-*
- DO 160 I = J, J + JB - 1
- IPIV( I ) = IPIV( I ) + J - 1
- 160 CONTINUE
- END IF
-*
-* Partially undo the interchanges in the current block to
-* restore the upper triangular form of A31 and copy the upper
-* triangle of A31 back into place
-*
- DO 170 JJ = J + JB - 1, J, -1
- JP = IPIV( JJ ) - JJ + 1
- IF( JP.NE.1 ) THEN
-*
-* Apply interchange to columns J to JJ-1
-*
- IF( JP+JJ-1.LT.J+KL ) THEN
-*
-* The interchange does not affect A31
-*
- CALL ZSWAP( JJ-J, AB( KV+1+JJ-J, J ), LDAB-1,
- $ AB( KV+JP+JJ-J, J ), LDAB-1 )
- ELSE
-*
-* The interchange does affect A31
-*
- CALL ZSWAP( JJ-J, AB( KV+1+JJ-J, J ), LDAB-1,
- $ WORK31( JP+JJ-J-KL, 1 ), LDWORK )
- END IF
- END IF
-*
-* Copy the current column of A31 back into place
-*
- NW = MIN( I3, JJ-J+1 )
- IF( NW.GT.0 )
- $ CALL ZCOPY( NW, WORK31( 1, JJ-J+1 ), 1,
- $ AB( KV+KL+1-JJ+J, JJ ), 1 )
- 170 CONTINUE
- 180 CONTINUE
- END IF
-*
- RETURN
-*
-* End of ZGBTRF
-*
- END
diff --git a/mtx/lapack_src/zgbtrs.f b/mtx/lapack_src/zgbtrs.f
deleted file mode 100644
index 2b41f129a..000000000
--- a/mtx/lapack_src/zgbtrs.f
+++ /dev/null
@@ -1,297 +0,0 @@
-*> \brief \b ZGBTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ZGBTRS + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* COMPLEX*16 AB( LDAB, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations.
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] KL
-*> \verbatim
-*> KL is INTEGER
-*> The number of subdiagonals within the band of A. KL >= 0.
-*> \endverbatim
-*>
-*> \param[in] KU
-*> \verbatim
-*> KU is INTEGER
-*> The number of superdiagonals within the band of A. KU >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] AB
-*> \verbatim
-*> AB is COMPLEX*16 array, dimension (LDAB,N)
-*> Details of the LU factorization of the band matrix A, as
-*> computed by ZGBTRF. U is stored as an upper triangular band
-*> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
-*> the multipliers used during the factorization are stored in
-*> rows KL+KU+2 to 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] LDAB
-*> \verbatim
-*> LDAB is INTEGER
-*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= N, row i of the matrix was
-*> interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is COMPLEX*16 array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16GBcomputational
-*
-* =====================================================================
- SUBROUTINE ZGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- COMPLEX*16 AB( LDAB, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX*16 ONE
- PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
-* ..
-* .. Local Scalars ..
- LOGICAL LNOTI, NOTRAN
- INTEGER I, J, KD, L, LM
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, ZGEMV, ZGERU, ZLACGV, ZSWAP, ZTBSV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( KL.LT.0 ) THEN
- INFO = -3
- ELSE IF( KU.LT.0 ) THEN
- INFO = -4
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -5
- ELSE IF( LDAB.LT.( 2*KL+KU+1 ) ) THEN
- INFO = -7
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'ZGBTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- KD = KU + KL + 1
- LNOTI = KL.GT.0
-*
- IF( NOTRAN ) THEN
-*
-* Solve A*X = B.
-*
-* Solve L*X = B, overwriting B with X.
-*
-* L is represented as a product of permutations and unit lower
-* triangular matrices L = P(1) * L(1) * ... * P(n-1) * L(n-1),
-* where each transformation L(i) is a rank-one modification of
-* the identity matrix.
-*
- IF( LNOTI ) THEN
- DO 10 J = 1, N - 1
- LM = MIN( KL, N-J )
- L = IPIV( J )
- IF( L.NE.J )
- $ CALL ZSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB )
- CALL ZGERU( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J, 1 ),
- $ LDB, B( J+1, 1 ), LDB )
- 10 CONTINUE
- END IF
-*
- DO 20 I = 1, NRHS
-*
-* Solve U*X = B, overwriting B with X.
-*
- CALL ZTBSV( 'Upper', 'No transpose', 'Non-unit', N, KL+KU,
- $ AB, LDAB, B( 1, I ), 1 )
- 20 CONTINUE
-*
- ELSE IF( LSAME( TRANS, 'T' ) ) THEN
-*
-* Solve A**T * X = B.
-*
- DO 30 I = 1, NRHS
-*
-* Solve U**T * X = B, overwriting B with X.
-*
- CALL ZTBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU, AB,
- $ LDAB, B( 1, I ), 1 )
- 30 CONTINUE
-*
-* Solve L**T * X = B, overwriting B with X.
-*
- IF( LNOTI ) THEN
- DO 40 J = N - 1, 1, -1
- LM = MIN( KL, N-J )
- CALL ZGEMV( 'Transpose', LM, NRHS, -ONE, B( J+1, 1 ),
- $ LDB, AB( KD+1, J ), 1, ONE, B( J, 1 ), LDB )
- L = IPIV( J )
- IF( L.NE.J )
- $ CALL ZSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB )
- 40 CONTINUE
- END IF
-*
- ELSE
-*
-* Solve A**H * X = B.
-*
- DO 50 I = 1, NRHS
-*
-* Solve U**H * X = B, overwriting B with X.
-*
- CALL ZTBSV( 'Upper', 'Conjugate transpose', 'Non-unit', N,
- $ KL+KU, AB, LDAB, B( 1, I ), 1 )
- 50 CONTINUE
-*
-* Solve L**H * X = B, overwriting B with X.
-*
- IF( LNOTI ) THEN
- DO 60 J = N - 1, 1, -1
- LM = MIN( KL, N-J )
- CALL ZLACGV( NRHS, B( J, 1 ), LDB )
- CALL ZGEMV( 'Conjugate transpose', LM, NRHS, -ONE,
- $ B( J+1, 1 ), LDB, AB( KD+1, J ), 1, ONE,
- $ B( J, 1 ), LDB )
- CALL ZLACGV( NRHS, B( J, 1 ), LDB )
- L = IPIV( J )
- IF( L.NE.J )
- $ CALL ZSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB )
- 60 CONTINUE
- END IF
- END IF
- RETURN
-*
-* End of ZGBTRS
-*
- END
diff --git a/mtx/lapack_src/zgemm.f b/mtx/lapack_src/zgemm.f
deleted file mode 100644
index 71c9e9a28..000000000
--- a/mtx/lapack_src/zgemm.f
+++ /dev/null
@@ -1,415 +0,0 @@
- SUBROUTINE ZGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
-* .. Scalar Arguments ..
- DOUBLE COMPLEX ALPHA,BETA
- INTEGER K,LDA,LDB,LDC,M,N
- CHARACTER TRANSA,TRANSB
-* ..
-* .. Array Arguments ..
- DOUBLE COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
-* ..
-*
-* Purpose
-* =======
-*
-* 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' or op( X ) = conjg( X' ),
-*
-* 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.
-*
-* Arguments
-* ==========
-*
-* TRANSA - CHARACTER*1.
-* On entry, TRANSA specifies the form of op( A ) to be used in
-* the matrix multiplication as follows:
-*
-* TRANSA = 'N' or 'n', op( A ) = A.
-*
-* TRANSA = 'T' or 't', op( A ) = A'.
-*
-* TRANSA = 'C' or 'c', op( A ) = conjg( A' ).
-*
-* Unchanged on exit.
-*
-* TRANSB - CHARACTER*1.
-* On entry, TRANSB specifies the form of op( B ) to be used in
-* the matrix multiplication as follows:
-*
-* TRANSB = 'N' or 'n', op( B ) = B.
-*
-* TRANSB = 'T' or 't', op( B ) = B'.
-*
-* TRANSB = 'C' or 'c', op( B ) = conjg( B' ).
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of the matrix
-* op( A ) and of the matrix C. M must be at least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of the matrix
-* op( B ) and the number of columns of the matrix C. N must be
-* at least zero.
-* Unchanged on exit.
-*
-* K - INTEGER.
-* On entry, K specifies the number of columns of the matrix
-* op( A ) and the number of rows of the matrix op( B ). K must
-* be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - COMPLEX*16 .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
-* k when TRANSA = 'N' or 'n', and is m otherwise.
-* Before entry with TRANSA = 'N' or 'n', the leading m by k
-* part of the array A must contain the matrix A, otherwise
-* the leading k by m part of the array A must contain the
-* matrix A.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When TRANSA = 'N' or 'n' then
-* LDA must be at least max( 1, m ), otherwise LDA must be at
-* least max( 1, k ).
-* Unchanged on exit.
-*
-* B - COMPLEX*16 array of DIMENSION ( LDB, kb ), where kb is
-* n when TRANSB = 'N' or 'n', and is k otherwise.
-* Before entry with TRANSB = 'N' or 'n', the leading k by n
-* part of the array B must contain the matrix B, otherwise
-* the leading n by k part of the array B must contain the
-* matrix B.
-* Unchanged on exit.
-*
-* LDB - INTEGER.
-* On entry, LDB specifies the first dimension of B as declared
-* in the calling (sub) program. When TRANSB = 'N' or 'n' then
-* LDB must be at least max( 1, k ), otherwise LDB must be at
-* least max( 1, n ).
-* Unchanged on exit.
-*
-* BETA - COMPLEX*16 .
-* On entry, BETA specifies the scalar beta. When BETA is
-* supplied as zero then C need not be set on input.
-* Unchanged on exit.
-*
-* C - COMPLEX*16 array of DIMENSION ( LDC, n ).
-* Before entry, the leading m by n part of the array C must
-* contain the matrix C, except when beta is zero, in which
-* case C need not be set on entry.
-* On exit, the array C is overwritten by the m by n matrix
-* ( alpha*op( A )*op( B ) + beta*C ).
-*
-* LDC - INTEGER.
-* On entry, LDC specifies the first dimension of C as declared
-* in the calling (sub) program. LDC must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-*
-* Level 3 Blas routine.
-*
-* -- Written on 8-February-1989.
-* Jack Dongarra, Argonne National Laboratory.
-* Iain Duff, AERE Harwell.
-* Jeremy Du Croz, Numerical Algorithms Group Ltd.
-* Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DCONJG,MAX
-* ..
-* .. Local Scalars ..
- DOUBLE COMPLEX TEMP
- INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB
- LOGICAL CONJA,CONJB,NOTA,NOTB
-* ..
-* .. Parameters ..
- DOUBLE COMPLEX ONE
- PARAMETER (ONE= (1.0D+0,0.0D+0))
- DOUBLE COMPLEX ZERO
- PARAMETER (ZERO= (0.0D+0,0.0D+0))
-* ..
-*
-* Set NOTA and NOTB as true if A and B respectively are not
-* conjugated or transposed, set CONJA and CONJB as true if A and
-* B respectively are to be transposed but not conjugated and set
-* NROWA, NCOLA and NROWB as the number of rows and columns of A
-* and the number of rows of B respectively.
-*
- NOTA = LSAME(TRANSA,'N')
- NOTB = LSAME(TRANSB,'N')
- CONJA = LSAME(TRANSA,'C')
- CONJB = LSAME(TRANSB,'C')
- IF (NOTA) THEN
- NROWA = M
- NCOLA = K
- ELSE
- NROWA = K
- NCOLA = M
- END IF
- IF (NOTB) THEN
- NROWB = K
- ELSE
- NROWB = N
- END IF
-*
-* Test the input parameters.
-*
- INFO = 0
- IF ((.NOT.NOTA) .AND. (.NOT.CONJA) .AND.
- + (.NOT.LSAME(TRANSA,'T'))) THEN
- INFO = 1
- ELSE IF ((.NOT.NOTB) .AND. (.NOT.CONJB) .AND.
- + (.NOT.LSAME(TRANSB,'T'))) THEN
- INFO = 2
- ELSE IF (M.LT.0) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (K.LT.0) THEN
- INFO = 5
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 8
- ELSE IF (LDB.LT.MAX(1,NROWB)) THEN
- INFO = 10
- ELSE IF (LDC.LT.MAX(1,M)) THEN
- INFO = 13
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('ZGEMM ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
- + (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
-*
-* And when alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,M
- C(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- ELSE
- DO 40 J = 1,N
- DO 30 I = 1,M
- C(I,J) = BETA*C(I,J)
- 30 CONTINUE
- 40 CONTINUE
- END IF
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (NOTB) THEN
- IF (NOTA) THEN
-*
-* Form C := alpha*A*B + beta*C.
-*
- DO 90 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 50 I = 1,M
- C(I,J) = ZERO
- 50 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 60 I = 1,M
- C(I,J) = BETA*C(I,J)
- 60 CONTINUE
- END IF
- DO 80 L = 1,K
- IF (B(L,J).NE.ZERO) THEN
- TEMP = ALPHA*B(L,J)
- DO 70 I = 1,M
- C(I,J) = C(I,J) + TEMP*A(I,L)
- 70 CONTINUE
- END IF
- 80 CONTINUE
- 90 CONTINUE
- ELSE IF (CONJA) THEN
-*
-* Form C := alpha*conjg( A' )*B + beta*C.
-*
- DO 120 J = 1,N
- DO 110 I = 1,M
- TEMP = ZERO
- DO 100 L = 1,K
- TEMP = TEMP + DCONJG(A(L,I))*B(L,J)
- 100 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 110 CONTINUE
- 120 CONTINUE
- ELSE
-*
-* Form C := alpha*A'*B + beta*C
-*
- DO 150 J = 1,N
- DO 140 I = 1,M
- TEMP = ZERO
- DO 130 L = 1,K
- TEMP = TEMP + A(L,I)*B(L,J)
- 130 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 140 CONTINUE
- 150 CONTINUE
- END IF
- ELSE IF (NOTA) THEN
- IF (CONJB) THEN
-*
-* Form C := alpha*A*conjg( B' ) + beta*C.
-*
- DO 200 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 160 I = 1,M
- C(I,J) = ZERO
- 160 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 170 I = 1,M
- C(I,J) = BETA*C(I,J)
- 170 CONTINUE
- END IF
- DO 190 L = 1,K
- IF (B(J,L).NE.ZERO) THEN
- TEMP = ALPHA*DCONJG(B(J,L))
- DO 180 I = 1,M
- C(I,J) = C(I,J) + TEMP*A(I,L)
- 180 CONTINUE
- END IF
- 190 CONTINUE
- 200 CONTINUE
- ELSE
-*
-* Form C := alpha*A*B' + beta*C
-*
- DO 250 J = 1,N
- IF (BETA.EQ.ZERO) THEN
- DO 210 I = 1,M
- C(I,J) = ZERO
- 210 CONTINUE
- ELSE IF (BETA.NE.ONE) THEN
- DO 220 I = 1,M
- C(I,J) = BETA*C(I,J)
- 220 CONTINUE
- END IF
- DO 240 L = 1,K
- IF (B(J,L).NE.ZERO) THEN
- TEMP = ALPHA*B(J,L)
- DO 230 I = 1,M
- C(I,J) = C(I,J) + TEMP*A(I,L)
- 230 CONTINUE
- END IF
- 240 CONTINUE
- 250 CONTINUE
- END IF
- ELSE IF (CONJA) THEN
- IF (CONJB) THEN
-*
-* Form C := alpha*conjg( A' )*conjg( B' ) + beta*C.
-*
- DO 280 J = 1,N
- DO 270 I = 1,M
- TEMP = ZERO
- DO 260 L = 1,K
- TEMP = TEMP + DCONJG(A(L,I))*DCONJG(B(J,L))
- 260 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 270 CONTINUE
- 280 CONTINUE
- ELSE
-*
-* Form C := alpha*conjg( A' )*B' + beta*C
-*
- DO 310 J = 1,N
- DO 300 I = 1,M
- TEMP = ZERO
- DO 290 L = 1,K
- TEMP = TEMP + DCONJG(A(L,I))*B(J,L)
- 290 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 300 CONTINUE
- 310 CONTINUE
- END IF
- ELSE
- IF (CONJB) THEN
-*
-* Form C := alpha*A'*conjg( B' ) + beta*C
-*
- DO 340 J = 1,N
- DO 330 I = 1,M
- TEMP = ZERO
- DO 320 L = 1,K
- TEMP = TEMP + A(L,I)*DCONJG(B(J,L))
- 320 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 330 CONTINUE
- 340 CONTINUE
- ELSE
-*
-* Form C := alpha*A'*B' + beta*C
-*
- DO 370 J = 1,N
- DO 360 I = 1,M
- TEMP = ZERO
- DO 350 L = 1,K
- TEMP = TEMP + A(L,I)*B(J,L)
- 350 CONTINUE
- IF (BETA.EQ.ZERO) THEN
- C(I,J) = ALPHA*TEMP
- ELSE
- C(I,J) = ALPHA*TEMP + BETA*C(I,J)
- END IF
- 360 CONTINUE
- 370 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of ZGEMM .
-*
- END
-
diff --git a/mtx/lapack_src/zgemv.f b/mtx/lapack_src/zgemv.f
deleted file mode 100644
index 9d1729ca2..000000000
--- a/mtx/lapack_src/zgemv.f
+++ /dev/null
@@ -1,282 +0,0 @@
- SUBROUTINE ZGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
-* .. Scalar Arguments ..
- DOUBLE COMPLEX ALPHA,BETA
- INTEGER INCX,INCY,LDA,M,N
- CHARACTER TRANS
-* ..
-* .. Array Arguments ..
- DOUBLE COMPLEX A(LDA,*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* ZGEMV performs one of the matrix-vector operations
-*
-* y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, or
-*
-* y := alpha*conjg( A' )*x + beta*y,
-*
-* where alpha and beta are scalars, x and y are vectors and A is an
-* m by n matrix.
-*
-* Arguments
-* ==========
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
-*
-* TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
-*
-* TRANS = 'C' or 'c' y := alpha*conjg( A' )*x + beta*y.
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of the matrix A.
-* M must be at least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - COMPLEX*16 .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A - COMPLEX*16 array of DIMENSION ( LDA, n ).
-* Before entry, the leading m by n part of the array A must
-* contain the matrix of coefficients.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-* X - COMPLEX*16 array of DIMENSION at least
-* ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
-* and at least
-* ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
-* Before entry, the incremented array X must contain the
-* vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* BETA - COMPLEX*16 .
-* On entry, BETA specifies the scalar beta. When BETA is
-* supplied as zero then Y need not be set on input.
-* Unchanged on exit.
-*
-* Y - COMPLEX*16 array of DIMENSION at least
-* ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
-* and at least
-* ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
-* Before entry with BETA non-zero, the incremented array Y
-* must contain the vector y. On exit, Y is overwritten by the
-* updated vector y.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-*
-* .. Parameters ..
- DOUBLE COMPLEX ONE
- PARAMETER (ONE= (1.0D+0,0.0D+0))
- DOUBLE COMPLEX ZERO
- PARAMETER (ZERO= (0.0D+0,0.0D+0))
-* ..
-* .. Local Scalars ..
- DOUBLE COMPLEX TEMP
- INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY
- LOGICAL NOCONJ
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DCONJG,MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 1
- ELSE IF (M.LT.0) THEN
- INFO = 2
- ELSE IF (N.LT.0) THEN
- INFO = 3
- ELSE IF (LDA.LT.MAX(1,M)) THEN
- INFO = 6
- ELSE IF (INCX.EQ.0) THEN
- INFO = 8
- ELSE IF (INCY.EQ.0) THEN
- INFO = 11
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('ZGEMV ',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
- + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
-*
- NOCONJ = LSAME(TRANS,'T')
-*
-* Set LENX and LENY, the lengths of the vectors x and y, and set
-* up the start points in X and Y.
-*
- IF (LSAME(TRANS,'N')) THEN
- LENX = N
- LENY = M
- ELSE
- LENX = M
- LENY = N
- END IF
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (LENX-1)*INCX
- END IF
- IF (INCY.GT.0) THEN
- KY = 1
- ELSE
- KY = 1 - (LENY-1)*INCY
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
-* First form y := beta*y.
-*
- IF (BETA.NE.ONE) THEN
- IF (INCY.EQ.1) THEN
- IF (BETA.EQ.ZERO) THEN
- DO 10 I = 1,LENY
- Y(I) = ZERO
- 10 CONTINUE
- ELSE
- DO 20 I = 1,LENY
- Y(I) = BETA*Y(I)
- 20 CONTINUE
- END IF
- ELSE
- IY = KY
- IF (BETA.EQ.ZERO) THEN
- DO 30 I = 1,LENY
- Y(IY) = ZERO
- IY = IY + INCY
- 30 CONTINUE
- ELSE
- DO 40 I = 1,LENY
- Y(IY) = BETA*Y(IY)
- IY = IY + INCY
- 40 CONTINUE
- END IF
- END IF
- END IF
- IF (ALPHA.EQ.ZERO) RETURN
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form y := alpha*A*x + y.
-*
- JX = KX
- IF (INCY.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- DO 50 I = 1,M
- Y(I) = Y(I) + TEMP*A(I,J)
- 50 CONTINUE
- END IF
- JX = JX + INCX
- 60 CONTINUE
- ELSE
- DO 80 J = 1,N
- IF (X(JX).NE.ZERO) THEN
- TEMP = ALPHA*X(JX)
- IY = KY
- DO 70 I = 1,M
- Y(IY) = Y(IY) + TEMP*A(I,J)
- IY = IY + INCY
- 70 CONTINUE
- END IF
- JX = JX + INCX
- 80 CONTINUE
- END IF
- ELSE
-*
-* Form y := alpha*A'*x + y or y := alpha*conjg( A' )*x + y.
-*
- JY = KY
- IF (INCX.EQ.1) THEN
- DO 110 J = 1,N
- TEMP = ZERO
- IF (NOCONJ) THEN
- DO 90 I = 1,M
- TEMP = TEMP + A(I,J)*X(I)
- 90 CONTINUE
- ELSE
- DO 100 I = 1,M
- TEMP = TEMP + DCONJG(A(I,J))*X(I)
- 100 CONTINUE
- END IF
- Y(JY) = Y(JY) + ALPHA*TEMP
- JY = JY + INCY
- 110 CONTINUE
- ELSE
- DO 140 J = 1,N
- TEMP = ZERO
- IX = KX
- IF (NOCONJ) THEN
- DO 120 I = 1,M
- TEMP = TEMP + A(I,J)*X(IX)
- IX = IX + INCX
- 120 CONTINUE
- ELSE
- DO 130 I = 1,M
- TEMP = TEMP + DCONJG(A(I,J))*X(IX)
- IX = IX + INCX
- 130 CONTINUE
- END IF
- Y(JY) = Y(JY) + ALPHA*TEMP
- JY = JY + INCY
- 140 CONTINUE
- END IF
- END IF
-*
- RETURN
-*
-* End of ZGEMV .
-*
- END
-
diff --git a/mtx/lapack_src/zgeru.f b/mtx/lapack_src/zgeru.f
deleted file mode 100644
index 47f1bef48..000000000
--- a/mtx/lapack_src/zgeru.f
+++ /dev/null
@@ -1,160 +0,0 @@
- SUBROUTINE ZGERU(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
-* .. Scalar Arguments ..
- DOUBLE COMPLEX ALPHA
- INTEGER INCX,INCY,LDA,M,N
-* ..
-* .. Array Arguments ..
- DOUBLE COMPLEX A(LDA,*),X(*),Y(*)
-* ..
-*
-* Purpose
-* =======
-*
-* ZGERU performs the rank 1 operation
-*
-* A := alpha*x*y' + 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.
-*
-* Arguments
-* ==========
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of the matrix A.
-* M must be at least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA - COMPLEX*16 .
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* X - COMPLEX*16 array of dimension at least
-* ( 1 + ( m - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the m
-* element vector x.
-* Unchanged on exit.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-* Y - COMPLEX*16 array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCY ) ).
-* Before entry, the incremented array Y must contain the n
-* element vector y.
-* Unchanged on exit.
-*
-* INCY - INTEGER.
-* On entry, INCY specifies the increment for the elements of
-* Y. INCY must not be zero.
-* Unchanged on exit.
-*
-* A - COMPLEX*16 array of DIMENSION ( LDA, n ).
-* Before entry, the leading m by n part of the array A must
-* contain the matrix of coefficients. On exit, A is
-* overwritten by the updated matrix.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-*
-* .. Parameters ..
- DOUBLE COMPLEX ZERO
- PARAMETER (ZERO= (0.0D+0,0.0D+0))
-* ..
-* .. Local Scalars ..
- DOUBLE COMPLEX TEMP
- INTEGER I,INFO,IX,J,JY,KX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (M.LT.0) THEN
- INFO = 1
- ELSE IF (N.LT.0) THEN
- INFO = 2
- ELSE IF (INCX.EQ.0) THEN
- INFO = 5
- ELSE IF (INCY.EQ.0) THEN
- INFO = 7
- ELSE IF (LDA.LT.MAX(1,M)) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('ZGERU',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
-*
-* Start the operations. In this version the elements of A are
-* accessed sequentially with one pass through A.
-*
- IF (INCY.GT.0) THEN
- JY = 1
- ELSE
- JY = 1 - (N-1)*INCY
- END IF
- IF (INCX.EQ.1) THEN
- DO 20 J = 1,N
- IF (Y(JY).NE.ZERO) THEN
- TEMP = ALPHA*Y(JY)
- DO 10 I = 1,M
- A(I,J) = A(I,J) + X(I)*TEMP
- 10 CONTINUE
- END IF
- JY = JY + INCY
- 20 CONTINUE
- ELSE
- IF (INCX.GT.0) THEN
- KX = 1
- ELSE
- KX = 1 - (M-1)*INCX
- END IF
- DO 40 J = 1,N
- IF (Y(JY).NE.ZERO) THEN
- TEMP = ALPHA*Y(JY)
- IX = KX
- DO 30 I = 1,M
- A(I,J) = A(I,J) + X(IX)*TEMP
- IX = IX + INCX
- 30 CONTINUE
- END IF
- JY = JY + INCY
- 40 CONTINUE
- END IF
-*
- RETURN
-*
-* End of ZGERU .
-*
- END
-
diff --git a/mtx/lapack_src/zgetf2.f b/mtx/lapack_src/zgetf2.f
deleted file mode 100644
index acb067170..000000000
--- a/mtx/lapack_src/zgetf2.f
+++ /dev/null
@@ -1,214 +0,0 @@
-*> \brief \b ZGETF2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ZGETF2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZGETF2( M, N, A, LDA, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* COMPLEX*16 A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is COMPLEX*16 array, dimension (LDA,N)
-*> On entry, the m by n matrix to be factored.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U; the unit diagonal elements of L are not stored.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, U(k,k) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16GEcomputational
-*
-* =====================================================================
- SUBROUTINE ZGETF2( M, N, A, LDA, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- COMPLEX*16 A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX*16 ONE, ZERO
- PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
- $ ZERO = ( 0.0D+0, 0.0D+0 ) )
-* ..
-* .. Local Scalars ..
- DOUBLE PRECISION SFMIN
- INTEGER I, J, JP
-* ..
-* .. External Functions ..
- DOUBLE PRECISION DLAMCH
- INTEGER IZAMAX
- EXTERNAL DLAMCH, IZAMAX
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, ZGERU, ZSCAL, ZSWAP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'ZGETF2', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Compute machine safe minimum
-*
- SFMIN = DLAMCH('S')
-*
- DO 10 J = 1, MIN( M, N )
-*
-* Find pivot and test for singularity.
-*
- JP = J - 1 + IZAMAX( M-J+1, A( J, J ), 1 )
- IPIV( J ) = JP
- IF( A( JP, J ).NE.ZERO ) THEN
-*
-* Apply the interchange to columns 1:N.
-*
- IF( JP.NE.J )
- $ CALL ZSWAP( N, A( J, 1 ), LDA, A( JP, 1 ), LDA )
-*
-* Compute elements J+1:M of J-th column.
-*
- IF( J.LT.M ) THEN
- IF( ABS(A( J, J )) .GE. SFMIN ) THEN
- CALL ZSCAL( M-J, ONE / A( J, J ), A( J+1, J ), 1 )
- ELSE
- DO 20 I = 1, M-J
- A( J+I, J ) = A( J+I, J ) / A( J, J )
- 20 CONTINUE
- END IF
- END IF
-*
- ELSE IF( INFO.EQ.0 ) THEN
-*
- INFO = J
- END IF
-*
- IF( J.LT.MIN( M, N ) ) THEN
-*
-* Update trailing submatrix.
-*
- CALL ZGERU( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ),
- $ LDA, A( J+1, J+1 ), LDA )
- END IF
- 10 CONTINUE
- RETURN
-*
-* End of ZGETF2
-*
- END
diff --git a/mtx/lapack_src/zgetrf.f b/mtx/lapack_src/zgetrf.f
deleted file mode 100644
index 5428a8ff7..000000000
--- a/mtx/lapack_src/zgetrf.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b ZGETRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ZGETRF + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZGETRF( M, N, A, LDA, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* COMPLEX*16 A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] M
-*> \verbatim
-*> M is INTEGER
-*> The number of rows of the matrix A. M >= 0.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is COMPLEX*16 array, dimension (LDA,N)
-*> On entry, the M-by-N matrix to be factored.
-*> On exit, the factors L and U from the factorization
-*> A = P*L*U; the unit diagonal elements of L are not stored.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,M).
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (min(M,N))
-*> The pivot indices; for 1 <= i <= min(M,N), row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16GEcomputational
-*
-* =====================================================================
- SUBROUTINE ZGETRF( M, N, A, LDA, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, M, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- COMPLEX*16 A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX*16 ONE
- PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
-* ..
-* .. Local Scalars ..
- INTEGER I, IINFO, J, JB, NB
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, ZGEMM, ZGETF2, ZLASWP, ZTRSM
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF( M.LT.0 ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
- INFO = -4
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'ZGETRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( M.EQ.0 .OR. N.EQ.0 )
- $ RETURN
-*
-* Determine the block size for this environment.
-*
- NB = ILAENV( 1, 'ZGETRF', ' ', M, N, -1, -1 )
- IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN
-*
-* Use unblocked code.
-*
- CALL ZGETF2( M, N, A, LDA, IPIV, INFO )
- ELSE
-*
-* Use blocked code.
-*
- DO 20 J = 1, MIN( M, N ), NB
- JB = MIN( MIN( M, N )-J+1, NB )
-*
-* Factor diagonal and subdiagonal blocks and test for exact
-* singularity.
-*
- CALL ZGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
-*
-* Adjust INFO and the pivot indices.
-*
- IF( INFO.EQ.0 .AND. IINFO.GT.0 )
- $ INFO = IINFO + J - 1
- DO 10 I = J, MIN( M, J+JB-1 )
- IPIV( I ) = J - 1 + IPIV( I )
- 10 CONTINUE
-*
-* Apply interchanges to columns 1:J-1.
-*
- CALL ZLASWP( J-1, A, LDA, J, J+JB-1, IPIV, 1 )
-*
- IF( J+JB.LE.N ) THEN
-*
-* Apply interchanges to columns J+JB:N.
-*
- CALL ZLASWP( N-J-JB+1, A( 1, J+JB ), LDA, J, J+JB-1,
- $ IPIV, 1 )
-*
-* Compute block row of U.
-*
- CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB,
- $ N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ),
- $ LDA )
- IF( J+JB.LE.M ) THEN
-*
-* Update trailing submatrix.
-*
- CALL ZGEMM( 'No transpose', 'No transpose', M-J-JB+1,
- $ N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA,
- $ A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ),
- $ LDA )
- END IF
- END IF
- 20 CONTINUE
- END IF
- RETURN
-*
-* End of ZGETRF
-*
- END
diff --git a/mtx/lapack_src/zgetrs.f b/mtx/lapack_src/zgetrs.f
deleted file mode 100644
index 6400055b4..000000000
--- a/mtx/lapack_src/zgetrs.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b ZGETRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ZGETRS + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* COMPLEX*16 A( LDA, * ), B( LDB, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations:
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A. N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] A
-*> \verbatim
-*> A is COMPLEX*16 array, dimension (LDA,N)
-*> The factors L and U from the factorization A = P*L*U
-*> as computed by ZGETRF.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices from ZGETRF; for 1<=i<=N, row i of the
-*> matrix was interchanged with row IPIV(i).
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is COMPLEX*16 array, dimension (LDB,NRHS)
-*> On entry, the right hand side matrix B.
-*> On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16GEcomputational
-*
-* =====================================================================
- SUBROUTINE ZGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDA, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- COMPLEX*16 A( LDA, * ), B( LDB, * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- COMPLEX*16 ONE
- PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
-* ..
-* .. Local Scalars ..
- LOGICAL NOTRAN
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, ZLASWP, ZTRSM
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX
-* ..
-* .. Executable Statements ..
-*
-* Test the input parameters.
-*
- INFO = 0
- NOTRAN = LSAME( TRANS, 'N' )
- IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
- $ LSAME( TRANS, 'C' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
- INFO = -5
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -8
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'ZGETRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( NOTRAN ) THEN
-*
-* Solve A * X = B.
-*
-* Apply row interchanges to the right hand sides.
-*
- CALL ZLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
-*
-* Solve L*X = B, overwriting B with X.
-*
- CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
- $ ONE, A, LDA, B, LDB )
-*
-* Solve U*X = B, overwriting B with X.
-*
- CALL ZTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
- $ NRHS, ONE, A, LDA, B, LDB )
- ELSE
-*
-* Solve A**T * X = B or A**H * X = B.
-*
-* Solve U**T *X = B or U**H *X = B, overwriting B with X.
-*
- CALL ZTRSM( 'Left', 'Upper', TRANS, 'Non-unit', N, NRHS, ONE,
- $ A, LDA, B, LDB )
-*
-* Solve L**T *X = B, or L**H *X = B overwriting B with X.
-*
- CALL ZTRSM( 'Left', 'Lower', TRANS, 'Unit', N, NRHS, ONE, A,
- $ LDA, B, LDB )
-*
-* Apply row interchanges to the solution vectors.
-*
- CALL ZLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
- END IF
-*
- RETURN
-*
-* End of ZGETRS
-*
- END
diff --git a/mtx/lapack_src/zgttrf.f b/mtx/lapack_src/zgttrf.f
deleted file mode 100644
index ac8edea97..000000000
--- a/mtx/lapack_src/zgttrf.f
+++ /dev/null
@@ -1,243 +0,0 @@
-*> \brief \b ZGTTRF
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ZGTTRF + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
-*
-* .. Scalar Arguments ..
-* INTEGER INFO, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* COMPLEX*16 D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] DL
-*> \verbatim
-*> DL is COMPLEX*16 array, dimension (N-1)
-*> On entry, DL must contain the (n-1) sub-diagonal elements of
-*> A.
-*>
-*> On exit, DL is overwritten by the (n-1) multipliers that
-*> define the matrix L from the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] D
-*> \verbatim
-*> D is COMPLEX*16 array, dimension (N)
-*> On entry, D must contain the diagonal elements of A.
-*>
-*> On exit, D is overwritten by the n diagonal elements of the
-*> upper triangular matrix U from the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in,out] DU
-*> \verbatim
-*> DU is COMPLEX*16 array, dimension (N-1)
-*> On entry, DU must contain the (n-1) super-diagonal elements
-*> of A.
-*>
-*> On exit, DU is overwritten by the (n-1) elements of the first
-*> super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[out] DU2
-*> \verbatim
-*> DU2 is COMPLEX*16 array, dimension (N-2)
-*> On exit, DU2 is overwritten by the (n-2) elements of the
-*> second super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[out] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> > 0: if INFO = k, U(k,k) is exactly zero. The factorization
-*> has been completed, but the factor U is exactly
-*> singular, and division by zero will occur if it is used
-*> to solve a system of equations.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16OTHERcomputational
-*
-* =====================================================================
- SUBROUTINE ZGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INFO, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- COMPLEX*16 D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I
- COMPLEX*16 FACT, TEMP, ZDUM
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, DIMAG
-* ..
-* .. Statement Functions ..
- DOUBLE PRECISION CABS1
-* ..
-* .. Statement Function definitions ..
- CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- IF( N.LT.0 ) THEN
- INFO = -1
- CALL XERBLA( 'ZGTTRF', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 )
- $ RETURN
-*
-* Initialize IPIV(i) = i and DU2(i) = 0
-*
- DO 10 I = 1, N
- IPIV( I ) = I
- 10 CONTINUE
- DO 20 I = 1, N - 2
- DU2( I ) = ZERO
- 20 CONTINUE
-*
- DO 30 I = 1, N - 2
- IF( CABS1( D( I ) ).GE.CABS1( DL( I ) ) ) THEN
-*
-* No row interchange required, eliminate DL(I)
-*
- IF( CABS1( D( I ) ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- DL( I ) = FACT
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- END IF
- ELSE
-*
-* Interchange rows I and I+1, eliminate DL(I)
-*
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- DL( I ) = FACT
- TEMP = DU( I )
- DU( I ) = D( I+1 )
- D( I+1 ) = TEMP - FACT*D( I+1 )
- DU2( I ) = DU( I+1 )
- DU( I+1 ) = -FACT*DU( I+1 )
- IPIV( I ) = I + 1
- END IF
- 30 CONTINUE
- IF( N.GT.1 ) THEN
- I = N - 1
- IF( CABS1( D( I ) ).GE.CABS1( DL( I ) ) ) THEN
- IF( CABS1( D( I ) ).NE.ZERO ) THEN
- FACT = DL( I ) / D( I )
- DL( I ) = FACT
- D( I+1 ) = D( I+1 ) - FACT*DU( I )
- END IF
- ELSE
- FACT = D( I ) / DL( I )
- D( I ) = DL( I )
- DL( I ) = FACT
- TEMP = DU( I )
- DU( I ) = D( I+1 )
- D( I+1 ) = TEMP - FACT*D( I+1 )
- IPIV( I ) = I + 1
- END IF
- END IF
-*
-* Check for a zero on the diagonal of U.
-*
- DO 40 I = 1, N
- IF( CABS1( D( I ) ).EQ.ZERO ) THEN
- INFO = I
- GO TO 50
- END IF
- 40 CONTINUE
- 50 CONTINUE
-*
- RETURN
-*
-* End of ZGTTRF
-*
- END
diff --git a/mtx/lapack_src/zgttrs.f b/mtx/lapack_src/zgttrs.f
deleted file mode 100644
index e5d50f311..000000000
--- a/mtx/lapack_src/zgttrs.f
+++ /dev/null
@@ -1,225 +0,0 @@
-*> \brief \b ZGTTRS
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ZGTTRS + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB,
-* INFO )
-*
-* .. Scalar Arguments ..
-* CHARACTER TRANS
-* INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] TRANS
-*> \verbatim
-*> TRANS is CHARACTER*1
-*> Specifies the form of the system of equations.
-*> = 'N': A * X = B (No transpose)
-*> = 'T': A**T * X = B (Transpose)
-*> = 'C': A**H * X = B (Conjugate transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is COMPLEX*16 array, dimension (N-1)
-*> The (n-1) multipliers that define the matrix L from the
-*> LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is COMPLEX*16 array, dimension (N)
-*> The n diagonal elements of the upper triangular matrix U from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is COMPLEX*16 array, dimension (N-1)
-*> The (n-1) elements of the first super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] DU2
-*> \verbatim
-*> DU2 is COMPLEX*16 array, dimension (N-2)
-*> The (n-2) elements of the second super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is COMPLEX*16 array, dimension (LDB,NRHS)
-*> On entry, the matrix of right hand side vectors B.
-*> On exit, B is overwritten by the solution vectors X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16OTHERcomputational
-*
-* =====================================================================
- SUBROUTINE ZGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB,
- $ INFO )
-*
-* -- LAPACK computational routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- CHARACTER TRANS
- INTEGER INFO, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- LOGICAL NOTRAN
- INTEGER ITRANS, J, JB, NB
-* ..
-* .. External Functions ..
- INTEGER ILAENV
- EXTERNAL ILAENV
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA, ZGTTS2
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN
-* ..
-* .. Executable Statements ..
-*
- INFO = 0
- NOTRAN = ( TRANS.EQ.'N' .OR. TRANS.EQ.'n' )
- IF( .NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T' .OR. TRANS.EQ.
- $ 't' ) .AND. .NOT.( TRANS.EQ.'C' .OR. TRANS.EQ.'c' ) ) THEN
- INFO = -1
- ELSE IF( N.LT.0 ) THEN
- INFO = -2
- ELSE IF( NRHS.LT.0 ) THEN
- INFO = -3
- ELSE IF( LDB.LT.MAX( N, 1 ) ) THEN
- INFO = -10
- END IF
- IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'ZGTTRS', -INFO )
- RETURN
- END IF
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
-* Decode TRANS
-*
- IF( NOTRAN ) THEN
- ITRANS = 0
- ELSE IF( TRANS.EQ.'T' .OR. TRANS.EQ.'t' ) THEN
- ITRANS = 1
- ELSE
- ITRANS = 2
- END IF
-*
-* Determine the number of right-hand sides to solve at a time.
-*
- IF( NRHS.EQ.1 ) THEN
- NB = 1
- ELSE
- NB = MAX( 1, ILAENV( 1, 'ZGTTRS', TRANS, N, NRHS, -1, -1 ) )
- END IF
-*
- IF( NB.GE.NRHS ) THEN
- CALL ZGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
- ELSE
- DO 10 J = 1, NRHS, NB
- JB = MIN( NRHS-J+1, NB )
- CALL ZGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ),
- $ LDB )
- 10 CONTINUE
- END IF
-*
-* End of ZGTTRS
-*
- END
diff --git a/mtx/lapack_src/zgtts2.f b/mtx/lapack_src/zgtts2.f
deleted file mode 100644
index a7c508ab9..000000000
--- a/mtx/lapack_src/zgtts2.f
+++ /dev/null
@@ -1,349 +0,0 @@
-*> \brief \b ZGTTS2
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ZGTTS2 + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
-*
-* .. Scalar Arguments ..
-* INTEGER ITRANS, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] ITRANS
-*> \verbatim
-*> ITRANS is INTEGER
-*> Specifies the form of the system of equations.
-*> = 0: A * X = B (No transpose)
-*> = 1: A**T * X = B (Transpose)
-*> = 2: A**H * X = B (Conjugate transpose)
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The order of the matrix A.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*> NRHS is INTEGER
-*> The number of right hand sides, i.e., the number of columns
-*> of the matrix B. NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in] DL
-*> \verbatim
-*> DL is COMPLEX*16 array, dimension (N-1)
-*> The (n-1) multipliers that define the matrix L from the
-*> LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] D
-*> \verbatim
-*> D is COMPLEX*16 array, dimension (N)
-*> The n diagonal elements of the upper triangular matrix U from
-*> the LU factorization of A.
-*> \endverbatim
-*>
-*> \param[in] DU
-*> \verbatim
-*> DU is COMPLEX*16 array, dimension (N-1)
-*> The (n-1) elements of the first super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] DU2
-*> \verbatim
-*> DU2 is COMPLEX*16 array, dimension (N-2)
-*> The (n-2) elements of the second super-diagonal of U.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
-*> The pivot indices; for 1 <= i <= n, row i of the matrix was
-*> interchanged with row IPIV(i). IPIV(i) will always be either
-*> i or i+1; IPIV(i) = i indicates a row interchange was not
-*> required.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*> B is COMPLEX*16 array, dimension (LDB,NRHS)
-*> On entry, the matrix of right hand side vectors B.
-*> On exit, B is overwritten by the solution vectors X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*> LDB is INTEGER
-*> The leading dimension of the array B. LDB >= max(1,N).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16OTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE ZGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER ITRANS, LDB, N, NRHS
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, J
- COMPLEX*16 TEMP
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DCONJG
-* ..
-* .. Executable Statements ..
-*
-* Quick return if possible
-*
- IF( N.EQ.0 .OR. NRHS.EQ.0 )
- $ RETURN
-*
- IF( ITRANS.EQ.0 ) THEN
-*
-* Solve A*X = B using the LU factorization of A,
-* overwriting each right hand side vector with its solution.
-*
- IF( NRHS.LE.1 ) THEN
- J = 1
- 10 CONTINUE
-*
-* Solve L*x = b.
-*
- DO 20 I = 1, N - 1
- IF( IPIV( I ).EQ.I ) THEN
- B( I+1, J ) = B( I+1, J ) - DL( I )*B( I, J )
- ELSE
- TEMP = B( I, J )
- B( I, J ) = B( I+1, J )
- B( I+1, J ) = TEMP - DL( I )*B( I, J )
- END IF
- 20 CONTINUE
-*
-* Solve U*x = b.
-*
- B( N, J ) = B( N, J ) / D( N )
- IF( N.GT.1 )
- $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
- $ D( N-1 )
- DO 30 I = N - 2, 1, -1
- B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )*
- $ B( I+2, J ) ) / D( I )
- 30 CONTINUE
- IF( J.LT.NRHS ) THEN
- J = J + 1
- GO TO 10
- END IF
- ELSE
- DO 60 J = 1, NRHS
-*
-* Solve L*x = b.
-*
- DO 40 I = 1, N - 1
- IF( IPIV( I ).EQ.I ) THEN
- B( I+1, J ) = B( I+1, J ) - DL( I )*B( I, J )
- ELSE
- TEMP = B( I, J )
- B( I, J ) = B( I+1, J )
- B( I+1, J ) = TEMP - DL( I )*B( I, J )
- END IF
- 40 CONTINUE
-*
-* Solve U*x = b.
-*
- B( N, J ) = B( N, J ) / D( N )
- IF( N.GT.1 )
- $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
- $ D( N-1 )
- DO 50 I = N - 2, 1, -1
- B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )*
- $ B( I+2, J ) ) / D( I )
- 50 CONTINUE
- 60 CONTINUE
- END IF
- ELSE IF( ITRANS.EQ.1 ) THEN
-*
-* Solve A**T * X = B.
-*
- IF( NRHS.LE.1 ) THEN
- J = 1
- 70 CONTINUE
-*
-* Solve U**T * x = b.
-*
- B( 1, J ) = B( 1, J ) / D( 1 )
- IF( N.GT.1 )
- $ B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 )
- DO 80 I = 3, N
- B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-DU2( I-2 )*
- $ B( I-2, J ) ) / D( I )
- 80 CONTINUE
-*
-* Solve L**T * x = b.
-*
- DO 90 I = N - 1, 1, -1
- IF( IPIV( I ).EQ.I ) THEN
- B( I, J ) = B( I, J ) - DL( I )*B( I+1, J )
- ELSE
- TEMP = B( I+1, J )
- B( I+1, J ) = B( I, J ) - DL( I )*TEMP
- B( I, J ) = TEMP
- END IF
- 90 CONTINUE
- IF( J.LT.NRHS ) THEN
- J = J + 1
- GO TO 70
- END IF
- ELSE
- DO 120 J = 1, NRHS
-*
-* Solve U**T * x = b.
-*
- B( 1, J ) = B( 1, J ) / D( 1 )
- IF( N.GT.1 )
- $ B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 )
- DO 100 I = 3, N
- B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-
- $ DU2( I-2 )*B( I-2, J ) ) / D( I )
- 100 CONTINUE
-*
-* Solve L**T * x = b.
-*
- DO 110 I = N - 1, 1, -1
- IF( IPIV( I ).EQ.I ) THEN
- B( I, J ) = B( I, J ) - DL( I )*B( I+1, J )
- ELSE
- TEMP = B( I+1, J )
- B( I+1, J ) = B( I, J ) - DL( I )*TEMP
- B( I, J ) = TEMP
- END IF
- 110 CONTINUE
- 120 CONTINUE
- END IF
- ELSE
-*
-* Solve A**H * X = B.
-*
- IF( NRHS.LE.1 ) THEN
- J = 1
- 130 CONTINUE
-*
-* Solve U**H * x = b.
-*
- B( 1, J ) = B( 1, J ) / DCONJG( D( 1 ) )
- IF( N.GT.1 )
- $ B( 2, J ) = ( B( 2, J )-DCONJG( DU( 1 ) )*B( 1, J ) ) /
- $ DCONJG( D( 2 ) )
- DO 140 I = 3, N
- B( I, J ) = ( B( I, J )-DCONJG( DU( I-1 ) )*B( I-1, J )-
- $ DCONJG( DU2( I-2 ) )*B( I-2, J ) ) /
- $ DCONJG( D( I ) )
- 140 CONTINUE
-*
-* Solve L**H * x = b.
-*
- DO 150 I = N - 1, 1, -1
- IF( IPIV( I ).EQ.I ) THEN
- B( I, J ) = B( I, J ) - DCONJG( DL( I ) )*B( I+1, J )
- ELSE
- TEMP = B( I+1, J )
- B( I+1, J ) = B( I, J ) - DCONJG( DL( I ) )*TEMP
- B( I, J ) = TEMP
- END IF
- 150 CONTINUE
- IF( J.LT.NRHS ) THEN
- J = J + 1
- GO TO 130
- END IF
- ELSE
- DO 180 J = 1, NRHS
-*
-* Solve U**H * x = b.
-*
- B( 1, J ) = B( 1, J ) / DCONJG( D( 1 ) )
- IF( N.GT.1 )
- $ B( 2, J ) = ( B( 2, J )-DCONJG( DU( 1 ) )*B( 1, J ) )
- $ / DCONJG( D( 2 ) )
- DO 160 I = 3, N
- B( I, J ) = ( B( I, J )-DCONJG( DU( I-1 ) )*
- $ B( I-1, J )-DCONJG( DU2( I-2 ) )*
- $ B( I-2, J ) ) / DCONJG( D( I ) )
- 160 CONTINUE
-*
-* Solve L**H * x = b.
-*
- DO 170 I = N - 1, 1, -1
- IF( IPIV( I ).EQ.I ) THEN
- B( I, J ) = B( I, J ) - DCONJG( DL( I ) )*
- $ B( I+1, J )
- ELSE
- TEMP = B( I+1, J )
- B( I+1, J ) = B( I, J ) - DCONJG( DL( I ) )*TEMP
- B( I, J ) = TEMP
- END IF
- 170 CONTINUE
- 180 CONTINUE
- END IF
- END IF
-*
-* End of ZGTTS2
-*
- END
diff --git a/mtx/lapack_src/zlacgv.f b/mtx/lapack_src/zlacgv.f
deleted file mode 100644
index 16c2e2ed9..000000000
--- a/mtx/lapack_src/zlacgv.f
+++ /dev/null
@@ -1,116 +0,0 @@
-*> \brief \b ZLACGV
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ZLACGV + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZLACGV( N, X, INCX )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, N
-* ..
-* .. Array Arguments ..
-* COMPLEX*16 X( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> ZLACGV conjugates a complex vector of length N.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The length of the vector X. N >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] X
-*> \verbatim
-*> X is COMPLEX*16 array, dimension
-*> (1+(N-1)*abs(INCX))
-*> On entry, the vector of length N to be conjugated.
-*> On exit, X is overwritten with conjg(X).
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The spacing between successive elements of X.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16OTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE ZLACGV( N, X, INCX )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX, N
-* ..
-* .. Array Arguments ..
- COMPLEX*16 X( * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, IOFF
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DCONJG
-* ..
-* .. Executable Statements ..
-*
- IF( INCX.EQ.1 ) THEN
- DO 10 I = 1, N
- X( I ) = DCONJG( X( I ) )
- 10 CONTINUE
- ELSE
- IOFF = 1
- IF( INCX.LT.0 )
- $ IOFF = 1 - ( N-1 )*INCX
- DO 20 I = 1, N
- X( IOFF ) = DCONJG( X( IOFF ) )
- IOFF = IOFF + INCX
- 20 CONTINUE
- END IF
- RETURN
-*
-* End of ZLACGV
-*
- END
diff --git a/mtx/lapack_src/zlaswp.f b/mtx/lapack_src/zlaswp.f
deleted file mode 100644
index 65edab111..000000000
--- a/mtx/lapack_src/zlaswp.f
+++ /dev/null
@@ -1,191 +0,0 @@
-*> \brief \b ZLASWP
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download ZLASWP + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
-*> [TXT]
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ZLASWP( N, A, LDA, K1, K2, IPIV, INCX )
-*
-* .. Scalar Arguments ..
-* INTEGER INCX, K1, K2, LDA, N
-* ..
-* .. Array Arguments ..
-* INTEGER IPIV( * )
-* COMPLEX*16 A( LDA, * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> 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.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] N
-*> \verbatim
-*> N is INTEGER
-*> The number of columns of the matrix A.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*> A is COMPLEX*16 array, dimension (LDA,N)
-*> On entry, the matrix of column dimension N to which the row
-*> interchanges will be applied.
-*> On exit, the permuted matrix.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*> LDA is INTEGER
-*> The leading dimension of the array A.
-*> \endverbatim
-*>
-*> \param[in] K1
-*> \verbatim
-*> K1 is INTEGER
-*> The first element of IPIV for which a row interchange will
-*> be done.
-*> \endverbatim
-*>
-*> \param[in] K2
-*> \verbatim
-*> K2 is INTEGER
-*> The last element of IPIV for which a row interchange will
-*> be done.
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*> IPIV is INTEGER array, dimension (K2*abs(INCX))
-*> The vector of pivot indices. Only the elements in positions
-*> K1 through K2 of IPIV are accessed.
-*> IPIV(K) = L implies rows K and L are to be interchanged.
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*> INCX is INTEGER
-*> The increment between successive values of IPIV. If IPIV
-*> is negative, the pivots are applied in reverse order.
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2011
-*
-*> \ingroup complex16OTHERauxiliary
-*
-*> \par Further Details:
-* =====================
-*>
-*> \verbatim
-*>
-*> Modified by
-*> R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*> \endverbatim
-*>
-* =====================================================================
- SUBROUTINE ZLASWP( N, A, LDA, K1, K2, IPIV, INCX )
-*
-* -- LAPACK auxiliary routine (version 3.4.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
-*
-* .. Scalar Arguments ..
- INTEGER INCX, K1, K2, LDA, N
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * )
- COMPLEX*16 A( LDA, * )
-* ..
-*
-* =====================================================================
-*
-* .. Local Scalars ..
- INTEGER I, I1, I2, INC, IP, IX, IX0, J, K, N32
- COMPLEX*16 TEMP
-* ..
-* .. Executable Statements ..
-*
-* Interchange row I with row IPIV(I) for each of rows K1 through K2.
-*
- IF( INCX.GT.0 ) THEN
- IX0 = K1
- I1 = K1
- I2 = K2
- INC = 1
- ELSE IF( INCX.LT.0 ) THEN
- IX0 = 1 + ( 1-K2 )*INCX
- I1 = K2
- I2 = K1
- INC = -1
- ELSE
- RETURN
- END IF
-*
- N32 = ( N / 32 )*32
- IF( N32.NE.0 ) THEN
- DO 30 J = 1, N32, 32
- IX = IX0
- DO 20 I = I1, I2, INC
- IP = IPIV( IX )
- IF( IP.NE.I ) THEN
- DO 10 K = J, J + 31
- TEMP = A( I, K )
- A( I, K ) = A( IP, K )
- A( IP, K ) = TEMP
- 10 CONTINUE
- END IF
- IX = IX + INCX
- 20 CONTINUE
- 30 CONTINUE
- END IF
- IF( N32.NE.N ) THEN
- N32 = N32 + 1
- IX = IX0
- DO 50 I = I1, I2, INC
- IP = IPIV( IX )
- IF( IP.NE.I ) THEN
- DO 40 K = N32, N
- TEMP = A( I, K )
- A( I, K ) = A( IP, K )
- A( IP, K ) = TEMP
- 40 CONTINUE
- END IF
- IX = IX + INCX
- 50 CONTINUE
- END IF
-*
- RETURN
-*
-* End of ZLASWP
-*
- END
diff --git a/mtx/lapack_src/zscal.f b/mtx/lapack_src/zscal.f
deleted file mode 100644
index 6ab6007a0..000000000
--- a/mtx/lapack_src/zscal.f
+++ /dev/null
@@ -1,41 +0,0 @@
- SUBROUTINE ZSCAL(N,ZA,ZX,INCX)
-* .. Scalar Arguments ..
- DOUBLE COMPLEX ZA
- INTEGER INCX,N
-* ..
-* .. Array Arguments ..
- DOUBLE COMPLEX ZX(*)
-* ..
-*
-* Purpose
-* =======
-*
-* scales a vector by a constant.
-* jack dongarra, 3/11/78.
-* modified 3/93 to return if incx .le. 0.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-*
-* .. Local Scalars ..
- INTEGER I,IX
-* ..
- IF (N.LE.0 .OR. INCX.LE.0) RETURN
- IF (INCX.EQ.1) GO TO 20
-*
-* code for increment not equal to 1
-*
- IX = 1
- DO 10 I = 1,N
- ZX(IX) = ZA*ZX(IX)
- IX = IX + INCX
- 10 CONTINUE
- RETURN
-*
-* code for increment equal to 1
-*
- 20 DO 30 I = 1,N
- ZX(I) = ZA*ZX(I)
- 30 CONTINUE
- RETURN
- END
-
diff --git a/mtx/lapack_src/zswap.f b/mtx/lapack_src/zswap.f
deleted file mode 100644
index 2eec2d68d..000000000
--- a/mtx/lapack_src/zswap.f
+++ /dev/null
@@ -1,48 +0,0 @@
- SUBROUTINE ZSWAP(N,ZX,INCX,ZY,INCY)
-* .. Scalar Arguments ..
- INTEGER INCX,INCY,N
-* ..
-* .. Array Arguments ..
- DOUBLE COMPLEX ZX(*),ZY(*)
-* ..
-*
-* Purpose
-* =======
-*
-* interchanges two vectors.
-* jack dongarra, 3/11/78.
-* modified 12/3/93, array(1) declarations changed to array(*)
-*
-*
-* .. Local Scalars ..
- DOUBLE COMPLEX ZTEMP
- INTEGER I,IX,IY
-* ..
- IF (N.LE.0) RETURN
- IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20
-*
-* code for unequal increments or equal increments not equal
-* to 1
-*
- IX = 1
- IY = 1
- IF (INCX.LT.0) IX = (-N+1)*INCX + 1
- IF (INCY.LT.0) IY = (-N+1)*INCY + 1
- DO 10 I = 1,N
- ZTEMP = ZX(IX)
- ZX(IX) = ZY(IY)
- ZY(IY) = ZTEMP
- IX = IX + INCX
- IY = IY + INCY
- 10 CONTINUE
- RETURN
-*
-* code for both increments equal to 1
- 20 DO 30 I = 1,N
- ZTEMP = ZX(I)
- ZX(I) = ZY(I)
- ZY(I) = ZTEMP
- 30 CONTINUE
- RETURN
- END
-
diff --git a/mtx/lapack_src/ztbsv.f b/mtx/lapack_src/ztbsv.f
deleted file mode 100644
index 59fcb8047..000000000
--- a/mtx/lapack_src/ztbsv.f
+++ /dev/null
@@ -1,368 +0,0 @@
- SUBROUTINE ZTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
-* .. Scalar Arguments ..
- INTEGER INCX,K,LDA,N
- CHARACTER DIAG,TRANS,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE COMPLEX A(LDA,*),X(*)
-* ..
-*
-* Purpose
-* =======
-*
-* ZTBSV solves one of the systems of equations
-*
-* A*x = b, or A'*x = b, or conjg( A' )*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.
-*
-* Arguments
-* ==========
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANS - CHARACTER*1.
-* On entry, TRANS specifies the equations to be solved as
-* follows:
-*
-* TRANS = 'N' or 'n' A*x = b.
-*
-* TRANS = 'T' or 't' A'*x = b.
-*
-* TRANS = 'C' or 'c' conjg( A' )*x = b.
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit
-* triangular as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the order of the matrix A.
-* N must be at least zero.
-* Unchanged on exit.
-*
-* K - INTEGER.
-* On entry with UPLO = 'U' or 'u', K specifies the number of
-* super-diagonals of the matrix A.
-* On entry with UPLO = 'L' or 'l', K specifies the number of
-* sub-diagonals of the matrix A.
-* K must satisfy 0 .le. K.
-* Unchanged on exit.
-*
-* A - COMPLEX*16 array of DIMENSION ( LDA, n ).
-* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
-* by n part of the array A must contain the upper triangular
-* band part of the matrix of coefficients, supplied column by
-* column, with the leading diagonal of the matrix in row
-* ( k + 1 ) of the array, the first super-diagonal starting at
-* position 2 in row k, and so on. The top left k by k triangle
-* of the array A is not referenced.
-* The following program segment will transfer an upper
-* triangular band matrix from conventional full matrix storage
-* to band storage:
-*
-* DO 20, J = 1, N
-* M = K + 1 - J
-* DO 10, I = MAX( 1, J - K ), J
-* A( M + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
-* by n part of the array A must contain the lower triangular
-* band part of the matrix of coefficients, supplied column by
-* column, with the leading diagonal of the matrix in row 1 of
-* the array, the first sub-diagonal starting at position 1 in
-* row 2, and so on. The bottom right k by k triangle of the
-* array A is not referenced.
-* The following program segment will transfer a lower
-* triangular band matrix from conventional full matrix storage
-* to band storage:
-*
-* DO 20, J = 1, N
-* M = 1 - J
-* DO 10, I = J, MIN( N, J + K )
-* A( M + I, J ) = matrix( I, J )
-* 10 CONTINUE
-* 20 CONTINUE
-*
-* Note that when DIAG = 'U' or 'u' the elements of the array A
-* corresponding to the diagonal elements of the matrix are not
-* referenced, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. LDA must be at least
-* ( k + 1 ).
-* Unchanged on exit.
-*
-* X - COMPLEX*16 array of dimension at least
-* ( 1 + ( n - 1 )*abs( INCX ) ).
-* Before entry, the incremented array X must contain the n
-* element right-hand side vector b. On exit, X is overwritten
-* with the solution vector x.
-*
-* INCX - INTEGER.
-* On entry, INCX specifies the increment for the elements of
-* X. INCX must not be zero.
-* Unchanged on exit.
-*
-*
-* Level 2 Blas routine.
-*
-* -- Written on 22-October-1986.
-* Jack Dongarra, Argonne National Lab.
-* Jeremy Du Croz, Nag Central Office.
-* Sven Hammarling, Nag Central Office.
-* Richard Hanson, Sandia National Labs.
-*
-*
-* .. Parameters ..
- DOUBLE COMPLEX ZERO
- PARAMETER (ZERO= (0.0D+0,0.0D+0))
-* ..
-* .. Local Scalars ..
- DOUBLE COMPLEX TEMP
- INTEGER I,INFO,IX,J,JX,KPLUS1,KX,L
- LOGICAL NOCONJ,NOUNIT
-* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DCONJG,MAX,MIN
-* ..
-*
-* Test the input parameters.
-*
- INFO = 0
- IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
- INFO = 1
- ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
- + .NOT.LSAME(TRANS,'C')) THEN
- INFO = 2
- ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
- INFO = 3
- ELSE IF (N.LT.0) THEN
- INFO = 4
- ELSE IF (K.LT.0) THEN
- INFO = 5
- ELSE IF (LDA.LT. (K+1)) THEN
- INFO = 7
- ELSE IF (INCX.EQ.0) THEN
- INFO = 9
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('ZTBSV',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
- NOCONJ = LSAME(TRANS,'T')
- NOUNIT = LSAME(DIAG,'N')
-*
-* Set up the start point in X if the increment is not unity. This
-* will be ( N - 1 )*INCX too small for descending loops.
-*
- IF (INCX.LE.0) THEN
- KX = 1 - (N-1)*INCX
- ELSE IF (INCX.NE.1) THEN
- KX = 1
- END IF
-*
-* Start the operations. In this version the elements of A are
-* accessed by sequentially with one pass through A.
-*
- IF (LSAME(TRANS,'N')) THEN
-*
-* Form x := inv( A )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KPLUS1 = K + 1
- IF (INCX.EQ.1) THEN
- DO 20 J = N,1,-1
- IF (X(J).NE.ZERO) THEN
- L = KPLUS1 - J
- IF (NOUNIT) X(J) = X(J)/A(KPLUS1,J)
- TEMP = X(J)
- DO 10 I = J - 1,MAX(1,J-K),-1
- X(I) = X(I) - TEMP*A(L+I,J)
- 10 CONTINUE
- END IF
- 20 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 40 J = N,1,-1
- KX = KX - INCX
- IF (X(JX).NE.ZERO) THEN
- IX = KX
- L = KPLUS1 - J
- IF (NOUNIT) X(JX) = X(JX)/A(KPLUS1,J)
- TEMP = X(JX)
- DO 30 I = J - 1,MAX(1,J-K),-1
- X(IX) = X(IX) - TEMP*A(L+I,J)
- IX = IX - INCX
- 30 CONTINUE
- END IF
- JX = JX - INCX
- 40 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 60 J = 1,N
- IF (X(J).NE.ZERO) THEN
- L = 1 - J
- IF (NOUNIT) X(J) = X(J)/A(1,J)
- TEMP = X(J)
- DO 50 I = J + 1,MIN(N,J+K)
- X(I) = X(I) - TEMP*A(L+I,J)
- 50 CONTINUE
- END IF
- 60 CONTINUE
- ELSE
- JX = KX
- DO 80 J = 1,N
- KX = KX + INCX
- IF (X(JX).NE.ZERO) THEN
- IX = KX
- L = 1 - J
- IF (NOUNIT) X(JX) = X(JX)/A(1,J)
- TEMP = X(JX)
- DO 70 I = J + 1,MIN(N,J+K)
- X(IX) = X(IX) - TEMP*A(L+I,J)
- IX = IX + INCX
- 70 CONTINUE
- END IF
- JX = JX + INCX
- 80 CONTINUE
- END IF
- END IF
- ELSE
-*
-* Form x := inv( A' )*x or x := inv( conjg( A') )*x.
-*
- IF (LSAME(UPLO,'U')) THEN
- KPLUS1 = K + 1
- IF (INCX.EQ.1) THEN
- DO 110 J = 1,N
- TEMP = X(J)
- L = KPLUS1 - J
- IF (NOCONJ) THEN
- DO 90 I = MAX(1,J-K),J - 1
- TEMP = TEMP - A(L+I,J)*X(I)
- 90 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(KPLUS1,J)
- ELSE
- DO 100 I = MAX(1,J-K),J - 1
- TEMP = TEMP - DCONJG(A(L+I,J))*X(I)
- 100 CONTINUE
- IF (NOUNIT) TEMP = TEMP/DCONJG(A(KPLUS1,J))
- END IF
- X(J) = TEMP
- 110 CONTINUE
- ELSE
- JX = KX
- DO 140 J = 1,N
- TEMP = X(JX)
- IX = KX
- L = KPLUS1 - J
- IF (NOCONJ) THEN
- DO 120 I = MAX(1,J-K),J - 1
- TEMP = TEMP - A(L+I,J)*X(IX)
- IX = IX + INCX
- 120 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(KPLUS1,J)
- ELSE
- DO 130 I = MAX(1,J-K),J - 1
- TEMP = TEMP - DCONJG(A(L+I,J))*X(IX)
- IX = IX + INCX
- 130 CONTINUE
- IF (NOUNIT) TEMP = TEMP/DCONJG(A(KPLUS1,J))
- END IF
- X(JX) = TEMP
- JX = JX + INCX
- IF (J.GT.K) KX = KX + INCX
- 140 CONTINUE
- END IF
- ELSE
- IF (INCX.EQ.1) THEN
- DO 170 J = N,1,-1
- TEMP = X(J)
- L = 1 - J
- IF (NOCONJ) THEN
- DO 150 I = MIN(N,J+K),J + 1,-1
- TEMP = TEMP - A(L+I,J)*X(I)
- 150 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(1,J)
- ELSE
- DO 160 I = MIN(N,J+K),J + 1,-1
- TEMP = TEMP - DCONJG(A(L+I,J))*X(I)
- 160 CONTINUE
- IF (NOUNIT) TEMP = TEMP/DCONJG(A(1,J))
- END IF
- X(J) = TEMP
- 170 CONTINUE
- ELSE
- KX = KX + (N-1)*INCX
- JX = KX
- DO 200 J = N,1,-1
- TEMP = X(JX)
- IX = KX
- L = 1 - J
- IF (NOCONJ) THEN
- DO 180 I = MIN(N,J+K),J + 1,-1
- TEMP = TEMP - A(L+I,J)*X(IX)
- IX = IX - INCX
- 180 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(1,J)
- ELSE
- DO 190 I = MIN(N,J+K),J + 1,-1
- TEMP = TEMP - DCONJG(A(L+I,J))*X(IX)
- IX = IX - INCX
- 190 CONTINUE
- IF (NOUNIT) TEMP = TEMP/DCONJG(A(1,J))
- END IF
- X(JX) = TEMP
- JX = JX - INCX
- IF ((N-J).GE.K) KX = KX - INCX
- 200 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of ZTBSV .
-*
- END
-
diff --git a/mtx/lapack_src/ztrsm.f b/mtx/lapack_src/ztrsm.f
deleted file mode 100644
index e199806e6..000000000
--- a/mtx/lapack_src/ztrsm.f
+++ /dev/null
@@ -1,408 +0,0 @@
- SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
-* .. Scalar Arguments ..
- DOUBLE COMPLEX ALPHA
- INTEGER LDA,LDB,M,N
- CHARACTER DIAG,SIDE,TRANSA,UPLO
-* ..
-* .. Array Arguments ..
- DOUBLE COMPLEX A(LDA,*),B(LDB,*)
-* ..
-*
-* Purpose
-* =======
-*
-* 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' or op( A ) = conjg( A' ).
-*
-* The matrix X is overwritten on B.
-*
-* Arguments
-* ==========
-*
-* SIDE - CHARACTER*1.
-* On entry, SIDE specifies whether op( A ) appears on the left
-* or right of X as follows:
-*
-* SIDE = 'L' or 'l' op( A )*X = alpha*B.
-*
-* SIDE = 'R' or 'r' X*op( A ) = alpha*B.
-*
-* Unchanged on exit.
-*
-* UPLO - CHARACTER*1.
-* On entry, UPLO specifies whether the matrix A is an upper or
-* lower triangular matrix as follows:
-*
-* UPLO = 'U' or 'u' A is an upper triangular matrix.
-*
-* UPLO = 'L' or 'l' A is a lower triangular matrix.
-*
-* Unchanged on exit.
-*
-* TRANSA - CHARACTER*1.
-* On entry, TRANSA specifies the form of op( A ) to be used in
-* the matrix multiplication as follows:
-*
-* TRANSA = 'N' or 'n' op( A ) = A.
-*
-* TRANSA = 'T' or 't' op( A ) = A'.
-*
-* TRANSA = 'C' or 'c' op( A ) = conjg( A' ).
-*
-* Unchanged on exit.
-*
-* DIAG - CHARACTER*1.
-* On entry, DIAG specifies whether or not A is unit triangular
-* as follows:
-*
-* DIAG = 'U' or 'u' A is assumed to be unit triangular.
-*
-* DIAG = 'N' or 'n' A is not assumed to be unit
-* triangular.
-*
-* Unchanged on exit.
-*
-* M - INTEGER.
-* On entry, M specifies the number of rows of B. M must be at
-* least zero.
-* Unchanged on exit.
-*
-* N - INTEGER.
-* On entry, N specifies the number of columns of B. N must be
-* at least zero.
-* Unchanged on exit.
-*
-* ALPHA - COMPLEX*16 .
-* On entry, ALPHA specifies the scalar alpha. When alpha is
-* zero then A is not referenced and B need not be set before
-* entry.
-* Unchanged on exit.
-*
-* A - COMPLEX*16 array of DIMENSION ( LDA, k ), where k is m
-* when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
-* Before entry with UPLO = 'U' or 'u', the leading k by k
-* upper triangular part of the array A must contain the upper
-* triangular matrix and the strictly lower triangular part of
-* A is not referenced.
-* Before entry with UPLO = 'L' or 'l', the leading k by k
-* lower triangular part of the array A must contain the lower
-* triangular matrix and the strictly upper triangular part of
-* A is not referenced.
-* Note that when DIAG = 'U' or 'u', the diagonal elements of
-* A are not referenced either, but are assumed to be unity.
-* Unchanged on exit.
-*
-* LDA - INTEGER.
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When SIDE = 'L' or 'l' then
-* LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
-* then LDA must be at least max( 1, n ).
-* Unchanged on exit.
-*
-* B - COMPLEX*16 array of DIMENSION ( LDB, n ).
-* Before entry, the leading m by n part of the array B must
-* contain the right-hand side matrix B, and on exit is
-* overwritten by the solution matrix X.
-*
-* LDB - INTEGER.
-* On entry, LDB specifies the first dimension of B as declared
-* in the calling (sub) program. LDB must be at least
-* max( 1, m ).
-* Unchanged on exit.
-*
-*
-* Level 3 Blas routine.
-*
-* -- Written on 8-February-1989.
-* Jack Dongarra, Argonne National Laboratory.
-* Iain Duff, AERE Harwell.
-* Jeremy Du Croz, Numerical Algorithms Group Ltd.
-* Sven Hammarling, Numerical Algorithms Group Ltd.
-*
-*
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
-* .. External Subroutines ..
- EXTERNAL XERBLA
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC DCONJG,MAX
-* ..
-* .. Local Scalars ..
- DOUBLE COMPLEX TEMP
- INTEGER I,INFO,J,K,NROWA
- LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER
-* ..
-* .. Parameters ..
- DOUBLE COMPLEX ONE
- PARAMETER (ONE= (1.0D+0,0.0D+0))
- DOUBLE COMPLEX ZERO
- PARAMETER (ZERO= (0.0D+0,0.0D+0))
-* ..
-*
-* Test the input parameters.
-*
- LSIDE = LSAME(SIDE,'L')
- IF (LSIDE) THEN
- NROWA = M
- ELSE
- NROWA = N
- END IF
- NOCONJ = LSAME(TRANSA,'T')
- NOUNIT = LSAME(DIAG,'N')
- UPPER = LSAME(UPLO,'U')
-*
- INFO = 0
- IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
- INFO = 1
- ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
- INFO = 2
- ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
- + (.NOT.LSAME(TRANSA,'T')) .AND.
- + (.NOT.LSAME(TRANSA,'C'))) THEN
- INFO = 3
- ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
- INFO = 4
- ELSE IF (M.LT.0) THEN
- INFO = 5
- ELSE IF (N.LT.0) THEN
- INFO = 6
- ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
- INFO = 9
- ELSE IF (LDB.LT.MAX(1,M)) THEN
- INFO = 11
- END IF
- IF (INFO.NE.0) THEN
- CALL XERBLA('ZTRSM',INFO)
- RETURN
- END IF
-*
-* Quick return if possible.
-*
- IF (N.EQ.0) RETURN
-*
-* And when alpha.eq.zero.
-*
- IF (ALPHA.EQ.ZERO) THEN
- DO 20 J = 1,N
- DO 10 I = 1,M
- B(I,J) = ZERO
- 10 CONTINUE
- 20 CONTINUE
- RETURN
- END IF
-*
-* Start the operations.
-*
- IF (LSIDE) THEN
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*inv( A )*B.
-*
- IF (UPPER) THEN
- DO 60 J = 1,N
- IF (ALPHA.NE.ONE) THEN
- DO 30 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 30 CONTINUE
- END IF
- DO 50 K = M,1,-1
- IF (B(K,J).NE.ZERO) THEN
- IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
- DO 40 I = 1,K - 1
- B(I,J) = B(I,J) - B(K,J)*A(I,K)
- 40 CONTINUE
- END IF
- 50 CONTINUE
- 60 CONTINUE
- ELSE
- DO 100 J = 1,N
- IF (ALPHA.NE.ONE) THEN
- DO 70 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 70 CONTINUE
- END IF
- DO 90 K = 1,M
- IF (B(K,J).NE.ZERO) THEN
- IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
- DO 80 I = K + 1,M
- B(I,J) = B(I,J) - B(K,J)*A(I,K)
- 80 CONTINUE
- END IF
- 90 CONTINUE
- 100 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*inv( A' )*B
-* or B := alpha*inv( conjg( A' ) )*B.
-*
- IF (UPPER) THEN
- DO 140 J = 1,N
- DO 130 I = 1,M
- TEMP = ALPHA*B(I,J)
- IF (NOCONJ) THEN
- DO 110 K = 1,I - 1
- TEMP = TEMP - A(K,I)*B(K,J)
- 110 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(I,I)
- ELSE
- DO 120 K = 1,I - 1
- TEMP = TEMP - DCONJG(A(K,I))*B(K,J)
- 120 CONTINUE
- IF (NOUNIT) TEMP = TEMP/DCONJG(A(I,I))
- END IF
- B(I,J) = TEMP
- 130 CONTINUE
- 140 CONTINUE
- ELSE
- DO 180 J = 1,N
- DO 170 I = M,1,-1
- TEMP = ALPHA*B(I,J)
- IF (NOCONJ) THEN
- DO 150 K = I + 1,M
- TEMP = TEMP - A(K,I)*B(K,J)
- 150 CONTINUE
- IF (NOUNIT) TEMP = TEMP/A(I,I)
- ELSE
- DO 160 K = I + 1,M
- TEMP = TEMP - DCONJG(A(K,I))*B(K,J)
- 160 CONTINUE
- IF (NOUNIT) TEMP = TEMP/DCONJG(A(I,I))
- END IF
- B(I,J) = TEMP
- 170 CONTINUE
- 180 CONTINUE
- END IF
- END IF
- ELSE
- IF (LSAME(TRANSA,'N')) THEN
-*
-* Form B := alpha*B*inv( A ).
-*
- IF (UPPER) THEN
- DO 230 J = 1,N
- IF (ALPHA.NE.ONE) THEN
- DO 190 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 190 CONTINUE
- END IF
- DO 210 K = 1,J - 1
- IF (A(K,J).NE.ZERO) THEN
- DO 200 I = 1,M
- B(I,J) = B(I,J) - A(K,J)*B(I,K)
- 200 CONTINUE
- END IF
- 210 CONTINUE
- IF (NOUNIT) THEN
- TEMP = ONE/A(J,J)
- DO 220 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 220 CONTINUE
- END IF
- 230 CONTINUE
- ELSE
- DO 280 J = N,1,-1
- IF (ALPHA.NE.ONE) THEN
- DO 240 I = 1,M
- B(I,J) = ALPHA*B(I,J)
- 240 CONTINUE
- END IF
- DO 260 K = J + 1,N
- IF (A(K,J).NE.ZERO) THEN
- DO 250 I = 1,M
- B(I,J) = B(I,J) - A(K,J)*B(I,K)
- 250 CONTINUE
- END IF
- 260 CONTINUE
- IF (NOUNIT) THEN
- TEMP = ONE/A(J,J)
- DO 270 I = 1,M
- B(I,J) = TEMP*B(I,J)
- 270 CONTINUE
- END IF
- 280 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*B*inv( A' )
-* or B := alpha*B*inv( conjg( A' ) ).
-*
- IF (UPPER) THEN
- DO 330 K = N,1,-1
- IF (NOUNIT) THEN
- IF (NOCONJ) THEN
- TEMP = ONE/A(K,K)
- ELSE
- TEMP = ONE/DCONJG(A(K,K))
- END IF
- DO 290 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 290 CONTINUE
- END IF
- DO 310 J = 1,K - 1
- IF (A(J,K).NE.ZERO) THEN
- IF (NOCONJ) THEN
- TEMP = A(J,K)
- ELSE
- TEMP = DCONJG(A(J,K))
- END IF
- DO 300 I = 1,M
- B(I,J) = B(I,J) - TEMP*B(I,K)
- 300 CONTINUE
- END IF
- 310 CONTINUE
- IF (ALPHA.NE.ONE) THEN
- DO 320 I = 1,M
- B(I,K) = ALPHA*B(I,K)
- 320 CONTINUE
- END IF
- 330 CONTINUE
- ELSE
- DO 380 K = 1,N
- IF (NOUNIT) THEN
- IF (NOCONJ) THEN
- TEMP = ONE/A(K,K)
- ELSE
- TEMP = ONE/DCONJG(A(K,K))
- END IF
- DO 340 I = 1,M
- B(I,K) = TEMP*B(I,K)
- 340 CONTINUE
- END IF
- DO 360 J = K + 1,N
- IF (A(J,K).NE.ZERO) THEN
- IF (NOCONJ) THEN
- TEMP = A(J,K)
- ELSE
- TEMP = DCONJG(A(J,K))
- END IF
- DO 350 I = 1,M
- B(I,J) = B(I,J) - TEMP*B(I,K)
- 350 CONTINUE
- END IF
- 360 CONTINUE
- IF (ALPHA.NE.ONE) THEN
- DO 370 I = 1,M
- B(I,K) = ALPHA*B(I,K)
- 370 CONTINUE
- END IF
- 380 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of ZTRSM .
-*
- END
-
diff --git a/mtx/make/makefile_base b/mtx/make/makefile_base
index a288df3cd..a21ae3cb3 100644
--- a/mtx/make/makefile_base
+++ b/mtx/make/makefile_base
@@ -12,176 +12,6 @@ include $(MESA_DIR)/utils/makefile_header
#
# SOURCES
-# WHB removed dlazq3.f because it fails to compile with ifort 2018:
-# ../lapack_src/dlazq3.f(219): error #6633: The type of the actual argument differs from the type of the dummy argument. [IEEE]
-# $ DN1, DN2, IEEE )
-# --------------------------------^
-# ../lapack_src/dlazq3.f(218): error #6631: A non-optional actual argument must be present when invoking a procedure with an explicit interface. [IEEE]
-# CALL DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,
-# --------------^
-# ../lapack_src/dlazq3.f(218): error #6631: A non-optional actual argument must be present when invoking a procedure with an explicit interface. [EPS]
-# CALL DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,
-# --------------^
-
-ifeq ($(WHICH_LAPACK),USE_SRCS)
- LAPACK_SRCS = \
- dgbcon.f \
- dgbequ.f \
- dgbrfs.f \
- dgbsv.f \
- dgbsvx.f \
- dgbtf2.f \
- dgbtrf.f \
- dgbtrs.f \
- dgecon.f \
- dgeequ.f \
- dgerfs.f \
- dgesv.f \
- dgesvx.f \
- dgetf2.f \
- dgetrf.f \
- dgetrs.f \
- dgtcon.f \
- dgtrfs.f \
- dgtsv.f \
- dgtsvx.f \
- dgttrf.f \
- dgttrs.f \
- dgtts2.f \
- disnan.f \
- dlacn2.f \
- dlabad.f \
- dlacpy.f \
- dlagtm.f \
- dlangb.f \
- dlange.f \
- dlangt.f \
- dlantb.f \
- dlantr.f \
- dlaqgb.f \
- dlaqge.f \
- dlassq.f \
- dlaswp.f \
- dlatbs.f \
- dlatrs.f \
- drscl.f \
- dgetri.f \
- dgesvd.f \
- dnrm2.f \
- dlasq3.f \
- dlasq4.f \
- dbdsqr.f \
- dgelqf.f \
- dlascl.f \
- dorgbr.f \
- dorgqr.f \
- dtrtri.f \
- dgebrd.f \
- dgeqrf.f \
- dlaset.f \
- dorglq.f \
- dormbr.f \
- dgebd2.f \
- dgeqr2.f \
- dlarfb.f \
- dlartg.f \
- dlasq1.f \
- dlasv2.f \
- dorgl2.f \
- dormqr.f \
- dtrmm.f \
- dgelq2.f \
- dlabrd.f \
- dlarft.f \
- dlas2.f \
- dlasr.f \
- dorg2r.f \
- dormlq.f \
- drot.f \
- dtrti2.f \
- dtrtrs.f \
- dlarf.f \
- dlarfg.f \
- dlasrt.f \
- dorm2r.f \
- dorml2.f \
- dlapy2.f \
- dlasq2.f \
- dtrmv.f \
- dlasq5.f \
- dlasq6.f \
- dlazq4.f \
- dcabs1.f \
- dlamch.f \
- dlaisnan.f \
- icmax1.f \
- ilaclr.f \
- iladlr.f \
- ilaslc.f \
- ilauplo.f \
- ilazlr.f \
- izmax1.f \
- ieeeck.f \
- iladiag.f \
- ilaenv.f \
- ilaslr.f \
- ilaver.f \
- iparmq.f \
- ilaclc.f \
- iladlc.f \
- ilaprec.f \
- ilatrans.f \
- ilazlc.f \
- izamax.f \
- sgesv.f \
- sgetf2.f \
- sgetrf.f \
- sgetrs.f \
- slaswp.f \
- zgbtrf.f \
- zgbtrs.f \
- zgetrf.f \
- zgetrs.f \
- zgetf2.f \
- zlaswp.f \
- zlacgv.f \
- zswap.f \
- zgeru.f \
- ztbsv.f \
- zgemv.f \
- ztrsm.f \
- zgbtf2.f \
- zgttrf.f \
- zgttrs.f \
- zgtts2.f \
- zscal.f \
- zcopy.f \
- zgemm.f \
- dgeev.f \
- dgebal.f \
- dgehrd.f \
- dorghr.f \
- dhseqr.f \
- dtrevc.f \
- dgebak.f \
- dlahr2.f \
- dgehd2.f \
- dlaqr0.f \
- dlahqr.f \
- dlaln2.f \
- dlaqr3.f \
- dlanv2.f \
- dladiv.f \
- dlaqr4.f \
- dlaqr5.f \
- dlaqr1.f \
- dlaqr2.f \
- dormhr.f \
- dtrexc.f \
- dlaexc.f \
- dlasy2.f \
- dlarfx.f
-endif
LAPACK_QUAD_SRCS = \
qgttrf.f \
@@ -201,39 +31,6 @@ LAPACK_QUAD_SRCS = \
qlamch.f \
qlaswp.f
-ifeq ($(WHICH_BLAS),USE_SRCS)
- BLAS_SRCS = \
- dgemm.f \
- dtrsm.f \
- xerbla.f \
- lsame.f \
- dger.f \
- dcopy.f \
- dgemv.f \
- dtbsv.f \
- daxpy.f \
- ddot.f \
- dgbmv.f \
- dasum.f \
- dtrsv.f \
- dscal.f \
- dswap.f \
- idamax.f \
- strsm.f \
- sgemm.f \
- slamch.f \
- isamax.f \
- sswap.f \
- sscal.f \
- sger.f \
- zaxpy.f \
- zdotc.f \
- zgerc.f \
- zhemv.f \
- zher2.f \
- ztrsv.f
-endif
-
MTX_SRCS = \
mtx_def.f \
my_lapack95_dble.f90 \
@@ -258,23 +55,10 @@ endif
# TARGETS
MTX_LIB = libmtx.$(LIB_SUFFIX)
-LAPACK_LIB = libmesalapack.$(LIB_SUFFIX)
-BLAS_LIB = libmesablas.$(LIB_SUFFIX)
-
-ifeq ($(WHICH_LAPACK),USE_SRCS)
- LAPACK_LIB = libmesalapack.$(LIB_SUFFIX)
- BLAS_LIB = libmesablas.$(LIB_SUFFIX)
-endif
MTX_OBJS = $(patsubst %.f,%.o,$(patsubst %.f90,%.o,$(MTX_SRCS) $(LAPACK_QUAD_SRCS)))
-LAPACK_OBJS = $(patsubst %.f,%.o,$(patsubst %.f90,%.o,$(LAPACK_SRCS)))
-BLAS_OBJS = $(patsubst %.f,%.o,$(patsubst %.f90,%.o,$(BLAS_SRCS)))
-ifeq ($(WHICH_LAPACK),USE_SRCS)
- all : $(MTX_LIB) $(LAPACK_LIB) $(BLAS_LIB)
-else
- all : $(MTX_LIB)
-endif
+all : $(MTX_LIB)
$(MTX_LIB) :$(MTX_OBJS)
ifneq ($(QUIET),)
@@ -284,22 +68,6 @@ else
$(LIB_TOOL) $@ $(MTX_OBJS)
endif
-$(LAPACK_LIB) : $(LAPACK_OBJS)
-ifneq ($(QUIET),)
- @echo LIB_TOOL $@
- @$(LIB_TOOL) $@ $(LAPACK_OBJS)
-else
- $(LIB_TOOL) $@ $(LAPACK_OBJS)
-endif
-
-$(BLAS_LIB) : $(BLAS_OBJS)
-ifneq ($(QUIET),)
- @echo LIB_TOOL $@
- @$(LIB_TOOL) $@ $(BLAS_OBJS)
-else
- $(LIB_TOOL) $@ $(BLAS_OBJS)
-endif
-
clean:
-@rm -f *.o *.f90 *.mod *genmod.f90 *.so *.a .depend *.smod
@@ -309,12 +77,6 @@ install:
@$(CP_IF_NEWER) ../public/mtx_*.dek $(MESA_DIR)/include
@$(CP_IF_NEWER) ../public/mtx_*.inc $(MESA_DIR)/include
@$(CP_IF_NEWER) $(MTX_LIB) $(MESA_DIR)/lib
-ifeq ($(WHICH_LAPACK),USE_SRCS)
- @$(CP_IF_NEWER) $(BLAS_LIB) $(MESA_DIR)/lib
-endif
-ifeq ($(WHICH_BLAS),USE_SRCS)
- @$(CP_IF_NEWER) $(LAPACK_LIB) $(MESA_DIR)/lib
-endif
nodeps : $(.DEFAULT_GOAL)
@@ -334,15 +96,8 @@ COMPILE_XTRA_NO_OPT = $(COMPILE_BASIC) $(FCnowarn) $(FCfixed) -c
COMPILE_CMD = $(COMPILE)
-$(LAPACK_OBJS) : COMPILE_CMD = $(COMPILE_XTRA) -std=gnu -w
-
$(LAPACK_QUAD_OBJS) : COMPILE_CMD = $(COMPILE_XTRA) -w
-$(filter-out dlamch.o,$(BLAS_OBJS)) : COMPILE_CMD = $(COMPILE_XTRA) -std=gnu -w
-
-# must turn off optimization for dlamch or can get infinite loop!!!
-dlamch.o : COMPILE_CMD = $(COMPILE_XTRA_NO_OPT)
-
%.o : %.mod
%.o : %.f
@@ -368,7 +123,7 @@ endif
#
# DEPENDENCIES
-SRC_PATH = $(MOD_PUBLIC_DIR):$(MOD_PRIVATE_DIR):../blas_src:../lapack_src:../lapack_quad
+SRC_PATH = $(MOD_PUBLIC_DIR):$(MOD_PRIVATE_DIR):../lapack_quad
vpath %.f $(SRC_PATH)
vpath %.f90 $(SRC_PATH)
diff --git a/utils/makefile_header b/utils/makefile_header
index 368d5ab90..80c721558 100644
--- a/utils/makefile_header
+++ b/utils/makefile_header
@@ -73,9 +73,6 @@ endif
# step 3) specify which LAPACK and BLAS libraries to use for mesa/mtx
-WHICH_LAPACK95 =
-WHICH_LAPACK =
-WHICH_BLAS =
LOAD_LAPACK95 = `mesasdk_lapack95_link`
LOAD_LAPACK = `mesasdk_lapack_link`
LOAD_BLAS = `mesasdk_blas_link`
diff --git a/utils/makefile_header_non_mesasdk b/utils/makefile_header_non_mesasdk
index 69d983da6..5e8e6f002 100644
--- a/utils/makefile_header_non_mesasdk
+++ b/utils/makefile_header_non_mesasdk
@@ -40,9 +40,7 @@ endif
# step 3) specify which BLAS and LAPACK libraries to use for mesa/mtx
# these are the standard defaults
-WHICH_LAPACK = USE_SRCS
LOAD_LAPACK = -lmesalapack
-WHICH_BLAS = USE_SRCS
LOAD_BLAS = -lmesablas
MKL_INCLUDE =