diff --git a/lib/linalg/dcabs1.f b/lib/linalg/dcabs1.f
new file mode 100644
index 0000000000000000000000000000000000000000..f6debb9ac261ffd2987feec1ef8bad9b2ec964bf
--- /dev/null
+++ b/lib/linalg/dcabs1.f
@@ -0,0 +1,58 @@
+*> \brief \b DCABS1
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* DOUBLE PRECISION FUNCTION DCABS1(Z)
+*
+* .. Scalar Arguments ..
+* COMPLEX*16 Z
+* ..
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DCABS1 computes absolute value of a double complex number
+*> \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
+*
+* =====================================================================
+ DOUBLE PRECISION FUNCTION DCABS1(Z)
+*
+* -- 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 Z
+* ..
+* ..
+* =====================================================================
+*
+* .. Intrinsic Functions ..
+ INTRINSIC ABS,DBLE,DIMAG
+*
+ DCABS1 = ABS(DBLE(Z)) + ABS(DIMAG(Z))
+ RETURN
+ END
diff --git a/lib/linalg/dgesv.f b/lib/linalg/dgesv.f
new file mode 100644
index 0000000000000000000000000000000000000000..8d47f839dce221867a940cdad64ec390f789c755
--- /dev/null
+++ b/lib/linalg/dgesv.f
@@ -0,0 +1,179 @@
+*> \brief <b> DGESV computes the solution to system of linear equations A * X = B for GE matrices</b>
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DGESV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgesv.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgesv.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgesv.f">
+*> [TXT]</a>
+*> \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/lib/linalg/dgetrs.f b/lib/linalg/dgetrs.f
new file mode 100644
index 0000000000000000000000000000000000000000..02e9832af79bbb45e570db2fe226a5324ea64d39
--- /dev/null
+++ b/lib/linalg/dgetrs.f
@@ -0,0 +1,225 @@
+*> \brief \b DGETRS
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DGETRS + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgetrs.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgetrs.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgetrs.f">
+*> [TXT]</a>
+*> \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/lib/linalg/dladiv.f b/lib/linalg/dladiv.f
new file mode 100644
index 0000000000000000000000000000000000000000..306a6b0020e39a5dd94b0045cc85ba15b33a678e
--- /dev/null
+++ b/lib/linalg/dladiv.f
@@ -0,0 +1,128 @@
+*> \brief \b DLADIV performs complex division in real arithmetic, avoiding unnecessary overflow.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DLADIV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dladiv.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dladiv.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dladiv.f">
+*> [TXT]</a>
+*> \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 September 2012
+*
+*> \ingroup auxOTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE DLADIV( A, B, C, D, P, Q )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. 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/lib/linalg/dlapy3.f b/lib/linalg/dlapy3.f
new file mode 100644
index 0000000000000000000000000000000000000000..23feecc4478a3ed002b7bdd5ec5c4c00c98603f6
--- /dev/null
+++ b/lib/linalg/dlapy3.f
@@ -0,0 +1,111 @@
+*> \brief \b DLAPY3 returns sqrt(x2+y2+z2).
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DLAPY3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapy3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapy3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapy3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
+*
+* .. Scalar Arguments ..
+* DOUBLE PRECISION X, Y, Z
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DLAPY3 returns sqrt(x**2+y**2+z**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
+*> \endverbatim
+*>
+*> \param[in] Z
+*> \verbatim
+*> Z is DOUBLE PRECISION
+*> X, Y and Z specify the values x, y and z.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date September 2012
+*
+*> \ingroup auxOTHERauxiliary
+*
+* =====================================================================
+ DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. Scalar Arguments ..
+ DOUBLE PRECISION X, Y, Z
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D0 )
+* ..
+* .. Local Scalars ..
+ DOUBLE PRECISION W, XABS, YABS, ZABS
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, SQRT
+* ..
+* .. Executable Statements ..
+*
+ XABS = ABS( X )
+ YABS = ABS( Y )
+ ZABS = ABS( Z )
+ W = MAX( XABS, YABS, ZABS )
+ IF( W.EQ.ZERO ) THEN
+* W can be zero for max(0,nan,0)
+* adding all three entries together will make sure
+* NaN will not disappear.
+ DLAPY3 = XABS + YABS + ZABS
+ ELSE
+ DLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+
+ $ ( ZABS / W )**2 )
+ END IF
+ RETURN
+*
+* End of DLAPY3
+*
+ END
diff --git a/lib/linalg/dorg2l.f b/lib/linalg/dorg2l.f
new file mode 100644
index 0000000000000000000000000000000000000000..b95fa50fc52e0b4da682052cd46e400b6ad2bcee
--- /dev/null
+++ b/lib/linalg/dorg2l.f
@@ -0,0 +1,198 @@
+*> \brief \b DORG2L generates all or part of the orthogonal matrix Q from a QL factorization determined by sgeqlf (unblocked algorithm).
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DORG2L + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorg2l.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorg2l.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorg2l.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DORG2L( 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
+*>
+*> DORG2L generates an m by n real matrix Q with orthonormal columns,
+*> which is defined as the last n columns of a product of k elementary
+*> reflectors of order m
+*>
+*> Q = H(k) . . . H(2) H(1)
+*>
+*> as returned by DGEQLF.
+*> \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 (n-k+i)-th column must contain the vector which
+*> defines the elementary reflector H(i), for i = 1,2,...,k, as
+*> returned by DGEQLF in the last 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 DGEQLF.
+*> \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 September 2012
+*
+*> \ingroup doubleOTHERcomputational
+*
+* =====================================================================
+ SUBROUTINE DORG2L( M, N, K, A, LDA, TAU, WORK, INFO )
+*
+* -- LAPACK computational routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. 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, II, 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( 'DORG2L', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.LE.0 )
+ $ RETURN
+*
+* Initialise columns 1:n-k to columns of the unit matrix
+*
+ DO 20 J = 1, N - K
+ DO 10 L = 1, M
+ A( L, J ) = ZERO
+ 10 CONTINUE
+ A( M-N+J, J ) = ONE
+ 20 CONTINUE
+*
+ DO 40 I = 1, K
+ II = N - K + I
+*
+* Apply H(i) to A(1:m-k+i,1:n-k+i) from the left
+*
+ A( M-N+II, II ) = ONE
+ CALL DLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), A,
+ $ LDA, WORK )
+ CALL DSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 )
+ A( M-N+II, II ) = ONE - TAU( I )
+*
+* Set A(m-k+i+1:m,n-k+i) to zero
+*
+ DO 30 L = M - N + II + 1, M
+ A( L, II ) = ZERO
+ 30 CONTINUE
+ 40 CONTINUE
+ RETURN
+*
+* End of DORG2L
+*
+ END
diff --git a/lib/linalg/dorgql.f b/lib/linalg/dorgql.f
new file mode 100644
index 0000000000000000000000000000000000000000..ca4698d799dbb9ef7568a696210891aaece4ad10
--- /dev/null
+++ b/lib/linalg/dorgql.f
@@ -0,0 +1,296 @@
+*> \brief \b DORGQL
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DORGQL + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorgql.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorgql.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorgql.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DORGQL( 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
+*>
+*> DORGQL generates an M-by-N real matrix Q with orthonormal columns,
+*> which is defined as the last N columns of a product of K elementary
+*> reflectors of order M
+*>
+*> Q = H(k) . . . H(2) H(1)
+*>
+*> as returned by DGEQLF.
+*> \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 (n-k+i)-th column must contain the vector which
+*> defines the elementary reflector H(i), for i = 1,2,...,k, as
+*> returned by DGEQLF in the last 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 DGEQLF.
+*> \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 DORGQL( 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, KK, L, LDWORK, LWKOPT,
+ $ NB, NBMIN, NX
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLARFB, DLARFT, DORG2L, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. External Functions ..
+ INTEGER ILAENV
+ EXTERNAL ILAENV
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ 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
+ END IF
+*
+ IF( INFO.EQ.0 ) THEN
+ IF( N.EQ.0 ) THEN
+ LWKOPT = 1
+ ELSE
+ NB = ILAENV( 1, 'DORGQL', ' ', M, N, K, -1 )
+ LWKOPT = N*NB
+ END IF
+ WORK( 1 ) = LWKOPT
+*
+ IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
+ INFO = -8
+ END IF
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DORGQL', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ 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, 'DORGQL', ' ', 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, 'DORGQL', ' ', 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 first block.
+* The last kk columns are handled by the block method.
+*
+ KK = MIN( K, ( ( K-NX+NB-1 ) / NB )*NB )
+*
+* Set A(m-kk+1:m,1:n-kk) to zero.
+*
+ DO 20 J = 1, N - KK
+ DO 10 I = M - KK + 1, M
+ A( I, J ) = ZERO
+ 10 CONTINUE
+ 20 CONTINUE
+ ELSE
+ KK = 0
+ END IF
+*
+* Use unblocked code for the first or only block.
+*
+ CALL DORG2L( M-KK, N-KK, K-KK, A, LDA, TAU, WORK, IINFO )
+*
+ IF( KK.GT.0 ) THEN
+*
+* Use blocked code
+*
+ DO 50 I = K - KK + 1, K, NB
+ IB = MIN( NB, K-I+1 )
+ IF( N-K+I.GT.1 ) THEN
+*
+* Form the triangular factor of the block reflector
+* H = H(i+ib-1) . . . H(i+1) H(i)
+*
+ CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB,
+ $ A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK )
+*
+* Apply H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left
+*
+ CALL DLARFB( 'Left', 'No transpose', 'Backward',
+ $ 'Columnwise', M-K+I+IB-1, N-K+I-1, IB,
+ $ A( 1, N-K+I ), LDA, WORK, LDWORK, A, LDA,
+ $ WORK( IB+1 ), LDWORK )
+ END IF
+*
+* Apply H to rows 1:m-k+i+ib-1 of current block
+*
+ CALL DORG2L( M-K+I+IB-1, IB, IB, A( 1, N-K+I ), LDA,
+ $ TAU( I ), WORK, IINFO )
+*
+* Set rows m-k+i+ib:m of current block to zero
+*
+ DO 40 J = N - K + I, N - K + I + IB - 1
+ DO 30 L = M - K + I + IB, M
+ A( L, J ) = ZERO
+ 30 CONTINUE
+ 40 CONTINUE
+ 50 CONTINUE
+ END IF
+*
+ WORK( 1 ) = IWS
+ RETURN
+*
+* End of DORGQL
+*
+ END
diff --git a/lib/linalg/dorgtr.f b/lib/linalg/dorgtr.f
new file mode 100644
index 0000000000000000000000000000000000000000..06a7b6cc1cdc5bd335ce9e50777a006ebfab3c06
--- /dev/null
+++ b/lib/linalg/dorgtr.f
@@ -0,0 +1,255 @@
+*> \brief \b DORGTR
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DORGTR + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorgtr.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorgtr.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorgtr.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DORGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER INFO, LDA, LWORK, N
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DORGTR generates a real orthogonal matrix Q which is defined as the
+*> product of n-1 elementary reflectors of order N, as returned by
+*> DSYTRD:
+*>
+*> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
+*>
+*> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A contains elementary reflectors
+*> from DSYTRD;
+*> = 'L': Lower triangle of A contains elementary reflectors
+*> from DSYTRD.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix Q. 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 DSYTRD.
+*> 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 DSYTRD.
+*> \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-1).
+*> For optimum performance LWORK >= (N-1)*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 DORGTR( UPLO, 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 ..
+ CHARACTER UPLO
+ INTEGER 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, UPPER
+ INTEGER I, IINFO, J, LWKOPT, NB
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ EXTERNAL LSAME, ILAENV
+* ..
+* .. External Subroutines ..
+ EXTERNAL DORGQL, DORGQR, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ LQUERY = ( LWORK.EQ.-1 )
+ UPPER = LSAME( UPLO, 'U' )
+ IF( .NOT.UPPER .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 = -4
+ ELSE IF( LWORK.LT.MAX( 1, N-1 ) .AND. .NOT.LQUERY ) THEN
+ INFO = -7
+ END IF
+*
+ IF( INFO.EQ.0 ) THEN
+ IF( UPPER ) THEN
+ NB = ILAENV( 1, 'DORGQL', ' ', N-1, N-1, N-1, -1 )
+ ELSE
+ NB = ILAENV( 1, 'DORGQR', ' ', N-1, N-1, N-1, -1 )
+ END IF
+ LWKOPT = MAX( 1, N-1 )*NB
+ WORK( 1 ) = LWKOPT
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DORGTR', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 ) THEN
+ WORK( 1 ) = 1
+ RETURN
+ END IF
+*
+ IF( UPPER ) THEN
+*
+* Q was determined by a call to DSYTRD with UPLO = 'U'
+*
+* Shift the vectors which define the elementary reflectors one
+* column to the left, and set the last row and column of Q to
+* those of the unit matrix
+*
+ DO 20 J = 1, N - 1
+ DO 10 I = 1, J - 1
+ A( I, J ) = A( I, J+1 )
+ 10 CONTINUE
+ A( N, J ) = ZERO
+ 20 CONTINUE
+ DO 30 I = 1, N - 1
+ A( I, N ) = ZERO
+ 30 CONTINUE
+ A( N, N ) = ONE
+*
+* Generate Q(1:n-1,1:n-1)
+*
+ CALL DORGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, IINFO )
+*
+ ELSE
+*
+* Q was determined by a call to DSYTRD with UPLO = 'L'.
+*
+* 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 50 J = N, 2, -1
+ A( 1, J ) = ZERO
+ DO 40 I = J + 1, N
+ A( I, J ) = A( I, J-1 )
+ 40 CONTINUE
+ 50 CONTINUE
+ A( 1, 1 ) = ONE
+ DO 60 I = 2, N
+ A( I, 1 ) = ZERO
+ 60 CONTINUE
+ IF( N.GT.1 ) THEN
+*
+* Generate Q(2:n,2:n)
+*
+ CALL DORGQR( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
+ $ LWORK, IINFO )
+ END IF
+ END IF
+ WORK( 1 ) = LWKOPT
+ RETURN
+*
+* End of DORGTR
+*
+ END
diff --git a/lib/linalg/dsyev.f b/lib/linalg/dsyev.f
new file mode 100644
index 0000000000000000000000000000000000000000..64b39ed84783e6eaa8df5220437c433ad3153afe
--- /dev/null
+++ b/lib/linalg/dsyev.f
@@ -0,0 +1,286 @@
+*> \brief <b> DSYEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYEV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyev.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyev.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyev.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER JOBZ, UPLO
+* INTEGER INFO, LDA, LWORK, N
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DSYEV computes all eigenvalues and, optionally, eigenvectors of a
+*> real symmetric matrix A.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*> JOBZ is CHARACTER*1
+*> = 'N': Compute eigenvalues only;
+*> = 'V': Compute eigenvalues and eigenvectors.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A is stored;
+*> = 'L': Lower triangle of A is stored.
+*> \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 symmetric matrix A. If UPLO = 'U', the
+*> leading N-by-N upper triangular part of A contains the
+*> upper triangular part of the matrix A. If UPLO = 'L',
+*> the leading N-by-N lower triangular part of A contains
+*> the lower triangular part of the matrix A.
+*> On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+*> orthonormal eigenvectors of the matrix A.
+*> If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+*> or the upper triangle (if UPLO='U') of A, including the
+*> diagonal, is destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*> W is DOUBLE PRECISION array, dimension (N)
+*> If INFO = 0, the eigenvalues in ascending order.
+*> \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,3*N-1).
+*> For optimal efficiency, LWORK >= (NB+2)*N,
+*> where NB is the blocksize for DSYTRD 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, the algorithm failed to converge; i
+*> off-diagonal elements of an intermediate tridiagonal
+*> form did not converge to zero.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup doubleSYeigen
+*
+* =====================================================================
+ SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, 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 JOBZ, UPLO
+ INTEGER INFO, LDA, LWORK, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LOWER, LQUERY, WANTZ
+ INTEGER IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
+ $ LLWORK, LWKOPT, NB
+ DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+ $ SMLNUM
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ DOUBLE PRECISION DLAMCH, DLANSY
+ EXTERNAL LSAME, ILAENV, DLAMCH, DLANSY
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLASCL, DORGTR, DSCAL, DSTEQR, DSTERF, DSYTRD,
+ $ XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, SQRT
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ WANTZ = LSAME( JOBZ, 'V' )
+ LOWER = LSAME( UPLO, 'L' )
+ LQUERY = ( LWORK.EQ.-1 )
+*
+ INFO = 0
+ IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, '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.EQ.0 ) THEN
+ NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
+ LWKOPT = MAX( 1, ( NB+2 )*N )
+ WORK( 1 ) = LWKOPT
+*
+ IF( LWORK.LT.MAX( 1, 3*N-1 ) .AND. .NOT.LQUERY )
+ $ INFO = -8
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DSYEV ', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 ) THEN
+ RETURN
+ END IF
+*
+ IF( N.EQ.1 ) THEN
+ W( 1 ) = A( 1, 1 )
+ WORK( 1 ) = 2
+ IF( WANTZ )
+ $ A( 1, 1 ) = ONE
+ RETURN
+ END IF
+*
+* Get machine constants.
+*
+ SAFMIN = DLAMCH( 'Safe minimum' )
+ EPS = DLAMCH( 'Precision' )
+ SMLNUM = SAFMIN / EPS
+ BIGNUM = ONE / SMLNUM
+ RMIN = SQRT( SMLNUM )
+ RMAX = SQRT( BIGNUM )
+*
+* Scale matrix to allowable range, if necessary.
+*
+ ANRM = DLANSY( 'M', UPLO, N, A, LDA, WORK )
+ ISCALE = 0
+ IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+ ISCALE = 1
+ SIGMA = RMIN / ANRM
+ ELSE IF( ANRM.GT.RMAX ) THEN
+ ISCALE = 1
+ SIGMA = RMAX / ANRM
+ END IF
+ IF( ISCALE.EQ.1 )
+ $ CALL DLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
+*
+* Call DSYTRD to reduce symmetric matrix to tridiagonal form.
+*
+ INDE = 1
+ INDTAU = INDE + N
+ INDWRK = INDTAU + N
+ LLWORK = LWORK - INDWRK + 1
+ CALL DSYTRD( UPLO, N, A, LDA, W, WORK( INDE ), WORK( INDTAU ),
+ $ WORK( INDWRK ), LLWORK, IINFO )
+*
+* For eigenvalues only, call DSTERF. For eigenvectors, first call
+* DORGTR to generate the orthogonal matrix, then call DSTEQR.
+*
+ IF( .NOT.WANTZ ) THEN
+ CALL DSTERF( N, W, WORK( INDE ), INFO )
+ ELSE
+ CALL DORGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ),
+ $ LLWORK, IINFO )
+ CALL DSTEQR( JOBZ, N, W, WORK( INDE ), A, LDA, WORK( INDTAU ),
+ $ INFO )
+ END IF
+*
+* If matrix was scaled, then rescale eigenvalues appropriately.
+*
+ IF( ISCALE.EQ.1 ) THEN
+ IF( INFO.EQ.0 ) THEN
+ IMAX = N
+ ELSE
+ IMAX = INFO - 1
+ END IF
+ CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
+ END IF
+*
+* Set WORK(1) to optimal workspace size.
+*
+ WORK( 1 ) = LWKOPT
+*
+ RETURN
+*
+* End of DSYEV
+*
+ END
diff --git a/lib/linalg/dsygv.f b/lib/linalg/dsygv.f
new file mode 100644
index 0000000000000000000000000000000000000000..e55631851869147a167a53aeeda1f72247794f1a
--- /dev/null
+++ b/lib/linalg/dsygv.f
@@ -0,0 +1,314 @@
+*> \brief \b DSYGST
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYGV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsygv.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsygv.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsygv.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK,
+* LWORK, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER JOBZ, UPLO
+* INTEGER INFO, ITYPE, LDA, LDB, LWORK, N
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), W( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DSYGV computes all the eigenvalues, and optionally, the eigenvectors
+*> of a real generalized symmetric-definite eigenproblem, of the form
+*> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
+*> Here A and B are assumed to be symmetric and B is also
+*> positive definite.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] ITYPE
+*> \verbatim
+*> ITYPE is INTEGER
+*> Specifies the problem type to be solved:
+*> = 1: A*x = (lambda)*B*x
+*> = 2: A*B*x = (lambda)*x
+*> = 3: B*A*x = (lambda)*x
+*> \endverbatim
+*>
+*> \param[in] JOBZ
+*> \verbatim
+*> JOBZ is CHARACTER*1
+*> = 'N': Compute eigenvalues only;
+*> = 'V': Compute eigenvalues and eigenvectors.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangles of A and B are stored;
+*> = 'L': Lower triangles of A and B are stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrices A and B. N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is DOUBLE PRECISION array, dimension (LDA, N)
+*> On entry, the symmetric matrix A. If UPLO = 'U', the
+*> leading N-by-N upper triangular part of A contains the
+*> upper triangular part of the matrix A. If UPLO = 'L',
+*> the leading N-by-N lower triangular part of A contains
+*> the lower triangular part of the matrix A.
+*>
+*> On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+*> matrix Z of eigenvectors. The eigenvectors are normalized
+*> as follows:
+*> if ITYPE = 1 or 2, Z**T*B*Z = I;
+*> if ITYPE = 3, Z**T*inv(B)*Z = I.
+*> If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
+*> or the lower triangle (if UPLO='L') of A, including the
+*> diagonal, is destroyed.
+*> \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, N)
+*> On entry, the symmetric positive definite matrix B.
+*> If UPLO = 'U', the leading N-by-N upper triangular part of B
+*> contains the upper triangular part of the matrix B.
+*> If UPLO = 'L', the leading N-by-N lower triangular part of B
+*> contains the lower triangular part of the matrix B.
+*>
+*> On exit, if INFO <= N, the part of B containing the matrix is
+*> overwritten by the triangular factor U or L from the Cholesky
+*> factorization B = U**T*U or B = L*L**T.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*> LDB is INTEGER
+*> The leading dimension of the array B. LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*> W is DOUBLE PRECISION array, dimension (N)
+*> If INFO = 0, the eigenvalues in ascending order.
+*> \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,3*N-1).
+*> For optimal efficiency, LWORK >= (NB+2)*N,
+*> where NB is the blocksize for DSYTRD 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: DPOTRF or DSYEV returned an error code:
+*> <= N: if INFO = i, DSYEV failed to converge;
+*> i off-diagonal elements of an intermediate
+*> tridiagonal form did not converge to zero;
+*> > N: if INFO = N + i, for 1 <= i <= N, then the leading
+*> minor of order i of B is not positive definite.
+*> The factorization of B could not be completed and
+*> no eigenvalues or eigenvectors were computed.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup doubleSYeigen
+*
+* =====================================================================
+ SUBROUTINE DSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, 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 JOBZ, UPLO
+ INTEGER INFO, ITYPE, LDA, LDB, LWORK, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), B( LDB, * ), W( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LQUERY, UPPER, WANTZ
+ CHARACTER TRANS
+ INTEGER LWKMIN, LWKOPT, NB, NEIG
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ EXTERNAL LSAME, ILAENV
+* ..
+* .. External Subroutines ..
+ EXTERNAL DPOTRF, DSYEV, DSYGST, DTRMM, DTRSM, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ WANTZ = LSAME( JOBZ, 'V' )
+ UPPER = LSAME( UPLO, 'U' )
+ LQUERY = ( LWORK.EQ.-1 )
+*
+ INFO = 0
+ IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
+ INFO = -1
+ ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
+ INFO = -2
+ ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
+ INFO = -3
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -6
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -8
+ END IF
+*
+ IF( INFO.EQ.0 ) THEN
+ LWKMIN = MAX( 1, 3*N - 1 )
+ NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
+ LWKOPT = MAX( LWKMIN, ( NB + 2 )*N )
+ WORK( 1 ) = LWKOPT
+*
+ IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
+ INFO = -11
+ END IF
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DSYGV ', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+* Form a Cholesky factorization of B.
+*
+ CALL DPOTRF( UPLO, N, B, LDB, INFO )
+ IF( INFO.NE.0 ) THEN
+ INFO = N + INFO
+ RETURN
+ END IF
+*
+* Transform problem to standard eigenvalue problem and solve.
+*
+ CALL DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
+ CALL DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
+*
+ IF( WANTZ ) THEN
+*
+* Backtransform eigenvectors to the original problem.
+*
+ NEIG = N
+ IF( INFO.GT.0 )
+ $ NEIG = INFO - 1
+ IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
+*
+* For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
+* backtransform eigenvectors: x = inv(L)**T*y or inv(U)*y
+*
+ IF( UPPER ) THEN
+ TRANS = 'N'
+ ELSE
+ TRANS = 'T'
+ END IF
+*
+ CALL DTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
+ $ B, LDB, A, LDA )
+*
+ ELSE IF( ITYPE.EQ.3 ) THEN
+*
+* For B*A*x=(lambda)*x;
+* backtransform eigenvectors: x = L*y or U**T*y
+*
+ IF( UPPER ) THEN
+ TRANS = 'T'
+ ELSE
+ TRANS = 'N'
+ END IF
+*
+ CALL DTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
+ $ B, LDB, A, LDA )
+ END IF
+ END IF
+*
+ WORK( 1 ) = LWKOPT
+ RETURN
+*
+* End of DSYGV
+*
+ END
diff --git a/lib/linalg/dznrm2.f b/lib/linalg/dznrm2.f
new file mode 100644
index 0000000000000000000000000000000000000000..b5713a2bfaf0b92dd3e27e8a007eb91130c2195a
--- /dev/null
+++ b/lib/linalg/dznrm2.f
@@ -0,0 +1,119 @@
+*> \brief \b DZNRM2
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX)
+*
+* .. Scalar Arguments ..
+* INTEGER INCX,N
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 X(*)
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DZNRM2 returns the euclidean norm of a vector via the function
+*> name, so that
+*>
+*> DZNRM2 := sqrt( x**H*x )
+*> \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
+*>
+*> -- This version written on 25-October-1982.
+*> Modified on 14-October-1993 to inline the call to ZLASSQ.
+*> Sven Hammarling, Nag Ltd.
+*> \endverbatim
+*>
+* =====================================================================
+ DOUBLE PRECISION FUNCTION DZNRM2(N,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,N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 X(*)
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE,ZERO
+ PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
+* ..
+* .. Local Scalars ..
+ DOUBLE PRECISION NORM,SCALE,SSQ,TEMP
+ INTEGER IX
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS,DBLE,DIMAG,SQRT
+* ..
+ IF (N.LT.1 .OR. INCX.LT.1) THEN
+ NORM = ZERO
+ ELSE
+ SCALE = ZERO
+ SSQ = ONE
+* The following loop is equivalent to this call to the LAPACK
+* auxiliary routine:
+* CALL ZLASSQ( N, X, INCX, SCALE, SSQ )
+*
+ DO 10 IX = 1,1 + (N-1)*INCX,INCX
+ IF (DBLE(X(IX)).NE.ZERO) THEN
+ TEMP = ABS(DBLE(X(IX)))
+ IF (SCALE.LT.TEMP) THEN
+ SSQ = ONE + SSQ* (SCALE/TEMP)**2
+ SCALE = TEMP
+ ELSE
+ SSQ = SSQ + (TEMP/SCALE)**2
+ END IF
+ END IF
+ IF (DIMAG(X(IX)).NE.ZERO) THEN
+ TEMP = ABS(DIMAG(X(IX)))
+ IF (SCALE.LT.TEMP) THEN
+ SSQ = ONE + SSQ* (SCALE/TEMP)**2
+ SCALE = TEMP
+ ELSE
+ SSQ = SSQ + (TEMP/SCALE)**2
+ END IF
+ END IF
+ 10 CONTINUE
+ NORM = SCALE*SQRT(SSQ)
+ END IF
+*
+ DZNRM2 = NORM
+ RETURN
+*
+* End of DZNRM2.
+*
+ END
diff --git a/lib/linalg/ilazlc.f b/lib/linalg/ilazlc.f
new file mode 100644
index 0000000000000000000000000000000000000000..718b277dfa6596e95fcbe37972f5af9d1fb79fb3
--- /dev/null
+++ b/lib/linalg/ilazlc.f
@@ -0,0 +1,118 @@
+*> \brief \b ILAZLC scans a matrix for its last non-zero column.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ILAZLC + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilazlc.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilazlc.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilazlc.f">
+*> [TXT]</a>
+*> \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 September 2012
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ INTEGER FUNCTION ILAZLC( M, N, A, LDA )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 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
+* ..
+* .. 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/lib/linalg/ilazlr.f b/lib/linalg/ilazlr.f
new file mode 100644
index 0000000000000000000000000000000000000000..44697214c75b0358a1568e2f46aa3d2b449f7b5c
--- /dev/null
+++ b/lib/linalg/ilazlr.f
@@ -0,0 +1,121 @@
+*> \brief \b ILAZLR scans a matrix for its last non-zero row.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ILAZLR + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilazlr.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilazlr.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilazlr.f">
+*> [TXT]</a>
+*> \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 September 2012
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ INTEGER FUNCTION ILAZLR( M, N, A, LDA )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 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/lib/linalg/zaxpy.f b/lib/linalg/zaxpy.f
new file mode 100644
index 0000000000000000000000000000000000000000..e6f5e1f6dbfe289ad666ffb6652387be9a808666
--- /dev/null
+++ b/lib/linalg/zaxpy.f
@@ -0,0 +1,102 @@
+*> \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/lib/linalg/zcopy.f b/lib/linalg/zcopy.f
new file mode 100644
index 0000000000000000000000000000000000000000..baeafd5c3b211b62e3dd415508e861579461fcc9
--- /dev/null
+++ b/lib/linalg/zcopy.f
@@ -0,0 +1,94 @@
+*> \brief \b ZCOPY
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZCOPY(N,ZX,INCX,ZY,INCY)
+*
+* .. Scalar Arguments ..
+* INTEGER INCX,INCY,N
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 ZX(*),ZY(*)
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZCOPY copies a vector, x, to a vector, y.
+*> \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, linpack, 4/11/78.
+*> modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+* =====================================================================
+ SUBROUTINE ZCOPY(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 ..
+ 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
+ ZY(I) = 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) = ZX(IX)
+ IX = IX + INCX
+ IY = IY + INCY
+ END DO
+ END IF
+ RETURN
+ END
diff --git a/lib/linalg/zgemm.f b/lib/linalg/zgemm.f
new file mode 100644
index 0000000000000000000000000000000000000000..f423315508a0de2fc5ce314db47bab240da9d7fa
--- /dev/null
+++ b/lib/linalg/zgemm.f
@@ -0,0 +1,489 @@
+*> \brief \b ZGEMM
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+*
+* .. Scalar Arguments ..
+* COMPLEX*16 ALPHA,BETA
+* INTEGER K,LDA,LDB,LDC,M,N
+* CHARACTER TRANSA,TRANSB
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZGEMM performs one of the matrix-matrix operations
+*>
+*> C := alpha*op( A )*op( B ) + beta*C,
+*>
+*> where op( X ) is one of
+*>
+*> op( X ) = X or op( X ) = X**T or op( X ) = X**H,
+*>
+*> alpha and beta are scalars, and A, B and C are matrices, with op( A )
+*> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.
+*> \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**H.
+*> \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**H.
+*> \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 COMPLEX*16
+*> On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is 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.
+*> \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 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.
+*> \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 COMPLEX*16
+*> 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 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 ).
+*> \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 complex16_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 ZGEMM(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 ..
+ COMPLEX*16 ALPHA,BETA
+ INTEGER K,LDA,LDB,LDC,M,N
+ CHARACTER TRANSA,TRANSB
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
+* ..
+*
+* =====================================================================
+*
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG,MAX
+* ..
+* .. Local Scalars ..
+ COMPLEX*16 TEMP
+ INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB
+ LOGICAL CONJA,CONJB,NOTA,NOTB
+* ..
+* .. Parameters ..
+ COMPLEX*16 ONE
+ PARAMETER (ONE= (1.0D+0,0.0D+0))
+ COMPLEX*16 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*A**H*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**T*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*B**H + 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**T + 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*A**H*B**H + 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*A**H*B**T + 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**T*B**H + 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**T*B**T + 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/lib/linalg/zgemv.f b/lib/linalg/zgemv.f
new file mode 100644
index 0000000000000000000000000000000000000000..4e174c956c9ee8cac85b1d5d765e92f838c4d777
--- /dev/null
+++ b/lib/linalg/zgemv.f
@@ -0,0 +1,354 @@
+*> \brief \b ZGEMV
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+*
+* .. Scalar Arguments ..
+* COMPLEX*16 ALPHA,BETA
+* INTEGER INCX,INCY,LDA,M,N
+* CHARACTER TRANS
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A(LDA,*),X(*),Y(*)
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZGEMV performs one of the matrix-vector operations
+*>
+*> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or
+*>
+*> y := alpha*A**H*x + beta*y,
+*>
+*> where alpha and beta are scalars, x and y are vectors and A is an
+*> m by n matrix.
+*> \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**H*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 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, 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 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.
+*> \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 + ( 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 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 ZGEMV(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 ..
+ COMPLEX*16 ALPHA,BETA
+ INTEGER INCX,INCY,LDA,M,N
+ CHARACTER TRANS
+* ..
+* .. 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 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**T*x + y or y := alpha*A**H*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/lib/linalg/zgerc.f b/lib/linalg/zgerc.f
new file mode 100644
index 0000000000000000000000000000000000000000..accfeafc053ad42c844281de2739d62148d1a602
--- /dev/null
+++ b/lib/linalg/zgerc.f
@@ -0,0 +1,227 @@
+*> \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/lib/linalg/zheev.f b/lib/linalg/zheev.f
new file mode 100644
index 0000000000000000000000000000000000000000..adba990f0a9d396198cf99711d38364e90f4e514
--- /dev/null
+++ b/lib/linalg/zheev.f
@@ -0,0 +1,298 @@
+*> \brief <b> ZHEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices</b>
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHEEV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zheev.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zheev.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zheev.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
+* INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER JOBZ, UPLO
+* INTEGER INFO, LDA, LWORK, N
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION RWORK( * ), W( * )
+* COMPLEX*16 A( LDA, * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZHEEV computes all eigenvalues and, optionally, eigenvectors of a
+*> complex Hermitian matrix A.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*> JOBZ is CHARACTER*1
+*> = 'N': Compute eigenvalues only;
+*> = 'V': Compute eigenvalues and eigenvectors.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A is stored;
+*> = 'L': Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA, N)
+*> On entry, the Hermitian matrix A. If UPLO = 'U', the
+*> leading N-by-N upper triangular part of A contains the
+*> upper triangular part of the matrix A. If UPLO = 'L',
+*> the leading N-by-N lower triangular part of A contains
+*> the lower triangular part of the matrix A.
+*> On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+*> orthonormal eigenvectors of the matrix A.
+*> If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+*> or the upper triangle (if UPLO='U') of A, including the
+*> diagonal, is destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*> W is DOUBLE PRECISION array, dimension (N)
+*> If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 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,2*N-1).
+*> For optimal efficiency, LWORK >= (NB+1)*N,
+*> where NB is the blocksize for ZHETRD 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] RWORK
+*> \verbatim
+*> RWORK is DOUBLE PRECISION array, dimension (max(1, 3*N-2))
+*> \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 algorithm failed to converge; i
+*> off-diagonal elements of an intermediate tridiagonal
+*> form did not converge to zero.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complex16HEeigen
+*
+* =====================================================================
+ SUBROUTINE ZHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
+ $ 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 JOBZ, UPLO
+ INTEGER INFO, LDA, LWORK, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION RWORK( * ), W( * )
+ COMPLEX*16 A( LDA, * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
+ COMPLEX*16 CONE
+ PARAMETER ( CONE = ( 1.0D0, 0.0D0 ) )
+* ..
+* .. Local Scalars ..
+ LOGICAL LOWER, LQUERY, WANTZ
+ INTEGER IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
+ $ LLWORK, LWKOPT, NB
+ DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+ $ SMLNUM
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ DOUBLE PRECISION DLAMCH, ZLANHE
+ EXTERNAL LSAME, ILAENV, DLAMCH, ZLANHE
+* ..
+* .. External Subroutines ..
+ EXTERNAL DSCAL, DSTERF, XERBLA, ZHETRD, ZLASCL, ZSTEQR,
+ $ ZUNGTR
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, SQRT
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ WANTZ = LSAME( JOBZ, 'V' )
+ LOWER = LSAME( UPLO, 'L' )
+ LQUERY = ( LWORK.EQ.-1 )
+*
+ INFO = 0
+ IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, '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.EQ.0 ) THEN
+ NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 )
+ LWKOPT = MAX( 1, ( NB+1 )*N )
+ WORK( 1 ) = LWKOPT
+*
+ IF( LWORK.LT.MAX( 1, 2*N-1 ) .AND. .NOT.LQUERY )
+ $ INFO = -8
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZHEEV ', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 ) THEN
+ RETURN
+ END IF
+*
+ IF( N.EQ.1 ) THEN
+ W( 1 ) = A( 1, 1 )
+ WORK( 1 ) = 1
+ IF( WANTZ )
+ $ A( 1, 1 ) = CONE
+ RETURN
+ END IF
+*
+* Get machine constants.
+*
+ SAFMIN = DLAMCH( 'Safe minimum' )
+ EPS = DLAMCH( 'Precision' )
+ SMLNUM = SAFMIN / EPS
+ BIGNUM = ONE / SMLNUM
+ RMIN = SQRT( SMLNUM )
+ RMAX = SQRT( BIGNUM )
+*
+* Scale matrix to allowable range, if necessary.
+*
+ ANRM = ZLANHE( 'M', UPLO, N, A, LDA, RWORK )
+ ISCALE = 0
+ IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+ ISCALE = 1
+ SIGMA = RMIN / ANRM
+ ELSE IF( ANRM.GT.RMAX ) THEN
+ ISCALE = 1
+ SIGMA = RMAX / ANRM
+ END IF
+ IF( ISCALE.EQ.1 )
+ $ CALL ZLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
+*
+* Call ZHETRD to reduce Hermitian matrix to tridiagonal form.
+*
+ INDE = 1
+ INDTAU = 1
+ INDWRK = INDTAU + N
+ LLWORK = LWORK - INDWRK + 1
+ CALL ZHETRD( UPLO, N, A, LDA, W, RWORK( INDE ), WORK( INDTAU ),
+ $ WORK( INDWRK ), LLWORK, IINFO )
+*
+* For eigenvalues only, call DSTERF. For eigenvectors, first call
+* ZUNGTR to generate the unitary matrix, then call ZSTEQR.
+*
+ IF( .NOT.WANTZ ) THEN
+ CALL DSTERF( N, W, RWORK( INDE ), INFO )
+ ELSE
+ CALL ZUNGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ),
+ $ LLWORK, IINFO )
+ INDWRK = INDE + N
+ CALL ZSTEQR( JOBZ, N, W, RWORK( INDE ), A, LDA,
+ $ RWORK( INDWRK ), INFO )
+ END IF
+*
+* If matrix was scaled, then rescale eigenvalues appropriately.
+*
+ IF( ISCALE.EQ.1 ) THEN
+ IF( INFO.EQ.0 ) THEN
+ IMAX = N
+ ELSE
+ IMAX = INFO - 1
+ END IF
+ CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
+ END IF
+*
+* Set WORK(1) to optimal complex workspace size.
+*
+ WORK( 1 ) = LWKOPT
+*
+ RETURN
+*
+* End of ZHEEV
+*
+ END
diff --git a/lib/linalg/zhemv.f b/lib/linalg/zhemv.f
new file mode 100644
index 0000000000000000000000000000000000000000..34216fbfff8a12b8d4c18cbdb2a7aa70a2d275e3
--- /dev/null
+++ b/lib/linalg/zhemv.f
@@ -0,0 +1,337 @@
+*> \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/lib/linalg/zher2.f b/lib/linalg/zher2.f
new file mode 100644
index 0000000000000000000000000000000000000000..e2a02c3c68fb3d705aa2c734d4e21fc722908def
--- /dev/null
+++ b/lib/linalg/zher2.f
@@ -0,0 +1,317 @@
+*> \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/lib/linalg/zher2k.f b/lib/linalg/zher2k.f
new file mode 100644
index 0000000000000000000000000000000000000000..0b91bd2cbbf09f79d782ac7b1b05313ca55c9f7e
--- /dev/null
+++ b/lib/linalg/zher2k.f
@@ -0,0 +1,443 @@
+*> \brief \b ZHER2K
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZHER2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+*
+* .. Scalar Arguments ..
+* COMPLEX*16 ALPHA
+* DOUBLE PRECISION BETA
+* INTEGER K,LDA,LDB,LDC,N
+* CHARACTER TRANS,UPLO
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZHER2K performs one of the hermitian rank 2k operations
+*>
+*> C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C,
+*>
+*> or
+*>
+*> C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C,
+*>
+*> where alpha and beta are scalars with beta real, C is an n by n
+*> hermitian matrix and A and B are n by k matrices in the first case
+*> and k by n matrices in the second case.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> On entry, UPLO specifies whether the upper or lower
+*> triangular part of the array C is to be referenced as
+*> follows:
+*>
+*> UPLO = 'U' or 'u' Only the upper triangular part of C
+*> is to be referenced.
+*>
+*> UPLO = 'L' or 'l' Only the lower triangular part of C
+*> is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*> TRANS is CHARACTER*1
+*> On entry, TRANS specifies the operation to be performed as
+*> follows:
+*>
+*> TRANS = 'N' or 'n' C := alpha*A*B**H +
+*> conjg( alpha )*B*A**H +
+*> beta*C.
+*>
+*> TRANS = 'C' or 'c' C := alpha*A**H*B +
+*> conjg( alpha )*B**H*A +
+*> beta*C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> On entry, N specifies the order of the matrix C. N must be
+*> at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*> K is INTEGER
+*> On entry with TRANS = 'N' or 'n', K specifies the number
+*> of columns of the matrices A and B, and on entry with
+*> TRANS = 'C' or 'c', K specifies the number of rows of the
+*> matrices A and B. K 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, ka ), where ka is
+*> k when TRANS = 'N' or 'n', and is n otherwise.
+*> Before entry with TRANS = 'N' or 'n', the leading n by k
+*> part of the array A must contain the matrix A, otherwise
+*> the leading k by n 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 TRANS = 'N' or 'n'
+*> then LDA must be at least max( 1, n ), otherwise LDA must
+*> be at least max( 1, k ).
+*> \endverbatim
+*>
+*> \param[in] B
+*> \verbatim
+*> B is COMPLEX*16 array of DIMENSION ( LDB, kb ), where kb is
+*> k when TRANS = 'N' or 'n', and is n otherwise.
+*> Before entry with TRANS = 'N' or 'n', the leading n by k
+*> part of the array B must contain the matrix B, otherwise
+*> the leading k by n 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 TRANS = 'N' or 'n'
+*> then LDB must be at least max( 1, n ), otherwise LDB must
+*> be at least max( 1, k ).
+*> Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*> BETA is DOUBLE PRECISION .
+*> On entry, BETA specifies the scalar beta.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*> C is COMPLEX*16 array of DIMENSION ( LDC, n ).
+*> Before entry with UPLO = 'U' or 'u', the leading n by n
+*> upper triangular part of the array C must contain the upper
+*> triangular part of the hermitian matrix and the strictly
+*> lower triangular part of C is not referenced. On exit, the
+*> upper triangular part of the array C 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 C must contain the lower
+*> triangular part of the hermitian matrix and the strictly
+*> upper triangular part of C is not referenced. On exit, the
+*> lower triangular part of the array C 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] 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, 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_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.
+*>
+*> -- Modified 8-Nov-93 to set C(J,J) to DBLE( C(J,J) ) when BETA = 1.
+*> Ed Anderson, Cray Research Inc.
+*> \endverbatim
+*>
+* =====================================================================
+ SUBROUTINE ZHER2K(UPLO,TRANS,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 ..
+ COMPLEX*16 ALPHA
+ DOUBLE PRECISION BETA
+ INTEGER K,LDA,LDB,LDC,N
+ CHARACTER TRANS,UPLO
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
+* ..
+*
+* =====================================================================
+*
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DBLE,DCONJG,MAX
+* ..
+* .. Local Scalars ..
+ COMPLEX*16 TEMP1,TEMP2
+ INTEGER I,INFO,J,L,NROWA
+ LOGICAL UPPER
+* ..
+* .. Parameters ..
+ DOUBLE PRECISION ONE
+ PARAMETER (ONE=1.0D+0)
+ COMPLEX*16 ZERO
+ PARAMETER (ZERO= (0.0D+0,0.0D+0))
+* ..
+*
+* Test the input parameters.
+*
+ IF (LSAME(TRANS,'N')) THEN
+ NROWA = N
+ ELSE
+ NROWA = K
+ END IF
+ UPPER = LSAME(UPLO,'U')
+*
+ INFO = 0
+ IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
+ INFO = 1
+ ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
+ + (.NOT.LSAME(TRANS,'C'))) THEN
+ INFO = 2
+ ELSE IF (N.LT.0) THEN
+ INFO = 3
+ ELSE IF (K.LT.0) THEN
+ INFO = 4
+ ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+ INFO = 7
+ ELSE IF (LDB.LT.MAX(1,NROWA)) THEN
+ INFO = 9
+ ELSE IF (LDC.LT.MAX(1,N)) THEN
+ INFO = 12
+ END IF
+ IF (INFO.NE.0) THEN
+ CALL XERBLA('ZHER2K',INFO)
+ RETURN
+ END IF
+*
+* Quick return if possible.
+*
+ IF ((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 (UPPER) THEN
+ IF (BETA.EQ.DBLE(ZERO)) THEN
+ DO 20 J = 1,N
+ DO 10 I = 1,J
+ C(I,J) = ZERO
+ 10 CONTINUE
+ 20 CONTINUE
+ ELSE
+ DO 40 J = 1,N
+ DO 30 I = 1,J - 1
+ C(I,J) = BETA*C(I,J)
+ 30 CONTINUE
+ C(J,J) = BETA*DBLE(C(J,J))
+ 40 CONTINUE
+ END IF
+ ELSE
+ IF (BETA.EQ.DBLE(ZERO)) THEN
+ DO 60 J = 1,N
+ DO 50 I = J,N
+ C(I,J) = ZERO
+ 50 CONTINUE
+ 60 CONTINUE
+ ELSE
+ DO 80 J = 1,N
+ C(J,J) = BETA*DBLE(C(J,J))
+ DO 70 I = J + 1,N
+ C(I,J) = BETA*C(I,J)
+ 70 CONTINUE
+ 80 CONTINUE
+ END IF
+ END IF
+ RETURN
+ END IF
+*
+* Start the operations.
+*
+ IF (LSAME(TRANS,'N')) THEN
+*
+* Form C := alpha*A*B**H + conjg( alpha )*B*A**H +
+* C.
+*
+ IF (UPPER) THEN
+ DO 130 J = 1,N
+ IF (BETA.EQ.DBLE(ZERO)) THEN
+ DO 90 I = 1,J
+ C(I,J) = ZERO
+ 90 CONTINUE
+ ELSE IF (BETA.NE.ONE) THEN
+ DO 100 I = 1,J - 1
+ C(I,J) = BETA*C(I,J)
+ 100 CONTINUE
+ C(J,J) = BETA*DBLE(C(J,J))
+ ELSE
+ C(J,J) = DBLE(C(J,J))
+ END IF
+ DO 120 L = 1,K
+ IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
+ TEMP1 = ALPHA*DCONJG(B(J,L))
+ TEMP2 = DCONJG(ALPHA*A(J,L))
+ DO 110 I = 1,J - 1
+ C(I,J) = C(I,J) + A(I,L)*TEMP1 +
+ + B(I,L)*TEMP2
+ 110 CONTINUE
+ C(J,J) = DBLE(C(J,J)) +
+ + DBLE(A(J,L)*TEMP1+B(J,L)*TEMP2)
+ END IF
+ 120 CONTINUE
+ 130 CONTINUE
+ ELSE
+ DO 180 J = 1,N
+ IF (BETA.EQ.DBLE(ZERO)) THEN
+ DO 140 I = J,N
+ C(I,J) = ZERO
+ 140 CONTINUE
+ ELSE IF (BETA.NE.ONE) THEN
+ DO 150 I = J + 1,N
+ C(I,J) = BETA*C(I,J)
+ 150 CONTINUE
+ C(J,J) = BETA*DBLE(C(J,J))
+ ELSE
+ C(J,J) = DBLE(C(J,J))
+ END IF
+ DO 170 L = 1,K
+ IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
+ TEMP1 = ALPHA*DCONJG(B(J,L))
+ TEMP2 = DCONJG(ALPHA*A(J,L))
+ DO 160 I = J + 1,N
+ C(I,J) = C(I,J) + A(I,L)*TEMP1 +
+ + B(I,L)*TEMP2
+ 160 CONTINUE
+ C(J,J) = DBLE(C(J,J)) +
+ + DBLE(A(J,L)*TEMP1+B(J,L)*TEMP2)
+ END IF
+ 170 CONTINUE
+ 180 CONTINUE
+ END IF
+ ELSE
+*
+* Form C := alpha*A**H*B + conjg( alpha )*B**H*A +
+* C.
+*
+ IF (UPPER) THEN
+ DO 210 J = 1,N
+ DO 200 I = 1,J
+ TEMP1 = ZERO
+ TEMP2 = ZERO
+ DO 190 L = 1,K
+ TEMP1 = TEMP1 + DCONJG(A(L,I))*B(L,J)
+ TEMP2 = TEMP2 + DCONJG(B(L,I))*A(L,J)
+ 190 CONTINUE
+ IF (I.EQ.J) THEN
+ IF (BETA.EQ.DBLE(ZERO)) THEN
+ C(J,J) = DBLE(ALPHA*TEMP1+
+ + DCONJG(ALPHA)*TEMP2)
+ ELSE
+ C(J,J) = BETA*DBLE(C(J,J)) +
+ + DBLE(ALPHA*TEMP1+
+ + DCONJG(ALPHA)*TEMP2)
+ END IF
+ ELSE
+ IF (BETA.EQ.DBLE(ZERO)) THEN
+ C(I,J) = ALPHA*TEMP1 + DCONJG(ALPHA)*TEMP2
+ ELSE
+ C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
+ + DCONJG(ALPHA)*TEMP2
+ END IF
+ END IF
+ 200 CONTINUE
+ 210 CONTINUE
+ ELSE
+ DO 240 J = 1,N
+ DO 230 I = J,N
+ TEMP1 = ZERO
+ TEMP2 = ZERO
+ DO 220 L = 1,K
+ TEMP1 = TEMP1 + DCONJG(A(L,I))*B(L,J)
+ TEMP2 = TEMP2 + DCONJG(B(L,I))*A(L,J)
+ 220 CONTINUE
+ IF (I.EQ.J) THEN
+ IF (BETA.EQ.DBLE(ZERO)) THEN
+ C(J,J) = DBLE(ALPHA*TEMP1+
+ + DCONJG(ALPHA)*TEMP2)
+ ELSE
+ C(J,J) = BETA*DBLE(C(J,J)) +
+ + DBLE(ALPHA*TEMP1+
+ + DCONJG(ALPHA)*TEMP2)
+ END IF
+ ELSE
+ IF (BETA.EQ.DBLE(ZERO)) THEN
+ C(I,J) = ALPHA*TEMP1 + DCONJG(ALPHA)*TEMP2
+ ELSE
+ C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
+ + DCONJG(ALPHA)*TEMP2
+ END IF
+ END IF
+ 230 CONTINUE
+ 240 CONTINUE
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of ZHER2K.
+*
+ END
diff --git a/lib/linalg/zhetd2.f b/lib/linalg/zhetd2.f
new file mode 100644
index 0000000000000000000000000000000000000000..dd8f9cf0145642ee5db89462d087c668bb6a6bf7
--- /dev/null
+++ b/lib/linalg/zhetd2.f
@@ -0,0 +1,334 @@
+*> \brief \b ZHETD2 reduces a Hermitian matrix to real symmetric tridiagonal form by an unitary similarity transformation (unblocked algorithm).
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHETD2 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetd2.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetd2.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetd2.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZHETD2( UPLO, N, A, LDA, D, E, TAU, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER INFO, LDA, N
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION D( * ), E( * )
+* COMPLEX*16 A( LDA, * ), TAU( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZHETD2 reduces a complex Hermitian matrix A to real symmetric
+*> tridiagonal form T by a unitary similarity transformation:
+*> Q**H * A * Q = T.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> Specifies whether the upper or lower triangular part of the
+*> Hermitian matrix A is stored:
+*> = 'U': Upper triangular
+*> = 'L': Lower 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 COMPLEX*16 array, dimension (LDA,N)
+*> On entry, the Hermitian matrix A. If UPLO = 'U', the leading
+*> n-by-n upper triangular part of A contains the upper
+*> triangular part of the matrix A, and the strictly lower
+*> triangular part of A is not referenced. If UPLO = 'L', the
+*> leading n-by-n lower triangular part of A contains the lower
+*> triangular part of the matrix A, and the strictly upper
+*> triangular part of A is not referenced.
+*> On exit, if UPLO = 'U', the diagonal and first superdiagonal
+*> of A are overwritten by the corresponding elements of the
+*> tridiagonal matrix T, and the elements above the first
+*> superdiagonal, with the array TAU, represent the unitary
+*> matrix Q as a product of elementary reflectors; if UPLO
+*> = 'L', the diagonal and first subdiagonal of A are over-
+*> written by the corresponding elements of the tridiagonal
+*> matrix T, and the elements below the first subdiagonal, with
+*> the array TAU, represent the unitary 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] D
+*> \verbatim
+*> D is DOUBLE PRECISION array, dimension (N)
+*> The diagonal elements of the tridiagonal matrix T:
+*> D(i) = A(i,i).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*> E is DOUBLE PRECISION array, dimension (N-1)
+*> The off-diagonal elements of the tridiagonal matrix T:
+*> E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is COMPLEX*16 array, dimension (N-1)
+*> The scalar factors of the elementary reflectors (see Further
+*> Details).
+*> \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 September 2012
+*
+*> \ingroup complex16HEcomputational
+*
+*> \par Further Details:
+* =====================
+*>
+*> \verbatim
+*>
+*> If UPLO = 'U', the matrix Q is represented as a product of elementary
+*> reflectors
+*>
+*> Q = H(n-1) . . . H(2) H(1).
+*>
+*> Each H(i) has the form
+*>
+*> H(i) = I - tau * v * v**H
+*>
+*> where tau is a complex scalar, and v is a complex vector with
+*> v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
+*> A(1:i-1,i+1), and tau in TAU(i).
+*>
+*> If UPLO = 'L', the matrix Q is represented as a product of elementary
+*> reflectors
+*>
+*> Q = H(1) H(2) . . . H(n-1).
+*>
+*> Each H(i) has the form
+*>
+*> H(i) = I - tau * v * v**H
+*>
+*> where tau is a complex scalar, and v is a complex vector with
+*> v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
+*> and tau in TAU(i).
+*>
+*> The contents of A on exit are illustrated by the following examples
+*> with n = 5:
+*>
+*> if UPLO = 'U': if UPLO = 'L':
+*>
+*> ( d e v2 v3 v4 ) ( d )
+*> ( d e v3 v4 ) ( e d )
+*> ( d e v4 ) ( v1 e d )
+*> ( d e ) ( v1 v2 e d )
+*> ( d ) ( v1 v2 v3 e d )
+*>
+*> where d and e denote diagonal and off-diagonal elements of T, and vi
+*> denotes an element of the vector defining H(i).
+*> \endverbatim
+*>
+* =====================================================================
+ SUBROUTINE ZHETD2( UPLO, N, A, LDA, D, E, TAU, INFO )
+*
+* -- LAPACK computational routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER INFO, LDA, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION D( * ), E( * )
+ COMPLEX*16 A( LDA, * ), TAU( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ONE, ZERO, HALF
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
+ $ ZERO = ( 0.0D+0, 0.0D+0 ),
+ $ HALF = ( 0.5D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ LOGICAL UPPER
+ INTEGER I
+ COMPLEX*16 ALPHA, TAUI
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZAXPY, ZHEMV, ZHER2, ZLARFG
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ COMPLEX*16 ZDOTC
+ EXTERNAL LSAME, ZDOTC
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DBLE, MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U')
+ IF( .NOT.UPPER .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 = -4
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZHETD2', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.LE.0 )
+ $ RETURN
+*
+ IF( UPPER ) THEN
+*
+* Reduce the upper triangle of A
+*
+ A( N, N ) = DBLE( A( N, N ) )
+ DO 10 I = N - 1, 1, -1
+*
+* Generate elementary reflector H(i) = I - tau * v * v**H
+* to annihilate A(1:i-1,i+1)
+*
+ ALPHA = A( I, I+1 )
+ CALL ZLARFG( I, ALPHA, A( 1, I+1 ), 1, TAUI )
+ E( I ) = ALPHA
+*
+ IF( TAUI.NE.ZERO ) THEN
+*
+* Apply H(i) from both sides to A(1:i,1:i)
+*
+ A( I, I+1 ) = ONE
+*
+* Compute x := tau * A * v storing x in TAU(1:i)
+*
+ CALL ZHEMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, ZERO,
+ $ TAU, 1 )
+*
+* Compute w := x - 1/2 * tau * (x**H * v) * v
+*
+ ALPHA = -HALF*TAUI*ZDOTC( I, TAU, 1, A( 1, I+1 ), 1 )
+ CALL ZAXPY( I, ALPHA, A( 1, I+1 ), 1, TAU, 1 )
+*
+* Apply the transformation as a rank-2 update:
+* A := A - v * w**H - w * v**H
+*
+ CALL ZHER2( UPLO, I, -ONE, A( 1, I+1 ), 1, TAU, 1, A,
+ $ LDA )
+*
+ ELSE
+ A( I, I ) = DBLE( A( I, I ) )
+ END IF
+ A( I, I+1 ) = E( I )
+ D( I+1 ) = A( I+1, I+1 )
+ TAU( I ) = TAUI
+ 10 CONTINUE
+ D( 1 ) = A( 1, 1 )
+ ELSE
+*
+* Reduce the lower triangle of A
+*
+ A( 1, 1 ) = DBLE( A( 1, 1 ) )
+ DO 20 I = 1, N - 1
+*
+* Generate elementary reflector H(i) = I - tau * v * v**H
+* to annihilate A(i+2:n,i)
+*
+ ALPHA = A( I+1, I )
+ CALL ZLARFG( N-I, ALPHA, A( MIN( I+2, N ), I ), 1, TAUI )
+ E( I ) = ALPHA
+*
+ IF( TAUI.NE.ZERO ) THEN
+*
+* Apply H(i) from both sides to A(i+1:n,i+1:n)
+*
+ A( I+1, I ) = ONE
+*
+* Compute x := tau * A * v storing y in TAU(i:n-1)
+*
+ CALL ZHEMV( UPLO, N-I, TAUI, A( I+1, I+1 ), LDA,
+ $ A( I+1, I ), 1, ZERO, TAU( I ), 1 )
+*
+* Compute w := x - 1/2 * tau * (x**H * v) * v
+*
+ ALPHA = -HALF*TAUI*ZDOTC( N-I, TAU( I ), 1, A( I+1, I ),
+ $ 1 )
+ CALL ZAXPY( N-I, ALPHA, A( I+1, I ), 1, TAU( I ), 1 )
+*
+* Apply the transformation as a rank-2 update:
+* A := A - v * w**H - w * v**H
+*
+ CALL ZHER2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), 1,
+ $ A( I+1, I+1 ), LDA )
+*
+ ELSE
+ A( I+1, I+1 ) = DBLE( A( I+1, I+1 ) )
+ END IF
+ A( I+1, I ) = E( I )
+ D( I ) = A( I, I )
+ TAU( I ) = TAUI
+ 20 CONTINUE
+ D( N ) = A( N, N )
+ END IF
+*
+ RETURN
+*
+* End of ZHETD2
+*
+ END
diff --git a/lib/linalg/zhetrd.f b/lib/linalg/zhetrd.f
new file mode 100644
index 0000000000000000000000000000000000000000..c6074846379f79f0ff837209d81e2d0fc28cecb2
--- /dev/null
+++ b/lib/linalg/zhetrd.f
@@ -0,0 +1,378 @@
+*> \brief \b ZHETRD
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHETRD + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrd.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetrd.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrd.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER INFO, LDA, LWORK, N
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION D( * ), E( * )
+* COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZHETRD reduces a complex Hermitian matrix A to real symmetric
+*> tridiagonal form T by a unitary similarity transformation:
+*> Q**H * A * Q = T.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A is stored;
+*> = 'L': Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N)
+*> On entry, the Hermitian matrix A. If UPLO = 'U', the leading
+*> N-by-N upper triangular part of A contains the upper
+*> triangular part of the matrix A, and the strictly lower
+*> triangular part of A is not referenced. If UPLO = 'L', the
+*> leading N-by-N lower triangular part of A contains the lower
+*> triangular part of the matrix A, and the strictly upper
+*> triangular part of A is not referenced.
+*> On exit, if UPLO = 'U', the diagonal and first superdiagonal
+*> of A are overwritten by the corresponding elements of the
+*> tridiagonal matrix T, and the elements above the first
+*> superdiagonal, with the array TAU, represent the unitary
+*> matrix Q as a product of elementary reflectors; if UPLO
+*> = 'L', the diagonal and first subdiagonal of A are over-
+*> written by the corresponding elements of the tridiagonal
+*> matrix T, and the elements below the first subdiagonal, with
+*> the array TAU, represent the unitary 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] D
+*> \verbatim
+*> D is DOUBLE PRECISION array, dimension (N)
+*> The diagonal elements of the tridiagonal matrix T:
+*> D(i) = A(i,i).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*> E is DOUBLE PRECISION array, dimension (N-1)
+*> The off-diagonal elements of the tridiagonal matrix T:
+*> E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is COMPLEX*16 array, dimension (N-1)
+*> The scalar factors of the elementary reflectors (see Further
+*> Details).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 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 >= 1.
+*> 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 complex16HEcomputational
+*
+*> \par Further Details:
+* =====================
+*>
+*> \verbatim
+*>
+*> If UPLO = 'U', the matrix Q is represented as a product of elementary
+*> reflectors
+*>
+*> Q = H(n-1) . . . H(2) H(1).
+*>
+*> Each H(i) has the form
+*>
+*> H(i) = I - tau * v * v**H
+*>
+*> where tau is a complex scalar, and v is a complex vector with
+*> v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
+*> A(1:i-1,i+1), and tau in TAU(i).
+*>
+*> If UPLO = 'L', the matrix Q is represented as a product of elementary
+*> reflectors
+*>
+*> Q = H(1) H(2) . . . H(n-1).
+*>
+*> Each H(i) has the form
+*>
+*> H(i) = I - tau * v * v**H
+*>
+*> where tau is a complex scalar, and v is a complex vector with
+*> v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
+*> and tau in TAU(i).
+*>
+*> The contents of A on exit are illustrated by the following examples
+*> with n = 5:
+*>
+*> if UPLO = 'U': if UPLO = 'L':
+*>
+*> ( d e v2 v3 v4 ) ( d )
+*> ( d e v3 v4 ) ( e d )
+*> ( d e v4 ) ( v1 e d )
+*> ( d e ) ( v1 v2 e d )
+*> ( d ) ( v1 v2 v3 e d )
+*>
+*> where d and e denote diagonal and off-diagonal elements of T, and vi
+*> denotes an element of the vector defining H(i).
+*> \endverbatim
+*>
+* =====================================================================
+ SUBROUTINE ZHETRD( UPLO, N, A, LDA, D, E, 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 ..
+ CHARACTER UPLO
+ INTEGER INFO, LDA, LWORK, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION D( * ), E( * )
+ COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0D+0 )
+ COMPLEX*16 CONE
+ PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ LOGICAL LQUERY, UPPER
+ INTEGER I, IINFO, IWS, J, KK, LDWORK, LWKOPT, NB,
+ $ NBMIN, NX
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZHER2K, ZHETD2, ZLATRD
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ EXTERNAL LSAME, ILAENV
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ LQUERY = ( LWORK.EQ.-1 )
+ IF( .NOT.UPPER .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 = -4
+ ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
+ INFO = -9
+ END IF
+*
+ IF( INFO.EQ.0 ) THEN
+*
+* Determine the block size.
+*
+ NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 )
+ LWKOPT = N*NB
+ WORK( 1 ) = LWKOPT
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZHETRD', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 ) THEN
+ WORK( 1 ) = 1
+ RETURN
+ END IF
+*
+ NX = N
+ IWS = 1
+ IF( NB.GT.1 .AND. NB.LT.N ) THEN
+*
+* Determine when to cross over from blocked to unblocked code
+* (last block is always handled by unblocked code).
+*
+ NX = MAX( NB, ILAENV( 3, 'ZHETRD', UPLO, N, -1, -1, -1 ) )
+ IF( NX.LT.N ) 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: determine the
+* minimum value of NB, and reduce NB or force use of
+* unblocked code by setting NX = N.
+*
+ NB = MAX( LWORK / LDWORK, 1 )
+ NBMIN = ILAENV( 2, 'ZHETRD', UPLO, N, -1, -1, -1 )
+ IF( NB.LT.NBMIN )
+ $ NX = N
+ END IF
+ ELSE
+ NX = N
+ END IF
+ ELSE
+ NB = 1
+ END IF
+*
+ IF( UPPER ) THEN
+*
+* Reduce the upper triangle of A.
+* Columns 1:kk are handled by the unblocked method.
+*
+ KK = N - ( ( N-NX+NB-1 ) / NB )*NB
+ DO 20 I = N - NB + 1, KK + 1, -NB
+*
+* Reduce columns i:i+nb-1 to tridiagonal form and form the
+* matrix W which is needed to update the unreduced part of
+* the matrix
+*
+ CALL ZLATRD( UPLO, I+NB-1, NB, A, LDA, E, TAU, WORK,
+ $ LDWORK )
+*
+* Update the unreduced submatrix A(1:i-1,1:i-1), using an
+* update of the form: A := A - V*W**H - W*V**H
+*
+ CALL ZHER2K( UPLO, 'No transpose', I-1, NB, -CONE,
+ $ A( 1, I ), LDA, WORK, LDWORK, ONE, A, LDA )
+*
+* Copy superdiagonal elements back into A, and diagonal
+* elements into D
+*
+ DO 10 J = I, I + NB - 1
+ A( J-1, J ) = E( J-1 )
+ D( J ) = A( J, J )
+ 10 CONTINUE
+ 20 CONTINUE
+*
+* Use unblocked code to reduce the last or only block
+*
+ CALL ZHETD2( UPLO, KK, A, LDA, D, E, TAU, IINFO )
+ ELSE
+*
+* Reduce the lower triangle of A
+*
+ DO 40 I = 1, N - NX, NB
+*
+* Reduce columns i:i+nb-1 to tridiagonal form and form the
+* matrix W which is needed to update the unreduced part of
+* the matrix
+*
+ CALL ZLATRD( UPLO, N-I+1, NB, A( I, I ), LDA, E( I ),
+ $ TAU( I ), WORK, LDWORK )
+*
+* Update the unreduced submatrix A(i+nb:n,i+nb:n), using
+* an update of the form: A := A - V*W**H - W*V**H
+*
+ CALL ZHER2K( UPLO, 'No transpose', N-I-NB+1, NB, -CONE,
+ $ A( I+NB, I ), LDA, WORK( NB+1 ), LDWORK, ONE,
+ $ A( I+NB, I+NB ), LDA )
+*
+* Copy subdiagonal elements back into A, and diagonal
+* elements into D
+*
+ DO 30 J = I, I + NB - 1
+ A( J+1, J ) = E( J )
+ D( J ) = A( J, J )
+ 30 CONTINUE
+ 40 CONTINUE
+*
+* Use unblocked code to reduce the last or only block
+*
+ CALL ZHETD2( UPLO, N-I+1, A( I, I ), LDA, D( I ), E( I ),
+ $ TAU( I ), IINFO )
+ END IF
+*
+ WORK( 1 ) = LWKOPT
+ RETURN
+*
+* End of ZHETRD
+*
+ END
diff --git a/lib/linalg/zlacgv.f b/lib/linalg/zlacgv.f
new file mode 100644
index 0000000000000000000000000000000000000000..315c4de5ce103048eeab7d103a20a8978de13005
--- /dev/null
+++ b/lib/linalg/zlacgv.f
@@ -0,0 +1,116 @@
+*> \brief \b ZLACGV conjugates a complex vector.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLACGV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlacgv.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlacgv.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlacgv.f">
+*> [TXT]</a>
+*> \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 September 2012
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE ZLACGV( N, X, INCX )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. 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/lib/linalg/zladiv.f b/lib/linalg/zladiv.f
new file mode 100644
index 0000000000000000000000000000000000000000..8f01fe3e63b2296c728d402a7d776f40b2c27539
--- /dev/null
+++ b/lib/linalg/zladiv.f
@@ -0,0 +1,97 @@
+*> \brief \b ZLADIV performs complex division in real arithmetic, avoiding unnecessary overflow.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLADIV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zladiv.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zladiv.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zladiv.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* COMPLEX*16 FUNCTION ZLADIV( X, Y )
+*
+* .. Scalar Arguments ..
+* COMPLEX*16 X, Y
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLADIV := X / Y, where X and Y are complex. The computation of X / Y
+*> will not overflow on an intermediary step unless the results
+*> overflows.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] X
+*> \verbatim
+*> X is COMPLEX*16
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*> Y is COMPLEX*16
+*> The complex scalars X and Y.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date September 2012
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ COMPLEX*16 FUNCTION ZLADIV( X, Y )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. Scalar Arguments ..
+ COMPLEX*16 X, Y
+* ..
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ DOUBLE PRECISION ZI, ZR
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLADIV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DBLE, DCMPLX, DIMAG
+* ..
+* .. Executable Statements ..
+*
+ CALL DLADIV( DBLE( X ), DIMAG( X ), DBLE( Y ), DIMAG( Y ), ZR,
+ $ ZI )
+ ZLADIV = DCMPLX( ZR, ZI )
+*
+ RETURN
+*
+* End of ZLADIV
+*
+ END
diff --git a/lib/linalg/zlanhe.f b/lib/linalg/zlanhe.f
new file mode 100644
index 0000000000000000000000000000000000000000..3093a151afe516731e2b2ccfb438407b0da3dbce
--- /dev/null
+++ b/lib/linalg/zlanhe.f
@@ -0,0 +1,258 @@
+*> \brief \b ZLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLANHE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlanhe.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlanhe.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlanhe.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* DOUBLE PRECISION FUNCTION ZLANHE( NORM, UPLO, N, A, LDA, WORK )
+*
+* .. Scalar Arguments ..
+* CHARACTER NORM, UPLO
+* INTEGER LDA, N
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION WORK( * )
+* COMPLEX*16 A( LDA, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLANHE returns the value of the one norm, or the Frobenius norm, or
+*> the infinity norm, or the element of largest absolute value of a
+*> complex hermitian matrix A.
+*> \endverbatim
+*>
+*> \return ZLANHE
+*> \verbatim
+*>
+*> ZLANHE = ( 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 ZLANHE as described
+*> above.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> Specifies whether the upper or lower triangular part of the
+*> hermitian matrix A is to be referenced.
+*> = 'U': Upper triangular part of A is referenced
+*> = 'L': Lower triangular part of A is referenced
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0. When N = 0, ZLANHE is
+*> set to zero.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N)
+*> The hermitian matrix A. If UPLO = 'U', the leading n by n
+*> upper triangular part of A contains the upper triangular part
+*> of the matrix A, and the strictly lower triangular part of A
+*> is not referenced. If UPLO = 'L', the leading n by n lower
+*> triangular part of A contains the lower triangular part of
+*> the matrix A, 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
+*> The leading dimension of the array A. LDA >= max(N,1).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+*> where LWORK >= N when NORM = 'I' or '1' or 'O'; 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 September 2012
+*
+*> \ingroup complex16HEauxiliary
+*
+* =====================================================================
+ DOUBLE PRECISION FUNCTION ZLANHE( NORM, UPLO, N, A, LDA, WORK )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. Scalar Arguments ..
+ CHARACTER NORM, UPLO
+ INTEGER LDA, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION WORK( * )
+ COMPLEX*16 A( LDA, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J
+ DOUBLE PRECISION ABSA, SCALE, SUM, VALUE
+* ..
+* .. External Functions ..
+ LOGICAL LSAME, DISNAN
+ EXTERNAL LSAME, DISNAN
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZLASSQ
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, SQRT
+* ..
+* .. Executable Statements ..
+*
+ IF( N.EQ.0 ) THEN
+ VALUE = ZERO
+ ELSE IF( LSAME( NORM, 'M' ) ) THEN
+*
+* Find max(abs(A(i,j))).
+*
+ VALUE = ZERO
+ IF( LSAME( UPLO, 'U' ) ) THEN
+ DO 20 J = 1, N
+ DO 10 I = 1, J - 1
+ SUM = ABS( A( I, J ) )
+ IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+ 10 CONTINUE
+ SUM = ABS( DBLE( A( J, J ) ) )
+ IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+ 20 CONTINUE
+ ELSE
+ DO 40 J = 1, N
+ SUM = ABS( DBLE( A( J, J ) ) )
+ IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+ DO 30 I = J + 1, N
+ SUM = ABS( A( I, J ) )
+ IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+ 30 CONTINUE
+ 40 CONTINUE
+ END IF
+ ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
+ $ ( NORM.EQ.'1' ) ) THEN
+*
+* Find normI(A) ( = norm1(A), since A is hermitian).
+*
+ VALUE = ZERO
+ IF( LSAME( UPLO, 'U' ) ) THEN
+ DO 60 J = 1, N
+ SUM = ZERO
+ DO 50 I = 1, J - 1
+ ABSA = ABS( A( I, J ) )
+ SUM = SUM + ABSA
+ WORK( I ) = WORK( I ) + ABSA
+ 50 CONTINUE
+ WORK( J ) = SUM + ABS( DBLE( A( J, J ) ) )
+ 60 CONTINUE
+ DO 70 I = 1, N
+ SUM = WORK( I )
+ IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+ 70 CONTINUE
+ ELSE
+ DO 80 I = 1, N
+ WORK( I ) = ZERO
+ 80 CONTINUE
+ DO 100 J = 1, N
+ SUM = WORK( J ) + ABS( DBLE( A( J, J ) ) )
+ DO 90 I = J + 1, N
+ ABSA = ABS( A( I, J ) )
+ SUM = SUM + ABSA
+ WORK( I ) = WORK( I ) + ABSA
+ 90 CONTINUE
+ IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+ 100 CONTINUE
+ END IF
+ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+*
+* Find normF(A).
+*
+ SCALE = ZERO
+ SUM = ONE
+ IF( LSAME( UPLO, 'U' ) ) THEN
+ DO 110 J = 2, N
+ CALL ZLASSQ( J-1, A( 1, J ), 1, SCALE, SUM )
+ 110 CONTINUE
+ ELSE
+ DO 120 J = 1, N - 1
+ CALL ZLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM )
+ 120 CONTINUE
+ END IF
+ SUM = 2*SUM
+ DO 130 I = 1, N
+ IF( DBLE( A( I, I ) ).NE.ZERO ) THEN
+ ABSA = ABS( DBLE( A( I, I ) ) )
+ IF( SCALE.LT.ABSA ) THEN
+ SUM = ONE + SUM*( SCALE / ABSA )**2
+ SCALE = ABSA
+ ELSE
+ SUM = SUM + ( ABSA / SCALE )**2
+ END IF
+ END IF
+ 130 CONTINUE
+ VALUE = SCALE*SQRT( SUM )
+ END IF
+*
+ ZLANHE = VALUE
+ RETURN
+*
+* End of ZLANHE
+*
+ END
diff --git a/lib/linalg/zlarf.f b/lib/linalg/zlarf.f
new file mode 100644
index 0000000000000000000000000000000000000000..f51e1d73831544937bfb8f5f66c83bbb0edf6a8e
--- /dev/null
+++ b/lib/linalg/zlarf.f
@@ -0,0 +1,232 @@
+*> \brief \b ZLARF applies an elementary reflector to a general rectangular matrix.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLARF + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarf.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarf.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarf.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+* .. Scalar Arguments ..
+* CHARACTER SIDE
+* INTEGER INCV, LDC, M, N
+* COMPLEX*16 TAU
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 C( LDC, * ), V( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLARF applies a complex elementary reflector H to a complex M-by-N
+*> matrix C, from either the left or the right. H is represented in the
+*> form
+*>
+*> H = I - tau * v * v**H
+*>
+*> where tau is a complex scalar and v is a complex vector.
+*>
+*> If tau = 0, then H is taken to be the unit matrix.
+*>
+*> To apply H**H, supply conjg(tau) instead
+*> tau.
+*> \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 COMPLEX*16 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 COMPLEX*16
+*> The value tau in the representation of H.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*> C is COMPLEX*16 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 COMPLEX*16 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 September 2012
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. Scalar Arguments ..
+ CHARACTER SIDE
+ INTEGER INCV, LDC, M, N
+ COMPLEX*16 TAU
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 C( LDC, * ), V( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ONE, ZERO
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
+ $ ZERO = ( 0.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ LOGICAL APPLYLEFT
+ INTEGER I, LASTV, LASTC
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZGEMV, ZGERC
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAZLR, ILAZLC
+ EXTERNAL LSAME, ILAZLR, ILAZLC
+* ..
+* .. 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 = ILAZLC(LASTV, N, C, LDC)
+ ELSE
+* Scan for the last non-zero row in C(:,1:lastv).
+ LASTC = ILAZLR(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)**H * v(1:lastv,1)
+*
+ CALL ZGEMV( 'Conjugate 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)**H
+*
+ CALL ZGERC( 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 ZGEMV( '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)**H
+*
+ CALL ZGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
+ END IF
+ END IF
+ RETURN
+*
+* End of ZLARF
+*
+ END
diff --git a/lib/linalg/zlarfb.f b/lib/linalg/zlarfb.f
new file mode 100644
index 0000000000000000000000000000000000000000..99490f5827ffad2e19c79cf4da285dd6e4f8b681
--- /dev/null
+++ b/lib/linalg/zlarfb.f
@@ -0,0 +1,769 @@
+*> \brief \b ZLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLARFB + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarfb.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarfb.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarfb.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLARFB( 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 ..
+* COMPLEX*16 C( LDC, * ), T( LDT, * ), V( LDV, * ),
+* $ WORK( LDWORK, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLARFB applies a complex block reflector H or its transpose H**H to a
+*> complex M-by-N matrix C, from either the left or the right.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*> SIDE is CHARACTER*1
+*> = 'L': apply H or H**H from the Left
+*> = 'R': apply H or H**H from the Right
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*> TRANS is CHARACTER*1
+*> = 'N': apply H (No transpose)
+*> = 'C': apply H**H (Conjugate 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 COMPLEX*16 array, dimension
+*> (LDV,K) if STOREV = 'C'
+*> (LDV,M) if STOREV = 'R' and SIDE = 'L'
+*> (LDV,N) if STOREV = 'R' and SIDE = 'R'
+*> 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 COMPLEX*16 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 COMPLEX*16 array, dimension (LDC,N)
+*> On entry, the M-by-N matrix C.
+*> On exit, C is overwritten by H*C or H**H*C or C*H or C*H**H.
+*> \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 COMPLEX*16 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 September 2012
+*
+*> \ingroup complex16OTHERauxiliary
+*
+*> \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 ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
+ $ T, LDT, C, LDC, WORK, LDWORK )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. Scalar Arguments ..
+ CHARACTER DIRECT, SIDE, STOREV, TRANS
+ INTEGER K, LDC, LDT, LDV, LDWORK, M, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 C( LDC, * ), T( LDT, * ), V( LDV, * ),
+ $ WORK( LDWORK, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ONE
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ CHARACTER TRANST
+ INTEGER I, J, LASTV, LASTC
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAZLR, ILAZLC
+ EXTERNAL LSAME, ILAZLR, ILAZLC
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZCOPY, ZGEMM, ZLACGV, ZTRMM
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( M.LE.0 .OR. N.LE.0 )
+ $ RETURN
+*
+ IF( LSAME( TRANS, 'N' ) ) THEN
+ TRANST = 'C'
+ 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**H * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILAZLR( M, K, V, LDV ) )
+ LASTC = ILAZLC( LASTV, N, C, LDC )
+*
+* W := C**H * V = (C1**H * V1 + C2**H * V2) (stored in WORK)
+*
+* W := C1**H
+*
+ DO 10 J = 1, K
+ CALL ZCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+ CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
+ 10 CONTINUE
+*
+* W := W * V1
+*
+ CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2**H *V2
+*
+ CALL ZGEMM( 'Conjugate 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**H or W * T
+*
+ CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V * W**H
+*
+ IF( M.GT.K ) THEN
+*
+* C2 := C2 - V2 * W**H
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTV-K, LASTC, K,
+ $ -ONE, V( K+1, 1 ), LDV, WORK, LDWORK,
+ $ ONE, C( K+1, 1 ), LDC )
+ END IF
+*
+* W := W * V1**H
+*
+ CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W**H
+*
+ DO 30 J = 1, K
+ DO 20 I = 1, LASTC
+ C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
+ 20 CONTINUE
+ 30 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**H where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )
+ LASTC = ILAZLR( M, LASTV, C, LDC )
+*
+* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+*
+* W := C1
+*
+ DO 40 J = 1, K
+ CALL ZCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
+ 40 CONTINUE
+*
+* W := W * V1
+*
+ CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2 * V2
+*
+ CALL ZGEMM( '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**H
+*
+ CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V**H
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - W * V2**H
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTC, LASTV-K, K,
+ $ -ONE, WORK, LDWORK, V( K+1, 1 ), LDV,
+ $ ONE, C( 1, K+1 ), LDC )
+ END IF
+*
+* W := W * V1**H
+*
+ CALL ZTRMM( 'Right', 'Lower', 'Conjugate 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**H * C where C = ( C1 )
+* ( C2 )
+*
+ LASTC = ILAZLC( M, N, C, LDC )
+*
+* W := C**H * V = (C1**H * V1 + C2**H * V2) (stored in WORK)
+*
+* W := C2**H
+*
+ DO 70 J = 1, K
+ CALL ZCOPY( LASTC, C( M-K+J, 1 ), LDC,
+ $ WORK( 1, J ), 1 )
+ CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
+ 70 CONTINUE
+*
+* W := W * V2
+*
+ CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( M-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+ IF( M.GT.K ) THEN
+*
+* W := W + C1**H*V1
+*
+ CALL ZGEMM( 'Conjugate transpose', 'No transpose',
+ $ LASTC, K, M-K,
+ $ ONE, C, LDC, V, LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**H or W * T
+*
+ CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V * W**H
+*
+ IF( M.GT.K ) THEN
+*
+* C1 := C1 - V1 * W**H
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ M-K, LASTC, K,
+ $ -ONE, V, LDV, WORK, LDWORK,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2**H
+*
+ CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V( M-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C2 := C2 - W**H
+*
+ DO 90 J = 1, K
+ DO 80 I = 1, LASTC
+ C( M-K+J, I ) = C( M-K+J, I ) -
+ $ DCONJG( WORK( I, J ) )
+ 80 CONTINUE
+ 90 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**H where C = ( C1 C2 )
+*
+ LASTC = ILAZLR( M, N, C, LDC )
+*
+* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+*
+* W := C2
+*
+ DO 100 J = 1, K
+ CALL ZCOPY( LASTC, C( 1, N-K+J ), 1,
+ $ WORK( 1, J ), 1 )
+ 100 CONTINUE
+*
+* W := W * V2
+*
+ CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( N-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+ IF( N.GT.K ) THEN
+*
+* W := W + C1 * V1
+*
+ CALL ZGEMM( 'No transpose', 'No transpose',
+ $ LASTC, K, N-K,
+ $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**H
+*
+ CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V**H
+*
+ IF( N.GT.K ) THEN
+*
+* C1 := C1 - W * V1**H
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2**H
+*
+ CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V( N-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C2 := C2 - W
+*
+ DO 120 J = 1, K
+ DO 110 I = 1, LASTC
+ C( I, N-K+J ) = C( I, N-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**H * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )
+ LASTC = ILAZLC( LASTV, N, C, LDC )
+*
+* W := C**H * V**H = (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
+*
+* W := C1**H
+*
+ DO 130 J = 1, K
+ CALL ZCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+ CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
+ 130 CONTINUE
+*
+* W := W * V1**H
+*
+ CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2**H*V2**H
+*
+ CALL ZGEMM( 'Conjugate transpose',
+ $ 'Conjugate transpose', LASTC, K, LASTV-K,
+ $ ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**H or W * T
+*
+ CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V**H * W**H
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - V2**H * W**H
+*
+ CALL ZGEMM( 'Conjugate transpose',
+ $ 'Conjugate 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 ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W**H
+*
+ DO 150 J = 1, K
+ DO 140 I = 1, LASTC
+ C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
+ 140 CONTINUE
+ 150 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**H where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )
+ LASTC = ILAZLR( M, LASTV, C, LDC )
+*
+* W := C * V**H = (C1*V1**H + C2*V2**H) (stored in WORK)
+*
+* W := C1
+*
+ DO 160 J = 1, K
+ CALL ZCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
+ 160 CONTINUE
+*
+* W := W * V1**H
+*
+ CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2 * V2**H
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate 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**H
+*
+ CALL ZTRMM( '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 ZGEMM( '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 ZTRMM( '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**H * C where C = ( C1 )
+* ( C2 )
+*
+ LASTC = ILAZLC( M, N, C, LDC )
+*
+* W := C**H * V**H = (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
+*
+* W := C2**H
+*
+ DO 190 J = 1, K
+ CALL ZCOPY( LASTC, C( M-K+J, 1 ), LDC,
+ $ WORK( 1, J ), 1 )
+ CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
+ 190 CONTINUE
+*
+* W := W * V2**H
+*
+ CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V( 1, M-K+1 ), LDV,
+ $ WORK, LDWORK )
+ IF( M.GT.K ) THEN
+*
+* W := W + C1**H * V1**H
+*
+ CALL ZGEMM( 'Conjugate transpose',
+ $ 'Conjugate transpose', LASTC, K, M-K,
+ $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**H or W * T
+*
+ CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V**H * W**H
+*
+ IF( M.GT.K ) THEN
+*
+* C1 := C1 - V1**H * W**H
+*
+ CALL ZGEMM( 'Conjugate transpose',
+ $ 'Conjugate transpose', M-K, LASTC, K,
+ $ -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
+ END IF
+*
+* W := W * V2
+*
+ CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( 1, M-K+1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C2 := C2 - W**H
+*
+ DO 210 J = 1, K
+ DO 200 I = 1, LASTC
+ C( M-K+J, I ) = C( M-K+J, I ) -
+ $ DCONJG( WORK( I, J ) )
+ 200 CONTINUE
+ 210 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**H where C = ( C1 C2 )
+*
+ LASTC = ILAZLR( M, N, C, LDC )
+*
+* W := C * V**H = (C1*V1**H + C2*V2**H) (stored in WORK)
+*
+* W := C2
+*
+ DO 220 J = 1, K
+ CALL ZCOPY( LASTC, C( 1, N-K+J ), 1,
+ $ WORK( 1, J ), 1 )
+ 220 CONTINUE
+*
+* W := W * V2**H
+*
+ CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V( 1, N-K+1 ), LDV,
+ $ WORK, LDWORK )
+ IF( N.GT.K ) THEN
+*
+* W := W + C1 * V1**H
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTC, K, N-K, ONE, C, LDC, V, LDV, ONE,
+ $ WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**H
+*
+ CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V
+*
+ IF( N.GT.K ) THEN
+*
+* C1 := C1 - W * V1
+*
+ CALL ZGEMM( 'No transpose', 'No transpose',
+ $ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2
+*
+ CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( 1, N-K+1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 240 J = 1, K
+ DO 230 I = 1, LASTC
+ C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
+ 230 CONTINUE
+ 240 CONTINUE
+*
+ END IF
+*
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of ZLARFB
+*
+ END
diff --git a/lib/linalg/zlarfg.f b/lib/linalg/zlarfg.f
new file mode 100644
index 0000000000000000000000000000000000000000..e37c683fc9acbf85612ff8fb338c2fa3a64944e3
--- /dev/null
+++ b/lib/linalg/zlarfg.f
@@ -0,0 +1,203 @@
+*> \brief \b ZLARFG generates an elementary reflector (Householder matrix).
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLARFG + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarfg.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarfg.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarfg.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLARFG( N, ALPHA, X, INCX, TAU )
+*
+* .. Scalar Arguments ..
+* INTEGER INCX, N
+* COMPLEX*16 ALPHA, TAU
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 X( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLARFG generates a complex elementary reflector H of order n, such
+*> that
+*>
+*> H**H * ( alpha ) = ( beta ), H**H * H = I.
+*> ( x ) ( 0 )
+*>
+*> where alpha and beta are scalars, with beta real, and x is an
+*> (n-1)-element complex vector. H is represented in the form
+*>
+*> H = I - tau * ( 1 ) * ( 1 v**H ) ,
+*> ( v )
+*>
+*> where tau is a complex scalar and v is a complex (n-1)-element
+*> vector. Note that H is not hermitian.
+*>
+*> If the elements of x are all zero and alpha is real, then tau = 0
+*> and H is taken to be the unit matrix.
+*>
+*> Otherwise 1 <= real(tau) <= 2 and abs(tau-1) <= 1 .
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the elementary reflector.
+*> \endverbatim
+*>
+*> \param[in,out] ALPHA
+*> \verbatim
+*> ALPHA is COMPLEX*16
+*> On entry, the value alpha.
+*> On exit, it is overwritten with the value beta.
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*> X is COMPLEX*16 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 COMPLEX*16
+*> The value tau.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date September 2012
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE ZLARFG( N, ALPHA, X, INCX, TAU )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+ COMPLEX*16 ALPHA, TAU
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 X( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER J, KNT
+ DOUBLE PRECISION ALPHI, ALPHR, BETA, RSAFMN, SAFMIN, XNORM
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMCH, DLAPY3, DZNRM2
+ COMPLEX*16 ZLADIV
+ EXTERNAL DLAMCH, DLAPY3, DZNRM2, ZLADIV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, DCMPLX, DIMAG, SIGN
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZDSCAL, ZSCAL
+* ..
+* .. Executable Statements ..
+*
+ IF( N.LE.0 ) THEN
+ TAU = ZERO
+ RETURN
+ END IF
+*
+ XNORM = DZNRM2( N-1, X, INCX )
+ ALPHR = DBLE( ALPHA )
+ ALPHI = DIMAG( ALPHA )
+*
+ IF( XNORM.EQ.ZERO .AND. ALPHI.EQ.ZERO ) THEN
+*
+* H = I
+*
+ TAU = ZERO
+ ELSE
+*
+* general case
+*
+ BETA = -SIGN( DLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
+ SAFMIN = DLAMCH( 'S' ) / DLAMCH( 'E' )
+ RSAFMN = ONE / SAFMIN
+*
+ KNT = 0
+ IF( ABS( BETA ).LT.SAFMIN ) THEN
+*
+* XNORM, BETA may be inaccurate; scale X and recompute them
+*
+ 10 CONTINUE
+ KNT = KNT + 1
+ CALL ZDSCAL( N-1, RSAFMN, X, INCX )
+ BETA = BETA*RSAFMN
+ ALPHI = ALPHI*RSAFMN
+ ALPHR = ALPHR*RSAFMN
+ IF( ABS( BETA ).LT.SAFMIN )
+ $ GO TO 10
+*
+* New BETA is at most 1, at least SAFMIN
+*
+ XNORM = DZNRM2( N-1, X, INCX )
+ ALPHA = DCMPLX( ALPHR, ALPHI )
+ BETA = -SIGN( DLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
+ END IF
+ TAU = DCMPLX( ( BETA-ALPHR ) / BETA, -ALPHI / BETA )
+ ALPHA = ZLADIV( DCMPLX( ONE ), ALPHA-BETA )
+ CALL ZSCAL( N-1, ALPHA, 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 ZLARFG
+*
+ END
diff --git a/lib/linalg/zlarft.f b/lib/linalg/zlarft.f
new file mode 100644
index 0000000000000000000000000000000000000000..2278d11d2b3d89098c2f3296766a3e0ecd6ea485
--- /dev/null
+++ b/lib/linalg/zlarft.f
@@ -0,0 +1,327 @@
+*> \brief \b ZLARFT forms the triangular factor T of a block reflector H = I - vtvH
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLARFT + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarft.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarft.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarft.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*
+* .. Scalar Arguments ..
+* CHARACTER DIRECT, STOREV
+* INTEGER K, LDT, LDV, N
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 T( LDT, * ), TAU( * ), V( LDV, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLARFT forms the triangular factor T of a complex block reflector H
+*> of order n, which is defined as a product of k elementary reflectors.
+*>
+*> If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
+*>
+*> If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
+*>
+*> If STOREV = 'C', the vector which defines the elementary reflector
+*> H(i) is stored in the i-th column of the array V, and
+*>
+*> H = I - V * T * V**H
+*>
+*> If STOREV = 'R', the vector which defines the elementary reflector
+*> H(i) is stored in the i-th row of the array V, and
+*>
+*> H = I - V**H * T * V
+*> \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 COMPLEX*16 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 COMPLEX*16 array, dimension (K)
+*> TAU(i) must contain the scalar factor of the elementary
+*> reflector H(i).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*> T is COMPLEX*16 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 September 2012
+*
+*> \ingroup complex16OTHERauxiliary
+*
+*> \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 ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. Scalar Arguments ..
+ CHARACTER DIRECT, STOREV
+ INTEGER K, LDT, LDV, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 T( LDT, * ), TAU( * ), V( LDV, * )
+* ..
+*
+* =====================================================================
+*
+* .. 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, PREVLASTV, LASTV
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZGEMV, ZLACGV, ZTRMV
+* ..
+* .. 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( PREVLASTV, I )
+ 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 ) * CONJG( V( I , J ) )
+ END DO
+ J = MIN( LASTV, PREVLASTV )
+*
+* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**H * V(i:j,i)
+*
+ CALL ZGEMV( 'Conjugate 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)**H
+*
+ CALL ZGEMM( 'N', 'C', I-1, 1, J-I, -TAU( I ),
+ $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV,
+ $ ONE, T( 1, I ), LDT )
+ END IF
+*
+* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
+*
+ CALL ZTRMV( '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 ) * CONJG( 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)**H * V(j:n-k+i,i)
+*
+ CALL ZGEMV( 'Conjugate 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)**H
+*
+ CALL ZGEMM( 'N', 'C', K-I, 1, N-K+I-J, -TAU( I ),
+ $ V( I+1, J ), LDV, V( I, J ), LDV,
+ $ ONE, T( I+1, I ), LDT )
+ END IF
+*
+* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)
+*
+ CALL ZTRMV( '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 ZLARFT
+*
+ END
diff --git a/lib/linalg/zlascl.f b/lib/linalg/zlascl.f
new file mode 100644
index 0000000000000000000000000000000000000000..51a4f0f61494c3507dde135c77a2efa21c1d8053
--- /dev/null
+++ b/lib/linalg/zlascl.f
@@ -0,0 +1,364 @@
+*> \brief \b ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLASCL + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlascl.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlascl.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlascl.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLASCL( 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 ..
+* COMPLEX*16 A( LDA, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLASCL multiplies the M by N complex matrix A by the real scalar
+*> CTO/CFROM. This is done without over/underflow as long as the final
+*> result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
+*> A may be full, upper triangular, lower triangular, upper Hessenberg,
+*> or banded.
+*> \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 ZGBTRF 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 COMPLEX*16 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 September 2012
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. Scalar Arguments ..
+ CHARACTER TYPE
+ INTEGER INFO, KL, KU, LDA, M, N
+ DOUBLE PRECISION CFROM, CTO
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 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( 'ZLASCL', -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 ZLASCL
+*
+ END
diff --git a/lib/linalg/zlaset.f b/lib/linalg/zlaset.f
new file mode 100644
index 0000000000000000000000000000000000000000..11f82361b741c14ee49356042759aadddc4f3b34
--- /dev/null
+++ b/lib/linalg/zlaset.f
@@ -0,0 +1,184 @@
+*> \brief \b ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLASET + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlaset.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlaset.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlaset.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER LDA, M, N
+* COMPLEX*16 ALPHA, BETA
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A( LDA, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLASET initializes a 2-D array 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 lower triangle
+*> is unchanged.
+*> = 'L': Lower triangular part is set. The upper triangle
+*> is unchanged.
+*> Otherwise: All of the matrix A is set.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> On entry, M specifies the number of rows of A.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> On entry, N specifies the number of columns of A.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*> ALPHA is COMPLEX*16
+*> All the offdiagonal array elements are set to ALPHA.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*> BETA is COMPLEX*16
+*> All the diagonal array elements are set to BETA.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N)
+*> On entry, the m by n matrix A.
+*> On exit, A(i,j) = ALPHA, 1 <= i <= m, 1 <= j <= n, i.ne.j;
+*> 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 September 2012
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE ZLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER LDA, M, N
+ COMPLEX*16 ALPHA, BETA
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 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 diagonal to BETA and the strictly upper triangular
+* 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
+ DO 30 I = 1, MIN( N, M )
+ A( I, I ) = BETA
+ 30 CONTINUE
+*
+ ELSE IF( LSAME( UPLO, 'L' ) ) THEN
+*
+* Set the diagonal to BETA and the strictly lower triangular
+* part of the array to ALPHA.
+*
+ DO 50 J = 1, MIN( M, N )
+ DO 40 I = J + 1, M
+ A( I, J ) = ALPHA
+ 40 CONTINUE
+ 50 CONTINUE
+ DO 60 I = 1, MIN( N, M )
+ A( I, I ) = BETA
+ 60 CONTINUE
+*
+ ELSE
+*
+* Set the array to BETA on the diagonal and ALPHA on the
+* offdiagonal.
+*
+ DO 80 J = 1, N
+ DO 70 I = 1, M
+ A( I, J ) = ALPHA
+ 70 CONTINUE
+ 80 CONTINUE
+ DO 90 I = 1, MIN( M, N )
+ A( I, I ) = BETA
+ 90 CONTINUE
+ END IF
+*
+ RETURN
+*
+* End of ZLASET
+*
+ END
diff --git a/lib/linalg/zlasr.f b/lib/linalg/zlasr.f
new file mode 100644
index 0000000000000000000000000000000000000000..5243d8304a953a7d9b47cfdaa41be83b2646907a
--- /dev/null
+++ b/lib/linalg/zlasr.f
@@ -0,0 +1,439 @@
+*> \brief \b ZLASR applies a sequence of plane rotations to a general rectangular matrix.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLASR + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlasr.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlasr.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlasr.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
+*
+* .. Scalar Arguments ..
+* CHARACTER DIRECT, PIVOT, SIDE
+* INTEGER LDA, M, N
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION C( * ), S( * )
+* COMPLEX*16 A( LDA, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLASR applies a sequence of real plane rotations to a complex matrix
+*> A, from either the left or the right.
+*>
+*> When SIDE = 'L', the transformation takes the form
+*>
+*> A := P*A
+*>
+*> and when SIDE = 'R', the transformation takes the form
+*>
+*> A := A*P**T
+*>
+*> where P is an orthogonal matrix consisting of a sequence of z plane
+*> rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
+*> and P**T is the transpose of P.
+*>
+*> When DIRECT = 'F' (Forward sequence), then
+*>
+*> P = P(z-1) * ... * P(2) * P(1)
+*>
+*> and when DIRECT = 'B' (Backward sequence), then
+*>
+*> P = P(1) * P(2) * ... * P(z-1)
+*>
+*> where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
+*>
+*> R(k) = ( c(k) s(k) )
+*> = ( -s(k) c(k) ).
+*>
+*> When PIVOT = 'V' (Variable pivot), the rotation is performed
+*> for the plane (k,k+1), i.e., P(k) has the form
+*>
+*> P(k) = ( 1 )
+*> ( ... )
+*> ( 1 )
+*> ( c(k) s(k) )
+*> ( -s(k) c(k) )
+*> ( 1 )
+*> ( ... )
+*> ( 1 )
+*>
+*> where R(k) appears as a rank-2 modification to the identity matrix in
+*> rows and columns k and k+1.
+*>
+*> When PIVOT = 'T' (Top pivot), the rotation is performed for the
+*> plane (1,k+1), so P(k) has the form
+*>
+*> P(k) = ( c(k) s(k) )
+*> ( 1 )
+*> ( ... )
+*> ( 1 )
+*> ( -s(k) c(k) )
+*> ( 1 )
+*> ( ... )
+*> ( 1 )
+*>
+*> where R(k) appears in rows and columns 1 and k+1.
+*>
+*> Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
+*> performed for the plane (k,z), giving P(k) the form
+*>
+*> P(k) = ( 1 )
+*> ( ... )
+*> ( 1 )
+*> ( c(k) s(k) )
+*> ( 1 )
+*> ( ... )
+*> ( 1 )
+*> ( -s(k) c(k) )
+*>
+*> where R(k) appears in rows and columns k and z. The rotations are
+*> performed without ever forming P(k) explicitly.
+*> \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 COMPLEX*16 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 September 2012
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE ZLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. Scalar Arguments ..
+ CHARACTER DIRECT, PIVOT, SIDE
+ INTEGER LDA, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION C( * ), S( * )
+ COMPLEX*16 A( LDA, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, INFO, J
+ DOUBLE PRECISION CTEMP, STEMP
+ COMPLEX*16 TEMP
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* ..
+* .. 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( 'ZLASR ', 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 ZLASR
+*
+ END
diff --git a/lib/linalg/zlassq.f b/lib/linalg/zlassq.f
new file mode 100644
index 0000000000000000000000000000000000000000..5b7e66c30bd421e41b836e4262903dc952022712
--- /dev/null
+++ b/lib/linalg/zlassq.f
@@ -0,0 +1,168 @@
+*> \brief \b ZLASSQ updates a sum of squares represented in scaled form.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLASSQ + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlassq.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlassq.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlassq.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ )
+*
+* .. Scalar Arguments ..
+* INTEGER INCX, N
+* DOUBLE PRECISION SCALE, SUMSQ
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 X( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLASSQ returns the values scl and ssq such that
+*>
+*> ( scl**2 )*ssq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
+*>
+*> where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is
+*> assumed to be at least unity and the value of ssq will then satisfy
+*>
+*> 1.0 .le. ssq .le. ( sumsq + 2*n ).
+*>
+*> scale is assumed to be non-negative and scl returns the value
+*>
+*> scl = max( scale, abs( real( x( i ) ) ), abs( aimag( x( i ) ) ) ),
+*> i
+*>
+*> scale and sumsq must be supplied in SCALE and SUMSQ respectively.
+*> SCALE and SUMSQ are overwritten by scl and ssq 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 COMPLEX*16 array, dimension (N)
+*> The vector x as described above.
+*> 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 the value scl .
+*> \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 the value ssq .
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date September 2012
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+ DOUBLE PRECISION SCALE, SUMSQ
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 X( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER IX
+ DOUBLE PRECISION TEMP1
+* ..
+* .. External Functions ..
+ LOGICAL DISNAN
+ EXTERNAL DISNAN
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, DIMAG
+* ..
+* .. Executable Statements ..
+*
+ IF( N.GT.0 ) THEN
+ DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
+ TEMP1 = ABS( DBLE( X( IX ) ) )
+ IF( TEMP1.GT.ZERO.OR.DISNAN( TEMP1 ) ) THEN
+ IF( SCALE.LT.TEMP1 ) THEN
+ SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
+ SCALE = TEMP1
+ ELSE
+ SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
+ END IF
+ END IF
+ TEMP1 = ABS( DIMAG( X( IX ) ) )
+ IF( TEMP1.GT.ZERO.OR.DISNAN( TEMP1 ) ) THEN
+ IF( SCALE.LT.TEMP1 ) THEN
+ SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
+ SCALE = TEMP1
+ ELSE
+ SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
+ END IF
+ END IF
+ 10 CONTINUE
+ END IF
+*
+ RETURN
+*
+* End of ZLASSQ
+*
+ END
diff --git a/lib/linalg/zlatrd.f b/lib/linalg/zlatrd.f
new file mode 100644
index 0000000000000000000000000000000000000000..619d7280c482270f6117235e941bf529e347ebc0
--- /dev/null
+++ b/lib/linalg/zlatrd.f
@@ -0,0 +1,358 @@
+*> \brief \b ZLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal form by an unitary similarity transformation.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLATRD + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlatrd.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlatrd.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlatrd.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER LDA, LDW, N, NB
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION E( * )
+* COMPLEX*16 A( LDA, * ), TAU( * ), W( LDW, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLATRD reduces NB rows and columns of a complex Hermitian matrix A to
+*> Hermitian tridiagonal form by a unitary similarity
+*> transformation Q**H * A * Q, and returns the matrices V and W which are
+*> needed to apply the transformation to the unreduced part of A.
+*>
+*> If UPLO = 'U', ZLATRD reduces the last NB rows and columns of a
+*> matrix, of which the upper triangle is supplied;
+*> if UPLO = 'L', ZLATRD reduces the first NB rows and columns of a
+*> matrix, of which the lower triangle is supplied.
+*>
+*> This is an auxiliary routine called by ZHETRD.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> Specifies whether the upper or lower triangular part of the
+*> Hermitian matrix A is stored:
+*> = 'U': Upper triangular
+*> = 'L': Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*> NB is INTEGER
+*> The number of rows and columns to be reduced.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N)
+*> On entry, the Hermitian matrix A. If UPLO = 'U', the leading
+*> n-by-n upper triangular part of A contains the upper
+*> triangular part of the matrix A, and the strictly lower
+*> triangular part of A is not referenced. If UPLO = 'L', the
+*> leading n-by-n lower triangular part of A contains the lower
+*> triangular part of the matrix A, and the strictly upper
+*> triangular part of A is not referenced.
+*> On exit:
+*> if UPLO = 'U', the last NB columns have been reduced to
+*> tridiagonal form, with the diagonal elements overwriting
+*> the diagonal elements of A; the elements above the diagonal
+*> with the array TAU, represent the unitary matrix Q as a
+*> product of elementary reflectors;
+*> if UPLO = 'L', the first NB columns have been reduced to
+*> tridiagonal form, with the diagonal elements overwriting
+*> the diagonal elements of A; the elements below the diagonal
+*> with the array TAU, represent the unitary 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] E
+*> \verbatim
+*> E is DOUBLE PRECISION array, dimension (N-1)
+*> If UPLO = 'U', E(n-nb:n-1) contains the superdiagonal
+*> elements of the last NB columns of the reduced matrix;
+*> if UPLO = 'L', E(1:nb) contains the subdiagonal elements of
+*> the first NB columns of the reduced matrix.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is COMPLEX*16 array, dimension (N-1)
+*> The scalar factors of the elementary reflectors, stored in
+*> TAU(n-nb:n-1) if UPLO = 'U', and in TAU(1:nb) if UPLO = 'L'.
+*> See Further Details.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*> W is COMPLEX*16 array, dimension (LDW,NB)
+*> The n-by-nb matrix W required to update the unreduced part
+*> of A.
+*> \endverbatim
+*>
+*> \param[in] LDW
+*> \verbatim
+*> LDW is INTEGER
+*> The leading dimension of the array W. LDW >= max(1,N).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date September 2012
+*
+*> \ingroup complex16OTHERauxiliary
+*
+*> \par Further Details:
+* =====================
+*>
+*> \verbatim
+*>
+*> If UPLO = 'U', the matrix Q is represented as a product of elementary
+*> reflectors
+*>
+*> Q = H(n) H(n-1) . . . H(n-nb+1).
+*>
+*> Each H(i) has the form
+*>
+*> H(i) = I - tau * v * v**H
+*>
+*> where tau is a complex scalar, and v is a complex vector with
+*> v(i:n) = 0 and v(i-1) = 1; v(1:i-1) is stored on exit in A(1:i-1,i),
+*> and tau in TAU(i-1).
+*>
+*> If UPLO = 'L', the matrix Q is represented as a product of elementary
+*> reflectors
+*>
+*> Q = H(1) H(2) . . . H(nb).
+*>
+*> Each H(i) has the form
+*>
+*> H(i) = I - tau * v * v**H
+*>
+*> where tau is a complex scalar, and v is a complex vector with
+*> v(1:i) = 0 and v(i+1) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
+*> and tau in TAU(i).
+*>
+*> The elements of the vectors v together form the n-by-nb matrix V
+*> which is needed, with W, to apply the transformation to the unreduced
+*> part of the matrix, using a Hermitian rank-2k update of the form:
+*> A := A - V*W**H - W*V**H.
+*>
+*> The contents of A on exit are illustrated by the following examples
+*> with n = 5 and nb = 2:
+*>
+*> if UPLO = 'U': if UPLO = 'L':
+*>
+*> ( a a a v4 v5 ) ( d )
+*> ( a a v4 v5 ) ( 1 d )
+*> ( a 1 v5 ) ( v1 1 a )
+*> ( d 1 ) ( v1 v2 a a )
+*> ( d ) ( v1 v2 a a a )
+*>
+*> where d denotes a diagonal element of the reduced matrix, a denotes
+*> an element of the original matrix that is unchanged, and vi denotes
+*> an element of the vector defining H(i).
+*> \endverbatim
+*>
+* =====================================================================
+ SUBROUTINE ZLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
+*
+* -- LAPACK auxiliary routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER LDA, LDW, N, NB
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION E( * )
+ COMPLEX*16 A( LDA, * ), TAU( * ), W( LDW, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ZERO, ONE, HALF
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
+ $ ONE = ( 1.0D+0, 0.0D+0 ),
+ $ HALF = ( 0.5D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER I, IW
+ COMPLEX*16 ALPHA
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZAXPY, ZGEMV, ZHEMV, ZLACGV, ZLARFG, ZSCAL
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ COMPLEX*16 ZDOTC
+ EXTERNAL LSAME, ZDOTC
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DBLE, MIN
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( N.LE.0 )
+ $ RETURN
+*
+ IF( LSAME( UPLO, 'U' ) ) THEN
+*
+* Reduce last NB columns of upper triangle
+*
+ DO 10 I = N, N - NB + 1, -1
+ IW = I - N + NB
+ IF( I.LT.N ) THEN
+*
+* Update A(1:i,i)
+*
+ A( I, I ) = DBLE( A( I, I ) )
+ CALL ZLACGV( N-I, W( I, IW+1 ), LDW )
+ CALL ZGEMV( 'No transpose', I, N-I, -ONE, A( 1, I+1 ),
+ $ LDA, W( I, IW+1 ), LDW, ONE, A( 1, I ), 1 )
+ CALL ZLACGV( N-I, W( I, IW+1 ), LDW )
+ CALL ZLACGV( N-I, A( I, I+1 ), LDA )
+ CALL ZGEMV( 'No transpose', I, N-I, -ONE, W( 1, IW+1 ),
+ $ LDW, A( I, I+1 ), LDA, ONE, A( 1, I ), 1 )
+ CALL ZLACGV( N-I, A( I, I+1 ), LDA )
+ A( I, I ) = DBLE( A( I, I ) )
+ END IF
+ IF( I.GT.1 ) THEN
+*
+* Generate elementary reflector H(i) to annihilate
+* A(1:i-2,i)
+*
+ ALPHA = A( I-1, I )
+ CALL ZLARFG( I-1, ALPHA, A( 1, I ), 1, TAU( I-1 ) )
+ E( I-1 ) = ALPHA
+ A( I-1, I ) = ONE
+*
+* Compute W(1:i-1,i)
+*
+ CALL ZHEMV( 'Upper', I-1, ONE, A, LDA, A( 1, I ), 1,
+ $ ZERO, W( 1, IW ), 1 )
+ IF( I.LT.N ) THEN
+ CALL ZGEMV( 'Conjugate transpose', I-1, N-I, ONE,
+ $ W( 1, IW+1 ), LDW, A( 1, I ), 1, ZERO,
+ $ W( I+1, IW ), 1 )
+ CALL ZGEMV( 'No transpose', I-1, N-I, -ONE,
+ $ A( 1, I+1 ), LDA, W( I+1, IW ), 1, ONE,
+ $ W( 1, IW ), 1 )
+ CALL ZGEMV( 'Conjugate transpose', I-1, N-I, ONE,
+ $ A( 1, I+1 ), LDA, A( 1, I ), 1, ZERO,
+ $ W( I+1, IW ), 1 )
+ CALL ZGEMV( 'No transpose', I-1, N-I, -ONE,
+ $ W( 1, IW+1 ), LDW, W( I+1, IW ), 1, ONE,
+ $ W( 1, IW ), 1 )
+ END IF
+ CALL ZSCAL( I-1, TAU( I-1 ), W( 1, IW ), 1 )
+ ALPHA = -HALF*TAU( I-1 )*ZDOTC( I-1, W( 1, IW ), 1,
+ $ A( 1, I ), 1 )
+ CALL ZAXPY( I-1, ALPHA, A( 1, I ), 1, W( 1, IW ), 1 )
+ END IF
+*
+ 10 CONTINUE
+ ELSE
+*
+* Reduce first NB columns of lower triangle
+*
+ DO 20 I = 1, NB
+*
+* Update A(i:n,i)
+*
+ A( I, I ) = DBLE( A( I, I ) )
+ CALL ZLACGV( I-1, W( I, 1 ), LDW )
+ CALL ZGEMV( 'No transpose', N-I+1, I-1, -ONE, A( I, 1 ),
+ $ LDA, W( I, 1 ), LDW, ONE, A( I, I ), 1 )
+ CALL ZLACGV( I-1, W( I, 1 ), LDW )
+ CALL ZLACGV( I-1, A( I, 1 ), LDA )
+ CALL ZGEMV( 'No transpose', N-I+1, I-1, -ONE, W( I, 1 ),
+ $ LDW, A( I, 1 ), LDA, ONE, A( I, I ), 1 )
+ CALL ZLACGV( I-1, A( I, 1 ), LDA )
+ A( I, I ) = DBLE( A( I, I ) )
+ IF( I.LT.N ) THEN
+*
+* Generate elementary reflector H(i) to annihilate
+* A(i+2:n,i)
+*
+ ALPHA = A( I+1, I )
+ CALL ZLARFG( N-I, ALPHA, A( MIN( I+2, N ), I ), 1,
+ $ TAU( I ) )
+ E( I ) = ALPHA
+ A( I+1, I ) = ONE
+*
+* Compute W(i+1:n,i)
+*
+ CALL ZHEMV( 'Lower', N-I, ONE, A( I+1, I+1 ), LDA,
+ $ A( I+1, I ), 1, ZERO, W( I+1, I ), 1 )
+ CALL ZGEMV( 'Conjugate transpose', N-I, I-1, ONE,
+ $ W( I+1, 1 ), LDW, A( I+1, I ), 1, ZERO,
+ $ W( 1, I ), 1 )
+ CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, A( I+1, 1 ),
+ $ LDA, W( 1, I ), 1, ONE, W( I+1, I ), 1 )
+ CALL ZGEMV( 'Conjugate transpose', N-I, I-1, ONE,
+ $ A( I+1, 1 ), LDA, A( I+1, I ), 1, ZERO,
+ $ W( 1, I ), 1 )
+ CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, W( I+1, 1 ),
+ $ LDW, W( 1, I ), 1, ONE, W( I+1, I ), 1 )
+ CALL ZSCAL( N-I, TAU( I ), W( I+1, I ), 1 )
+ ALPHA = -HALF*TAU( I )*ZDOTC( N-I, W( I+1, I ), 1,
+ $ A( I+1, I ), 1 )
+ CALL ZAXPY( N-I, ALPHA, A( I+1, I ), 1, W( I+1, I ), 1 )
+ END IF
+*
+ 20 CONTINUE
+ END IF
+*
+ RETURN
+*
+* End of ZLATRD
+*
+ END
diff --git a/lib/linalg/zsteqr.f b/lib/linalg/zsteqr.f
new file mode 100644
index 0000000000000000000000000000000000000000..33af78e854425201ba713272e0532406d325ad8b
--- /dev/null
+++ b/lib/linalg/zsteqr.f
@@ -0,0 +1,576 @@
+*> \brief \b ZSTEQR
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSTEQR + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsteqr.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsteqr.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsteqr.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER COMPZ
+* INTEGER INFO, LDZ, N
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION D( * ), E( * ), WORK( * )
+* COMPLEX*16 Z( LDZ, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZSTEQR computes all eigenvalues and, optionally, eigenvectors of a
+*> symmetric tridiagonal matrix using the implicit QL or QR method.
+*> The eigenvectors of a full or band complex Hermitian matrix can also
+*> be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this
+*> matrix to tridiagonal form.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] COMPZ
+*> \verbatim
+*> COMPZ is CHARACTER*1
+*> = 'N': Compute eigenvalues only.
+*> = 'V': Compute eigenvalues and eigenvectors of the original
+*> Hermitian matrix. On entry, Z must contain the
+*> unitary matrix used to reduce the original matrix
+*> to tridiagonal form.
+*> = 'I': Compute eigenvalues and eigenvectors of the
+*> tridiagonal matrix. Z is initialized to the identity
+*> matrix.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix. N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] D
+*> \verbatim
+*> D is DOUBLE PRECISION array, dimension (N)
+*> On entry, the diagonal elements of the tridiagonal matrix.
+*> On exit, if INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[in,out] E
+*> \verbatim
+*> E is DOUBLE PRECISION array, dimension (N-1)
+*> On entry, the (n-1) subdiagonal elements of the tridiagonal
+*> matrix.
+*> On exit, E has been destroyed.
+*> \endverbatim
+*>
+*> \param[in,out] Z
+*> \verbatim
+*> Z is COMPLEX*16 array, dimension (LDZ, N)
+*> On entry, if COMPZ = 'V', then Z contains the unitary
+*> matrix used in the reduction to tridiagonal form.
+*> On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
+*> orthonormal eigenvectors of the original Hermitian matrix,
+*> and if COMPZ = 'I', Z contains the orthonormal eigenvectors
+*> of the symmetric tridiagonal matrix.
+*> If COMPZ = 'N', then Z is not referenced.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*> LDZ is INTEGER
+*> The leading dimension of the array Z. LDZ >= 1, and if
+*> eigenvectors are desired, then LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is DOUBLE PRECISION array, dimension (max(1,2*N-2))
+*> If COMPZ = 'N', then WORK is not referenced.
+*> \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 has failed to find all the eigenvalues in
+*> a total of 30*N iterations; if INFO = i, then i
+*> elements of E have not converged to zero; on exit, D
+*> and E contain the elements of a symmetric tridiagonal
+*> matrix which is unitarily similar to the original
+*> matrix.
+*> \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 ZSTEQR( COMPZ, N, D, E, Z, LDZ, 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 COMPZ
+ INTEGER INFO, LDZ, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION D( * ), E( * ), WORK( * )
+ COMPLEX*16 Z( LDZ, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE, TWO, THREE
+ PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
+ $ THREE = 3.0D0 )
+ COMPLEX*16 CZERO, CONE
+ PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ),
+ $ CONE = ( 1.0D0, 0.0D0 ) )
+ INTEGER MAXIT
+ PARAMETER ( MAXIT = 30 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, ICOMPZ, II, ISCALE, J, JTOT, K, L, L1, LEND,
+ $ LENDM1, LENDP1, LENDSV, LM1, LSV, M, MM, MM1,
+ $ NM1, NMAXIT
+ DOUBLE PRECISION ANORM, B, C, EPS, EPS2, F, G, P, R, RT1, RT2,
+ $ S, SAFMAX, SAFMIN, SSFMAX, SSFMIN, TST
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ DOUBLE PRECISION DLAMCH, DLANST, DLAPY2
+ EXTERNAL LSAME, DLAMCH, DLANST, DLAPY2
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLAE2, DLAEV2, DLARTG, DLASCL, DLASRT, XERBLA,
+ $ ZLASET, ZLASR, ZSWAP
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, SIGN, SQRT
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+*
+ IF( LSAME( COMPZ, 'N' ) ) THEN
+ ICOMPZ = 0
+ ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
+ ICOMPZ = 1
+ ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
+ ICOMPZ = 2
+ ELSE
+ ICOMPZ = -1
+ END IF
+ IF( ICOMPZ.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1,
+ $ N ) ) ) THEN
+ INFO = -6
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZSTEQR', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+ IF( N.EQ.1 ) THEN
+ IF( ICOMPZ.EQ.2 )
+ $ Z( 1, 1 ) = CONE
+ RETURN
+ END IF
+*
+* Determine the unit roundoff and over/underflow thresholds.
+*
+ EPS = DLAMCH( 'E' )
+ EPS2 = EPS**2
+ SAFMIN = DLAMCH( 'S' )
+ SAFMAX = ONE / SAFMIN
+ SSFMAX = SQRT( SAFMAX ) / THREE
+ SSFMIN = SQRT( SAFMIN ) / EPS2
+*
+* Compute the eigenvalues and eigenvectors of the tridiagonal
+* matrix.
+*
+ IF( ICOMPZ.EQ.2 )
+ $ CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDZ )
+*
+ NMAXIT = N*MAXIT
+ JTOT = 0
+*
+* Determine where the matrix splits and choose QL or QR iteration
+* for each block, according to whether top or bottom diagonal
+* element is smaller.
+*
+ L1 = 1
+ NM1 = N - 1
+*
+ 10 CONTINUE
+ IF( L1.GT.N )
+ $ GO TO 160
+ IF( L1.GT.1 )
+ $ E( L1-1 ) = ZERO
+ IF( L1.LE.NM1 ) THEN
+ DO 20 M = L1, NM1
+ TST = ABS( E( M ) )
+ IF( TST.EQ.ZERO )
+ $ GO TO 30
+ IF( TST.LE.( SQRT( ABS( D( M ) ) )*SQRT( ABS( D( M+
+ $ 1 ) ) ) )*EPS ) THEN
+ E( M ) = ZERO
+ GO TO 30
+ END IF
+ 20 CONTINUE
+ END IF
+ M = N
+*
+ 30 CONTINUE
+ L = L1
+ LSV = L
+ LEND = M
+ LENDSV = LEND
+ L1 = M + 1
+ IF( LEND.EQ.L )
+ $ GO TO 10
+*
+* Scale submatrix in rows and columns L to LEND
+*
+ ANORM = DLANST( 'I', LEND-L+1, D( L ), E( L ) )
+ ISCALE = 0
+ IF( ANORM.EQ.ZERO )
+ $ GO TO 10
+ IF( ANORM.GT.SSFMAX ) THEN
+ ISCALE = 1
+ CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N,
+ $ INFO )
+ CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L, 1, E( L ), N,
+ $ INFO )
+ ELSE IF( ANORM.LT.SSFMIN ) THEN
+ ISCALE = 2
+ CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), N,
+ $ INFO )
+ CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L, 1, E( L ), N,
+ $ INFO )
+ END IF
+*
+* Choose between QL and QR iteration
+*
+ IF( ABS( D( LEND ) ).LT.ABS( D( L ) ) ) THEN
+ LEND = LSV
+ L = LENDSV
+ END IF
+*
+ IF( LEND.GT.L ) THEN
+*
+* QL Iteration
+*
+* Look for small subdiagonal element.
+*
+ 40 CONTINUE
+ IF( L.NE.LEND ) THEN
+ LENDM1 = LEND - 1
+ DO 50 M = L, LENDM1
+ TST = ABS( E( M ) )**2
+ IF( TST.LE.( EPS2*ABS( D( M ) ) )*ABS( D( M+1 ) )+
+ $ SAFMIN )GO TO 60
+ 50 CONTINUE
+ END IF
+*
+ M = LEND
+*
+ 60 CONTINUE
+ IF( M.LT.LEND )
+ $ E( M ) = ZERO
+ P = D( L )
+ IF( M.EQ.L )
+ $ GO TO 80
+*
+* If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
+* to compute its eigensystem.
+*
+ IF( M.EQ.L+1 ) THEN
+ IF( ICOMPZ.GT.0 ) THEN
+ CALL DLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C, S )
+ WORK( L ) = C
+ WORK( N-1+L ) = S
+ CALL ZLASR( 'R', 'V', 'B', N, 2, WORK( L ),
+ $ WORK( N-1+L ), Z( 1, L ), LDZ )
+ ELSE
+ CALL DLAE2( D( L ), E( L ), D( L+1 ), RT1, RT2 )
+ END IF
+ D( L ) = RT1
+ D( L+1 ) = RT2
+ E( L ) = ZERO
+ L = L + 2
+ IF( L.LE.LEND )
+ $ GO TO 40
+ GO TO 140
+ END IF
+*
+ IF( JTOT.EQ.NMAXIT )
+ $ GO TO 140
+ JTOT = JTOT + 1
+*
+* Form shift.
+*
+ G = ( D( L+1 )-P ) / ( TWO*E( L ) )
+ R = DLAPY2( G, ONE )
+ G = D( M ) - P + ( E( L ) / ( G+SIGN( R, G ) ) )
+*
+ S = ONE
+ C = ONE
+ P = ZERO
+*
+* Inner loop
+*
+ MM1 = M - 1
+ DO 70 I = MM1, L, -1
+ F = S*E( I )
+ B = C*E( I )
+ CALL DLARTG( G, F, C, S, R )
+ IF( I.NE.M-1 )
+ $ E( I+1 ) = R
+ G = D( I+1 ) - P
+ R = ( D( I )-G )*S + TWO*C*B
+ P = S*R
+ D( I+1 ) = G + P
+ G = C*R - B
+*
+* If eigenvectors are desired, then save rotations.
+*
+ IF( ICOMPZ.GT.0 ) THEN
+ WORK( I ) = C
+ WORK( N-1+I ) = -S
+ END IF
+*
+ 70 CONTINUE
+*
+* If eigenvectors are desired, then apply saved rotations.
+*
+ IF( ICOMPZ.GT.0 ) THEN
+ MM = M - L + 1
+ CALL ZLASR( 'R', 'V', 'B', N, MM, WORK( L ), WORK( N-1+L ),
+ $ Z( 1, L ), LDZ )
+ END IF
+*
+ D( L ) = D( L ) - P
+ E( L ) = G
+ GO TO 40
+*
+* Eigenvalue found.
+*
+ 80 CONTINUE
+ D( L ) = P
+*
+ L = L + 1
+ IF( L.LE.LEND )
+ $ GO TO 40
+ GO TO 140
+*
+ ELSE
+*
+* QR Iteration
+*
+* Look for small superdiagonal element.
+*
+ 90 CONTINUE
+ IF( L.NE.LEND ) THEN
+ LENDP1 = LEND + 1
+ DO 100 M = L, LENDP1, -1
+ TST = ABS( E( M-1 ) )**2
+ IF( TST.LE.( EPS2*ABS( D( M ) ) )*ABS( D( M-1 ) )+
+ $ SAFMIN )GO TO 110
+ 100 CONTINUE
+ END IF
+*
+ M = LEND
+*
+ 110 CONTINUE
+ IF( M.GT.LEND )
+ $ E( M-1 ) = ZERO
+ P = D( L )
+ IF( M.EQ.L )
+ $ GO TO 130
+*
+* If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
+* to compute its eigensystem.
+*
+ IF( M.EQ.L-1 ) THEN
+ IF( ICOMPZ.GT.0 ) THEN
+ CALL DLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C, S )
+ WORK( M ) = C
+ WORK( N-1+M ) = S
+ CALL ZLASR( 'R', 'V', 'F', N, 2, WORK( M ),
+ $ WORK( N-1+M ), Z( 1, L-1 ), LDZ )
+ ELSE
+ CALL DLAE2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2 )
+ END IF
+ D( L-1 ) = RT1
+ D( L ) = RT2
+ E( L-1 ) = ZERO
+ L = L - 2
+ IF( L.GE.LEND )
+ $ GO TO 90
+ GO TO 140
+ END IF
+*
+ IF( JTOT.EQ.NMAXIT )
+ $ GO TO 140
+ JTOT = JTOT + 1
+*
+* Form shift.
+*
+ G = ( D( L-1 )-P ) / ( TWO*E( L-1 ) )
+ R = DLAPY2( G, ONE )
+ G = D( M ) - P + ( E( L-1 ) / ( G+SIGN( R, G ) ) )
+*
+ S = ONE
+ C = ONE
+ P = ZERO
+*
+* Inner loop
+*
+ LM1 = L - 1
+ DO 120 I = M, LM1
+ F = S*E( I )
+ B = C*E( I )
+ CALL DLARTG( G, F, C, S, R )
+ IF( I.NE.M )
+ $ E( I-1 ) = R
+ G = D( I ) - P
+ R = ( D( I+1 )-G )*S + TWO*C*B
+ P = S*R
+ D( I ) = G + P
+ G = C*R - B
+*
+* If eigenvectors are desired, then save rotations.
+*
+ IF( ICOMPZ.GT.0 ) THEN
+ WORK( I ) = C
+ WORK( N-1+I ) = S
+ END IF
+*
+ 120 CONTINUE
+*
+* If eigenvectors are desired, then apply saved rotations.
+*
+ IF( ICOMPZ.GT.0 ) THEN
+ MM = L - M + 1
+ CALL ZLASR( 'R', 'V', 'F', N, MM, WORK( M ), WORK( N-1+M ),
+ $ Z( 1, M ), LDZ )
+ END IF
+*
+ D( L ) = D( L ) - P
+ E( LM1 ) = G
+ GO TO 90
+*
+* Eigenvalue found.
+*
+ 130 CONTINUE
+ D( L ) = P
+*
+ L = L - 1
+ IF( L.GE.LEND )
+ $ GO TO 90
+ GO TO 140
+*
+ END IF
+*
+* Undo scaling if necessary
+*
+ 140 CONTINUE
+ IF( ISCALE.EQ.1 ) THEN
+ CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV+1, 1,
+ $ D( LSV ), N, INFO )
+ CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1, E( LSV ),
+ $ N, INFO )
+ ELSE IF( ISCALE.EQ.2 ) THEN
+ CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV+1, 1,
+ $ D( LSV ), N, INFO )
+ CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1, E( LSV ),
+ $ N, INFO )
+ END IF
+*
+* Check for no convergence to an eigenvalue after a total
+* of N*MAXIT iterations.
+*
+ IF( JTOT.EQ.NMAXIT ) THEN
+ DO 150 I = 1, N - 1
+ IF( E( I ).NE.ZERO )
+ $ INFO = INFO + 1
+ 150 CONTINUE
+ RETURN
+ END IF
+ GO TO 10
+*
+* Order eigenvalues and eigenvectors.
+*
+ 160 CONTINUE
+ IF( ICOMPZ.EQ.0 ) THEN
+*
+* Use Quick Sort
+*
+ CALL DLASRT( 'I', N, D, INFO )
+*
+ ELSE
+*
+* Use Selection Sort to minimize swaps of eigenvectors
+*
+ DO 180 II = 2, N
+ I = II - 1
+ K = I
+ P = D( I )
+ DO 170 J = II, N
+ IF( D( J ).LT.P ) THEN
+ K = J
+ P = D( J )
+ END IF
+ 170 CONTINUE
+ IF( K.NE.I ) THEN
+ D( K ) = D( I )
+ D( I ) = P
+ CALL ZSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 )
+ END IF
+ 180 CONTINUE
+ END IF
+ RETURN
+*
+* End of ZSTEQR
+*
+ END
diff --git a/lib/linalg/zswap.f b/lib/linalg/zswap.f
new file mode 100644
index 0000000000000000000000000000000000000000..ca2f34721192c53ee11ec4e0dc05a722e5e4cfe8
--- /dev/null
+++ b/lib/linalg/zswap.f
@@ -0,0 +1,98 @@
+*> \brief \b ZSWAP
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZSWAP(N,ZX,INCX,ZY,INCY)
+*
+* .. Scalar Arguments ..
+* INTEGER INCX,INCY,N
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 ZX(*),ZY(*)
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZSWAP interchanges two vectors.
+*> \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 ZSWAP(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
+* ..
+ 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 = ZX(I)
+ ZX(I) = ZY(I)
+ ZY(I) = ZTEMP
+ 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 = ZX(IX)
+ ZX(IX) = ZY(IY)
+ ZY(IY) = ZTEMP
+ IX = IX + INCX
+ IY = IY + INCY
+ END DO
+ END IF
+ RETURN
+ END
diff --git a/lib/linalg/ztrmm.f b/lib/linalg/ztrmm.f
new file mode 100644
index 0000000000000000000000000000000000000000..ba7aead68b5df58348242a8497ded795e1215168
--- /dev/null
+++ b/lib/linalg/ztrmm.f
@@ -0,0 +1,452 @@
+*> \brief \b ZTRMM
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
+*
+* .. Scalar Arguments ..
+* COMPLEX*16 ALPHA
+* INTEGER LDA,LDB,M,N
+* CHARACTER DIAG,SIDE,TRANSA,UPLO
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A(LDA,*),B(LDB,*)
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZTRMM performs one of the matrix-matrix operations
+*>
+*> B := alpha*op( A )*B, or B := alpha*B*op( A )
+*>
+*> where alpha is a scalar, B is an m by n matrix, A is a unit, or
+*> non-unit, upper or lower triangular matrix and op( A ) is one of
+*>
+*> op( A ) = A or op( A ) = A**T or op( A ) = A**H.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*> SIDE is 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 ).
+*> \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**H.
+*> \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 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.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is 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.
+*> \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] B
+*> \verbatim
+*> B is (input/output) COMPLEX*16 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.
+*> \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 complex16_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 ZTRMM(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 ..
+ COMPLEX*16 ALPHA
+ INTEGER LDA,LDB,M,N
+ CHARACTER DIAG,SIDE,TRANSA,UPLO
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A(LDA,*),B(LDB,*)
+* ..
+*
+* =====================================================================
+*
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG,MAX
+* ..
+* .. Local Scalars ..
+ COMPLEX*16 TEMP
+ INTEGER I,INFO,J,K,NROWA
+ LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER
+* ..
+* .. Parameters ..
+ COMPLEX*16 ONE
+ PARAMETER (ONE= (1.0D+0,0.0D+0))
+ COMPLEX*16 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('ZTRMM ',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 or B := alpha*A**H*B.
+*
+ IF (UPPER) THEN
+ DO 120 J = 1,N
+ DO 110 I = M,1,-1
+ TEMP = B(I,J)
+ IF (NOCONJ) THEN
+ IF (NOUNIT) TEMP = TEMP*A(I,I)
+ DO 90 K = 1,I - 1
+ TEMP = TEMP + A(K,I)*B(K,J)
+ 90 CONTINUE
+ ELSE
+ IF (NOUNIT) TEMP = TEMP*DCONJG(A(I,I))
+ DO 100 K = 1,I - 1
+ TEMP = TEMP + DCONJG(A(K,I))*B(K,J)
+ 100 CONTINUE
+ END IF
+ B(I,J) = ALPHA*TEMP
+ 110 CONTINUE
+ 120 CONTINUE
+ ELSE
+ DO 160 J = 1,N
+ DO 150 I = 1,M
+ TEMP = B(I,J)
+ IF (NOCONJ) THEN
+ IF (NOUNIT) TEMP = TEMP*A(I,I)
+ DO 130 K = I + 1,M
+ TEMP = TEMP + A(K,I)*B(K,J)
+ 130 CONTINUE
+ ELSE
+ IF (NOUNIT) TEMP = TEMP*DCONJG(A(I,I))
+ DO 140 K = I + 1,M
+ TEMP = TEMP + DCONJG(A(K,I))*B(K,J)
+ 140 CONTINUE
+ END IF
+ B(I,J) = ALPHA*TEMP
+ 150 CONTINUE
+ 160 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IF (LSAME(TRANSA,'N')) THEN
+*
+* Form B := alpha*B*A.
+*
+ IF (UPPER) THEN
+ DO 200 J = N,1,-1
+ TEMP = ALPHA
+ IF (NOUNIT) TEMP = TEMP*A(J,J)
+ DO 170 I = 1,M
+ B(I,J) = TEMP*B(I,J)
+ 170 CONTINUE
+ DO 190 K = 1,J - 1
+ IF (A(K,J).NE.ZERO) THEN
+ TEMP = ALPHA*A(K,J)
+ DO 180 I = 1,M
+ B(I,J) = B(I,J) + TEMP*B(I,K)
+ 180 CONTINUE
+ END IF
+ 190 CONTINUE
+ 200 CONTINUE
+ ELSE
+ DO 240 J = 1,N
+ TEMP = ALPHA
+ IF (NOUNIT) TEMP = TEMP*A(J,J)
+ DO 210 I = 1,M
+ B(I,J) = TEMP*B(I,J)
+ 210 CONTINUE
+ DO 230 K = J + 1,N
+ IF (A(K,J).NE.ZERO) THEN
+ TEMP = ALPHA*A(K,J)
+ DO 220 I = 1,M
+ B(I,J) = B(I,J) + TEMP*B(I,K)
+ 220 CONTINUE
+ END IF
+ 230 CONTINUE
+ 240 CONTINUE
+ END IF
+ ELSE
+*
+* Form B := alpha*B*A**T or B := alpha*B*A**H.
+*
+ IF (UPPER) THEN
+ DO 280 K = 1,N
+ DO 260 J = 1,K - 1
+ IF (A(J,K).NE.ZERO) THEN
+ IF (NOCONJ) THEN
+ TEMP = ALPHA*A(J,K)
+ ELSE
+ TEMP = ALPHA*DCONJG(A(J,K))
+ END IF
+ DO 250 I = 1,M
+ B(I,J) = B(I,J) + TEMP*B(I,K)
+ 250 CONTINUE
+ END IF
+ 260 CONTINUE
+ TEMP = ALPHA
+ IF (NOUNIT) THEN
+ IF (NOCONJ) THEN
+ TEMP = TEMP*A(K,K)
+ ELSE
+ TEMP = TEMP*DCONJG(A(K,K))
+ END IF
+ END IF
+ IF (TEMP.NE.ONE) THEN
+ DO 270 I = 1,M
+ B(I,K) = TEMP*B(I,K)
+ 270 CONTINUE
+ END IF
+ 280 CONTINUE
+ ELSE
+ DO 320 K = N,1,-1
+ DO 300 J = K + 1,N
+ IF (A(J,K).NE.ZERO) THEN
+ IF (NOCONJ) THEN
+ TEMP = ALPHA*A(J,K)
+ ELSE
+ TEMP = ALPHA*DCONJG(A(J,K))
+ END IF
+ DO 290 I = 1,M
+ B(I,J) = B(I,J) + TEMP*B(I,K)
+ 290 CONTINUE
+ END IF
+ 300 CONTINUE
+ TEMP = ALPHA
+ IF (NOUNIT) THEN
+ IF (NOCONJ) THEN
+ TEMP = TEMP*A(K,K)
+ ELSE
+ TEMP = TEMP*DCONJG(A(K,K))
+ END IF
+ END IF
+ IF (TEMP.NE.ONE) THEN
+ DO 310 I = 1,M
+ B(I,K) = TEMP*B(I,K)
+ 310 CONTINUE
+ END IF
+ 320 CONTINUE
+ END IF
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of ZTRMM .
+*
+ END
diff --git a/lib/linalg/ztrmv.f b/lib/linalg/ztrmv.f
new file mode 100644
index 0000000000000000000000000000000000000000..8d7974a059112c0604fd63890060bf17a1ff446c
--- /dev/null
+++ b/lib/linalg/ztrmv.f
@@ -0,0 +1,373 @@
+*> \brief \b ZTRMV
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZTRMV(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
+*>
+*> ZTRMV performs one of the matrix-vector operations
+*>
+*> x := A*x, or x := A**T*x, or x := A**H*x,
+*>
+*> where x is an n element vector and A is an n by n unit, or non-unit,
+*> upper or lower triangular matrix.
+*> \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 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**H*x.
+*> \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] X
+*> \verbatim
+*> X is (input/output) 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. On exit, X is overwritten with the
+*> tranformed 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.
+*> 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 ZTRMV(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('ZTRMV ',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 := 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 or x := A**H*x.
+*
+ IF (LSAME(UPLO,'U')) THEN
+ IF (INCX.EQ.1) THEN
+ DO 110 J = N,1,-1
+ TEMP = X(J)
+ IF (NOCONJ) THEN
+ IF (NOUNIT) TEMP = TEMP*A(J,J)
+ DO 90 I = J - 1,1,-1
+ TEMP = TEMP + A(I,J)*X(I)
+ 90 CONTINUE
+ ELSE
+ IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
+ DO 100 I = J - 1,1,-1
+ TEMP = TEMP + DCONJG(A(I,J))*X(I)
+ 100 CONTINUE
+ END IF
+ X(J) = TEMP
+ 110 CONTINUE
+ ELSE
+ JX = KX + (N-1)*INCX
+ DO 140 J = N,1,-1
+ TEMP = X(JX)
+ IX = JX
+ IF (NOCONJ) THEN
+ IF (NOUNIT) TEMP = TEMP*A(J,J)
+ DO 120 I = J - 1,1,-1
+ IX = IX - INCX
+ TEMP = TEMP + A(I,J)*X(IX)
+ 120 CONTINUE
+ ELSE
+ IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
+ DO 130 I = J - 1,1,-1
+ IX = IX - INCX
+ TEMP = TEMP + DCONJG(A(I,J))*X(IX)
+ 130 CONTINUE
+ END IF
+ X(JX) = TEMP
+ JX = JX - INCX
+ 140 CONTINUE
+ END IF
+ ELSE
+ IF (INCX.EQ.1) THEN
+ DO 170 J = 1,N
+ TEMP = X(J)
+ IF (NOCONJ) THEN
+ IF (NOUNIT) TEMP = TEMP*A(J,J)
+ DO 150 I = J + 1,N
+ TEMP = TEMP + A(I,J)*X(I)
+ 150 CONTINUE
+ ELSE
+ IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
+ DO 160 I = J + 1,N
+ TEMP = TEMP + DCONJG(A(I,J))*X(I)
+ 160 CONTINUE
+ END IF
+ X(J) = TEMP
+ 170 CONTINUE
+ ELSE
+ JX = KX
+ DO 200 J = 1,N
+ TEMP = X(JX)
+ IX = JX
+ IF (NOCONJ) THEN
+ IF (NOUNIT) TEMP = TEMP*A(J,J)
+ DO 180 I = J + 1,N
+ IX = IX + INCX
+ TEMP = TEMP + A(I,J)*X(IX)
+ 180 CONTINUE
+ ELSE
+ IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
+ DO 190 I = J + 1,N
+ IX = IX + INCX
+ TEMP = TEMP + DCONJG(A(I,J))*X(IX)
+ 190 CONTINUE
+ END IF
+ X(JX) = TEMP
+ JX = JX + INCX
+ 200 CONTINUE
+ END IF
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of ZTRMV .
+*
+ END
diff --git a/lib/linalg/zung2l.f b/lib/linalg/zung2l.f
new file mode 100644
index 0000000000000000000000000000000000000000..f8fd3667d26cf7230a3402eafe3b4d6c2868ac7a
--- /dev/null
+++ b/lib/linalg/zung2l.f
@@ -0,0 +1,199 @@
+*> \brief \b ZUNG2L generates all or part of the unitary matrix Q from a QL factorization determined by cgeqlf (unblocked algorithm).
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZUNG2L + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zung2l.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zung2l.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zung2l.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZUNG2L( M, N, K, A, LDA, TAU, WORK, INFO )
+*
+* .. Scalar Arguments ..
+* INTEGER INFO, K, LDA, M, N
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZUNG2L generates an m by n complex matrix Q with orthonormal columns,
+*> which is defined as the last n columns of a product of k elementary
+*> reflectors of order m
+*>
+*> Q = H(k) . . . H(2) H(1)
+*>
+*> as returned by ZGEQLF.
+*> \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 COMPLEX*16 array, dimension (LDA,N)
+*> On entry, the (n-k+i)-th column must contain the vector which
+*> defines the elementary reflector H(i), for i = 1,2,...,k, as
+*> returned by ZGEQLF in the last 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 COMPLEX*16 array, dimension (K)
+*> TAU(i) must contain the scalar factor of the elementary
+*> reflector H(i), as returned by ZGEQLF.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 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 September 2012
+*
+*> \ingroup complex16OTHERcomputational
+*
+* =====================================================================
+ SUBROUTINE ZUNG2L( M, N, K, A, LDA, TAU, WORK, INFO )
+*
+* -- LAPACK computational routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, K, LDA, M, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ONE, ZERO
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
+ $ ZERO = ( 0.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER I, II, J, L
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZLARF, ZSCAL
+* ..
+* .. 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( 'ZUNG2L', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.LE.0 )
+ $ RETURN
+*
+* Initialise columns 1:n-k to columns of the unit matrix
+*
+ DO 20 J = 1, N - K
+ DO 10 L = 1, M
+ A( L, J ) = ZERO
+ 10 CONTINUE
+ A( M-N+J, J ) = ONE
+ 20 CONTINUE
+*
+ DO 40 I = 1, K
+ II = N - K + I
+*
+* Apply H(i) to A(1:m-k+i,1:n-k+i) from the left
+*
+ A( M-N+II, II ) = ONE
+ CALL ZLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), A,
+ $ LDA, WORK )
+ CALL ZSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 )
+ A( M-N+II, II ) = ONE - TAU( I )
+*
+* Set A(m-k+i+1:m,n-k+i) to zero
+*
+ DO 30 L = M - N + II + 1, M
+ A( L, II ) = ZERO
+ 30 CONTINUE
+ 40 CONTINUE
+ RETURN
+*
+* End of ZUNG2L
+*
+ END
diff --git a/lib/linalg/zung2r.f b/lib/linalg/zung2r.f
new file mode 100644
index 0000000000000000000000000000000000000000..63783ac01b65fabbe27433788720a21e1ec7bf9a
--- /dev/null
+++ b/lib/linalg/zung2r.f
@@ -0,0 +1,201 @@
+*> \brief \b ZUNG2R
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZUNG2R + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zung2r.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zung2r.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zung2r.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZUNG2R( M, N, K, A, LDA, TAU, WORK, INFO )
+*
+* .. Scalar Arguments ..
+* INTEGER INFO, K, LDA, M, N
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZUNG2R generates an m by n complex matrix Q with orthonormal columns,
+*> which is defined as the first n columns of a product of k elementary
+*> reflectors of order m
+*>
+*> Q = H(1) H(2) . . . H(k)
+*>
+*> as returned by ZGEQRF.
+*> \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 COMPLEX*16 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 ZGEQRF 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 COMPLEX*16 array, dimension (K)
+*> TAU(i) must contain the scalar factor of the elementary
+*> reflector H(i), as returned by ZGEQRF.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 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 complex16OTHERcomputational
+*
+* =====================================================================
+ SUBROUTINE ZUNG2R( 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 ..
+ COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. 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, L
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZLARF, ZSCAL
+* ..
+* .. 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( 'ZUNG2R', -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 ZLARF( '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 ZSCAL( 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 ZUNG2R
+*
+ END
diff --git a/lib/linalg/zungl2.f b/lib/linalg/zungl2.f
new file mode 100644
index 0000000000000000000000000000000000000000..44acba12a6e2885de1ae366063ec4174d1491301
--- /dev/null
+++ b/lib/linalg/zungl2.f
@@ -0,0 +1,207 @@
+*> \brief \b ZUNGL2 generates all or part of the unitary matrix Q from an LQ factorization determined by cgelqf (unblocked algorithm).
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZUNGL2 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zungl2.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zungl2.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zungl2.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZUNGL2( M, N, K, A, LDA, TAU, WORK, INFO )
+*
+* .. Scalar Arguments ..
+* INTEGER INFO, K, LDA, M, N
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZUNGL2 generates an m-by-n complex matrix Q with orthonormal rows,
+*> which is defined as the first m rows of a product of k elementary
+*> reflectors of order n
+*>
+*> Q = H(k)**H . . . H(2)**H H(1)**H
+*>
+*> as returned by ZGELQF.
+*> \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 COMPLEX*16 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 ZGELQF 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 COMPLEX*16 array, dimension (K)
+*> TAU(i) must contain the scalar factor of the elementary
+*> reflector H(i), as returned by ZGELQF.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 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 September 2012
+*
+*> \ingroup complex16OTHERcomputational
+*
+* =====================================================================
+ SUBROUTINE ZUNGL2( M, N, K, A, LDA, TAU, WORK, INFO )
+*
+* -- LAPACK computational routine (version 3.4.2) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* September 2012
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, K, LDA, M, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. 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, L
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZLACGV, ZLARF, ZSCAL
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG, 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( 'ZUNGL2', -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)**H to A(i:m,i:n) from the right
+*
+ IF( I.LT.N ) THEN
+ CALL ZLACGV( N-I, A( I, I+1 ), LDA )
+ IF( I.LT.M ) THEN
+ A( I, I ) = ONE
+ CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
+ $ DCONJG( TAU( I ) ), A( I+1, I ), LDA, WORK )
+ END IF
+ CALL ZSCAL( N-I, -TAU( I ), A( I, I+1 ), LDA )
+ CALL ZLACGV( N-I, A( I, I+1 ), LDA )
+ END IF
+ A( I, I ) = ONE - DCONJG( 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 ZUNGL2
+*
+ END
diff --git a/lib/linalg/zungql.f b/lib/linalg/zungql.f
new file mode 100644
index 0000000000000000000000000000000000000000..5c77abbd4621d85ac27c9bb672f2f298f720c140
--- /dev/null
+++ b/lib/linalg/zungql.f
@@ -0,0 +1,296 @@
+*> \brief \b ZUNGQL
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZUNGQL + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zungql.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zungql.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zungql.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZUNGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
+*
+* .. Scalar Arguments ..
+* INTEGER INFO, K, LDA, LWORK, M, N
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZUNGQL generates an M-by-N complex matrix Q with orthonormal columns,
+*> which is defined as the last N columns of a product of K elementary
+*> reflectors of order M
+*>
+*> Q = H(k) . . . H(2) H(1)
+*>
+*> as returned by ZGEQLF.
+*> \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 COMPLEX*16 array, dimension (LDA,N)
+*> On entry, the (n-k+i)-th column must contain the vector which
+*> defines the elementary reflector H(i), for i = 1,2,...,k, as
+*> returned by ZGEQLF in the last 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 COMPLEX*16 array, dimension (K)
+*> TAU(i) must contain the scalar factor of the elementary
+*> reflector H(i), as returned by ZGEQLF.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 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 complex16OTHERcomputational
+*
+* =====================================================================
+ SUBROUTINE ZUNGQL( 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 ..
+ COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ZERO
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ LOGICAL LQUERY
+ INTEGER I, IB, IINFO, IWS, J, KK, L, LDWORK, LWKOPT,
+ $ NB, NBMIN, NX
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZLARFB, ZLARFT, ZUNG2L
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. External Functions ..
+ INTEGER ILAENV
+ EXTERNAL ILAENV
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ 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
+ END IF
+*
+ IF( INFO.EQ.0 ) THEN
+ IF( N.EQ.0 ) THEN
+ LWKOPT = 1
+ ELSE
+ NB = ILAENV( 1, 'ZUNGQL', ' ', M, N, K, -1 )
+ LWKOPT = N*NB
+ END IF
+ WORK( 1 ) = LWKOPT
+*
+ IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
+ INFO = -8
+ END IF
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZUNGQL', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ 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, 'ZUNGQL', ' ', 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, 'ZUNGQL', ' ', 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 first block.
+* The last kk columns are handled by the block method.
+*
+ KK = MIN( K, ( ( K-NX+NB-1 ) / NB )*NB )
+*
+* Set A(m-kk+1:m,1:n-kk) to zero.
+*
+ DO 20 J = 1, N - KK
+ DO 10 I = M - KK + 1, M
+ A( I, J ) = ZERO
+ 10 CONTINUE
+ 20 CONTINUE
+ ELSE
+ KK = 0
+ END IF
+*
+* Use unblocked code for the first or only block.
+*
+ CALL ZUNG2L( M-KK, N-KK, K-KK, A, LDA, TAU, WORK, IINFO )
+*
+ IF( KK.GT.0 ) THEN
+*
+* Use blocked code
+*
+ DO 50 I = K - KK + 1, K, NB
+ IB = MIN( NB, K-I+1 )
+ IF( N-K+I.GT.1 ) THEN
+*
+* Form the triangular factor of the block reflector
+* H = H(i+ib-1) . . . H(i+1) H(i)
+*
+ CALL ZLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB,
+ $ A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK )
+*
+* Apply H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left
+*
+ CALL ZLARFB( 'Left', 'No transpose', 'Backward',
+ $ 'Columnwise', M-K+I+IB-1, N-K+I-1, IB,
+ $ A( 1, N-K+I ), LDA, WORK, LDWORK, A, LDA,
+ $ WORK( IB+1 ), LDWORK )
+ END IF
+*
+* Apply H to rows 1:m-k+i+ib-1 of current block
+*
+ CALL ZUNG2L( M-K+I+IB-1, IB, IB, A( 1, N-K+I ), LDA,
+ $ TAU( I ), WORK, IINFO )
+*
+* Set rows m-k+i+ib:m of current block to zero
+*
+ DO 40 J = N - K + I, N - K + I + IB - 1
+ DO 30 L = M - K + I + IB, M
+ A( L, J ) = ZERO
+ 30 CONTINUE
+ 40 CONTINUE
+ 50 CONTINUE
+ END IF
+*
+ WORK( 1 ) = IWS
+ RETURN
+*
+* End of ZUNGQL
+*
+ END
diff --git a/lib/linalg/zungqr.f b/lib/linalg/zungqr.f
new file mode 100644
index 0000000000000000000000000000000000000000..6b3e9220cd41560a85637d0cbceedf4a77a4f8f2
--- /dev/null
+++ b/lib/linalg/zungqr.f
@@ -0,0 +1,290 @@
+*> \brief \b ZUNGQR
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZUNGQR + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zungqr.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zungqr.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zungqr.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZUNGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
+*
+* .. Scalar Arguments ..
+* INTEGER INFO, K, LDA, LWORK, M, N
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZUNGQR generates an M-by-N complex matrix Q with orthonormal columns,
+*> which is defined as the first N columns of a product of K elementary
+*> reflectors of order M
+*>
+*> Q = H(1) H(2) . . . H(k)
+*>
+*> as returned by ZGEQRF.
+*> \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 COMPLEX*16 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 ZGEQRF 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 COMPLEX*16 array, dimension (K)
+*> TAU(i) must contain the scalar factor of the elementary
+*> reflector H(i), as returned by ZGEQRF.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 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 complex16OTHERcomputational
+*
+* =====================================================================
+ SUBROUTINE ZUNGQR( 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 ..
+ COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ZERO
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ LOGICAL LQUERY
+ INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
+ $ LWKOPT, NB, NBMIN, NX
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZLARFB, ZLARFT, ZUNG2R
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. External Functions ..
+ INTEGER ILAENV
+ EXTERNAL ILAENV
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ NB = ILAENV( 1, 'ZUNGQR', ' ', 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( 'ZUNGQR', -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, 'ZUNGQR', ' ', 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, 'ZUNGQR', ' ', 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 ZUNG2R( 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 ZLARFT( '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 ZLARFB( '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 ZUNG2R( 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 ZUNGQR
+*
+ END
diff --git a/lib/linalg/zungtr.f b/lib/linalg/zungtr.f
new file mode 100644
index 0000000000000000000000000000000000000000..422a55a921ffd166a06c76cd8f37d3da5420feb5
--- /dev/null
+++ b/lib/linalg/zungtr.f
@@ -0,0 +1,256 @@
+*> \brief \b ZUNGTR
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZUNGTR + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zungtr.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zungtr.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zungtr.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZUNGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER INFO, LDA, LWORK, N
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZUNGTR generates a complex unitary matrix Q which is defined as the
+*> product of n-1 elementary reflectors of order N, as returned by
+*> ZHETRD:
+*>
+*> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
+*>
+*> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A contains elementary reflectors
+*> from ZHETRD;
+*> = 'L': Lower triangle of A contains elementary reflectors
+*> from ZHETRD.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix Q. N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N)
+*> On entry, the vectors which define the elementary reflectors,
+*> as returned by ZHETRD.
+*> On exit, the N-by-N unitary matrix Q.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= N.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*> TAU is COMPLEX*16 array, dimension (N-1)
+*> TAU(i) must contain the scalar factor of the elementary
+*> reflector H(i), as returned by ZHETRD.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 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 >= N-1.
+*> For optimum performance LWORK >= (N-1)*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 complex16OTHERcomputational
+*
+* =====================================================================
+ SUBROUTINE ZUNGTR( UPLO, 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 ..
+ CHARACTER UPLO
+ INTEGER INFO, LDA, LWORK, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ZERO, ONE
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
+ $ ONE = ( 1.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ LOGICAL LQUERY, UPPER
+ INTEGER I, IINFO, J, LWKOPT, NB
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ EXTERNAL LSAME, ILAENV
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZUNGQL, ZUNGQR
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ LQUERY = ( LWORK.EQ.-1 )
+ UPPER = LSAME( UPLO, 'U' )
+ IF( .NOT.UPPER .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 = -4
+ ELSE IF( LWORK.LT.MAX( 1, N-1 ) .AND. .NOT.LQUERY ) THEN
+ INFO = -7
+ END IF
+*
+ IF( INFO.EQ.0 ) THEN
+ IF( UPPER ) THEN
+ NB = ILAENV( 1, 'ZUNGQL', ' ', N-1, N-1, N-1, -1 )
+ ELSE
+ NB = ILAENV( 1, 'ZUNGQR', ' ', N-1, N-1, N-1, -1 )
+ END IF
+ LWKOPT = MAX( 1, N-1 )*NB
+ WORK( 1 ) = LWKOPT
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZUNGTR', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 ) THEN
+ WORK( 1 ) = 1
+ RETURN
+ END IF
+*
+ IF( UPPER ) THEN
+*
+* Q was determined by a call to ZHETRD with UPLO = 'U'
+*
+* Shift the vectors which define the elementary reflectors one
+* column to the left, and set the last row and column of Q to
+* those of the unit matrix
+*
+ DO 20 J = 1, N - 1
+ DO 10 I = 1, J - 1
+ A( I, J ) = A( I, J+1 )
+ 10 CONTINUE
+ A( N, J ) = ZERO
+ 20 CONTINUE
+ DO 30 I = 1, N - 1
+ A( I, N ) = ZERO
+ 30 CONTINUE
+ A( N, N ) = ONE
+*
+* Generate Q(1:n-1,1:n-1)
+*
+ CALL ZUNGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, IINFO )
+*
+ ELSE
+*
+* Q was determined by a call to ZHETRD with UPLO = 'L'.
+*
+* 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 50 J = N, 2, -1
+ A( 1, J ) = ZERO
+ DO 40 I = J + 1, N
+ A( I, J ) = A( I, J-1 )
+ 40 CONTINUE
+ 50 CONTINUE
+ A( 1, 1 ) = ONE
+ DO 60 I = 2, N
+ A( I, 1 ) = ZERO
+ 60 CONTINUE
+ IF( N.GT.1 ) THEN
+*
+* Generate Q(2:n,2:n)
+*
+ CALL ZUNGQR( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
+ $ LWORK, IINFO )
+ END IF
+ END IF
+ WORK( 1 ) = LWKOPT
+ RETURN
+*
+* End of ZUNGTR
+*
+ END