--- /dev/null
- *
+*> \brief \b CHETRS_AA
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHETRS_AA + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetrs_aa.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetrs_aa.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetrs_aa.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
+* WORK, LWORK, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, NRHS, LDA, LDB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * )
+* COMPLEX A( LDA, * ), B( LDB, * ), WORK( * )
+* ..
++*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CHETRS_AA solves a system of linear equations A*X = B with a real
+*> hermitian matrix A using the factorization A = U*T*U**T or
+*> A = L*T*L**T computed by CHETRF_AA.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> Specifies whether the details of the factorization are stored
+*> as an upper or lower triangular matrix.
+*> = 'U': Upper triangular, form is A = U*T*U**T;
+*> = 'L': Lower triangular, form is A = L*T*L**T.
+*> \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,out] A
+*> \verbatim
+*> A is COMPLEX array, dimension (LDA,N)
+*> Details of factors computed by CHETRF_AA.
+*> \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)
+*> Details of the interchanges as computed by CHETRF_AA.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*> B is COMPLEX 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[in] WORK
+*> \verbatim
+*> WORK is DOUBLE array, dimension (MAX(1,LWORK))
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER, LWORK >= 3*N-2.
+*>
+*> \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 2016
+*
+*> \ingroup complexHEcomputational
+*
+* =====================================================================
+ SUBROUTINE CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
+ $ WORK, LWORK, INFO )
+*
+* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2016
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, NRHS, LDA, LDB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * )
+ COMPLEX A( LDA, * ), B( LDB, * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+ COMPLEX ONE
+ PARAMETER ( ONE = 1.0E+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LQUERY, UPPER
+ INTEGER K, KP, LWKOPT
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL CGTSV, CSWAP, CTRSM, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+ 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( 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
+ ELSE IF( LWORK.LT.(3*N-2) .AND. .NOT.LQUERY ) THEN
+ INFO = -10
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'CHETRS_AA', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ LWKOPT = (3*N-2)
+ WORK( 1 ) = LWKOPT
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 .OR. NRHS.EQ.0 )
+ $ RETURN
+*
+ IF( UPPER ) THEN
+*
+* Solve A*X = B, where A = U*T*U**T.
+*
+* P**T * B
+*
+ K = 1
+ DO WHILE ( K.LE.N )
+ KP = IPIV( K )
+ IF( KP.NE.K )
+ $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+ K = K + 1
+ END DO
+*
+* Compute (U \P**T * B) -> B [ (U \P**T * B) ]
+*
+ CALL CTRSM('L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
+ $ B( 2, 1 ), LDB)
+*
+* Compute T \ B -> B [ T \ (U \P**T * B) ]
+*
+ CALL CLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)
+ IF( N.GT.1 ) THEN
+ CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1)
+ CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1)
+ CALL CLACGV( N-1, WORK( 1 ), 1 )
+ END IF
+ CALL CGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
+ $ INFO)
+*
+* Compute (U**T \ B) -> B [ U**T \ (T \ (U \P**T * B) ) ]
+*
+ CALL CTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
+ $ B(2, 1), LDB)
+*
+* Pivot, P * B [ P * (U**T \ (T \ (U \P**T * B) )) ]
+*
+ K = N
+ DO WHILE ( K.GE.1 )
+ KP = IPIV( K )
+ IF( KP.NE.K )
+ $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+ K = K - 1
+ END DO
+*
+ ELSE
+*
+* Solve A*X = B, where A = L*T*L**T.
+*
+* Pivot, P**T * B
+*
+ K = 1
+ DO WHILE ( K.LE.N )
+ KP = IPIV( K )
+ IF( KP.NE.K )
+ $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+ K = K + 1
+ END DO
+*
+* Compute (L \P**T * B) -> B [ (L \P**T * B) ]
+*
+ CALL CTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1), LDA,
+ $ B(2, 1), LDB)
+*
+* Compute T \ B -> B [ T \ (L \P**T * B) ]
+*
+ CALL CLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)
+ IF( N.GT.1 ) THEN
+ CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1)
+ CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1)
+ CALL CLACGV( N-1, WORK( 2*N ), 1 )
+ END IF
+ CALL CGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
+ $ INFO)
+*
+* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ]
+*
+ CALL CTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,
+ $ B( 2, 1 ), LDB)
+*
+* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ]
+*
+ K = N
+ DO WHILE ( K.GE.1 )
+ KP = IPIV( K )
+ IF( KP.NE.K )
+ $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+ K = K - 1
+ END DO
+*
+ END IF
+*
+ RETURN
+*
+* End of CHETRS_AA
+*
+ END
--- /dev/null
--- /dev/null
++*> \brief \b CHETRS_AASEN
++*
++* =========== DOCUMENTATION ===========
++*
++* Online html documentation available at
++* http://www.netlib.org/lapack/explore-html/
++*
++*> \htmlonly
++*> Download CHETRS_AASEN + dependencies
++*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetrs_aasen.f">
++*> [TGZ]</a>
++*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetrs_aasen.f">
++*> [ZIP]</a>
++*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetrs_aasen.f">
++*> [TXT]</a>
++*> \endhtmlonly
++*
++* Definition:
++* ===========
++*
++* SUBROUTINE CHETRS_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
++* WORK, LWORK, INFO )
++*
++* .. Scalar Arguments ..
++* CHARACTER UPLO
++* INTEGER N, NRHS, LDA, LDB, LWORK, INFO
++* ..
++* .. Array Arguments ..
++* INTEGER IPIV( * )
++* COMPLEX A( LDA, * ), B( LDB, * ), WORK( * )
++* ..
++*
++*
++*> \par Purpose:
++* =============
++*>
++*> \verbatim
++*>
++*> CHETRS_AASEN solves a system of linear equations A*X = B with a real
++*> hermitian matrix A using the factorization A = U*T*U**T or
++*> A = L*T*L**T computed by CHETRF_AASEN.
++*> \endverbatim
++*
++* Arguments:
++* ==========
++*
++*> \param[in] UPLO
++*> \verbatim
++*> UPLO is CHARACTER*1
++*> Specifies whether the details of the factorization are stored
++*> as an upper or lower triangular matrix.
++*> = 'U': Upper triangular, form is A = U*T*U**T;
++*> = 'L': Lower triangular, form is A = L*T*L**T.
++*> \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,out] A
++*> \verbatim
++*> A is COMPLEX array, dimension (LDA,N)
++*> Details of factors computed by CHETRF_AASEN.
++*> \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)
++*> Details of the interchanges as computed by CHETRF_AASEN.
++*> \endverbatim
++*>
++*> \param[in,out] B
++*> \verbatim
++*> B is COMPLEX 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[in] WORK
++*> \verbatim
++*> WORK is DOUBLE array, dimension (MAX(1,LWORK))
++*> \endverbatim
++*>
++*> \param[in] LWORK
++*> \verbatim
++*> LWORK is INTEGER, LWORK >= 3*N-2.
++*>
++*> \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 2016
++*
++*> \ingroup complexSYcomputational
++*
++* @generated from zhetrs_aasen.f, fortran z -> c, Fri Sep 23 00:09:52 2016
++*
++* =====================================================================
++ SUBROUTINE CHETRS_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
++ $ 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 2016
++*
++ IMPLICIT NONE
++*
++* .. Scalar Arguments ..
++ CHARACTER UPLO
++ INTEGER N, NRHS, LDA, LDB, LWORK, INFO
++* ..
++* .. Array Arguments ..
++ INTEGER IPIV( * )
++ COMPLEX A( LDA, * ), B( LDB, * ), WORK( * )
++* ..
++*
++* =====================================================================
++*
++ COMPLEX ONE
++ PARAMETER ( ONE = 1.0E+0 )
++* ..
++* .. Local Scalars ..
++ LOGICAL UPPER
++ INTEGER K, KP
++* ..
++* .. External Functions ..
++ LOGICAL LSAME
++ EXTERNAL LSAME
++* ..
++* .. External Subroutines ..
++ EXTERNAL CGTSV, CSWAP, CTRSM, XERBLA
++* ..
++* .. Intrinsic Functions ..
++ INTRINSIC MAX
++* ..
++* .. Executable Statements ..
++*
++ 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( 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
++ ELSE IF( LWORK.LT.(3*N-2) ) THEN
++ INFO = -10
++ END IF
++ IF( INFO.NE.0 ) THEN
++ CALL XERBLA( 'CHETRS_AASEN', -INFO )
++ RETURN
++ END IF
++*
++* Quick return if possible
++*
++ IF( N.EQ.0 .OR. NRHS.EQ.0 )
++ $ RETURN
++*
++ IF( UPPER ) THEN
++*
++* Solve A*X = B, where A = U*T*U**T.
++*
++* P**T * B
++*
++ K = 1
++ DO WHILE ( K.LE.N )
++ KP = IPIV( K )
++ IF( KP.NE.K )
++ $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
++ K = K + 1
++ END DO
++*
++* Compute (U \P**T * B) -> B [ (U \P**T * B) ]
++*
++ CALL CTRSM('L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
++ $ B( 2, 1 ), LDB)
++*
++* Compute T \ B -> B [ T \ (U \P**T * B) ]
++*
++ CALL CLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)
++ IF( N.GT.1 ) THEN
++ CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1)
++ CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1)
++ CALL CLACGV( N-1, WORK( 1 ), 1 )
++ END IF
++ CALL CGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
++ $ INFO)
++*
++* Compute (U**T \ B) -> B [ U**T \ (T \ (U \P**T * B) ) ]
++*
++ CALL CTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
++ $ B(2, 1), LDB)
++*
++* Pivot, P * B [ P * (U**T \ (T \ (U \P**T * B) )) ]
++*
++ K = N
++ DO WHILE ( K.GE.1 )
++ KP = IPIV( K )
++ IF( KP.NE.K )
++ $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
++ K = K - 1
++ END DO
++*
++ ELSE
++*
++* Solve A*X = B, where A = L*T*L**T.
++*
++* Pivot, P**T * B
++*
++ K = 1
++ DO WHILE ( K.LE.N )
++ KP = IPIV( K )
++ IF( KP.NE.K )
++ $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
++ K = K + 1
++ END DO
++*
++* Compute (L \P**T * B) -> B [ (L \P**T * B) ]
++*
++ CALL CTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1), LDA,
++ $ B(2, 1), LDB)
++*
++* Compute T \ B -> B [ T \ (L \P**T * B) ]
++*
++ CALL CLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)
++ IF( N.GT.1 ) THEN
++ CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1)
++ CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1)
++ CALL CLACGV( N-1, WORK( 2*N ), 1 )
++ END IF
++ CALL CGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
++ $ INFO)
++*
++* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ]
++*
++ CALL CTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,
++ $ B( 2, 1 ), LDB)
++*
++* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ]
++*
++ K = N
++ DO WHILE ( K.GE.1 )
++ KP = IPIV( K )
++ IF( KP.NE.K )
++ $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
++ K = K - 1
++ END DO
++*
++ END IF
++*
++ RETURN
++*
++* End of CHETRS_AASEN
++*
++ END
END IF
CALL SGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
$ INFO)
- *
-*
++*
*
* Compute (U**T \ B) -> B [ U**T \ (T \ (U \P**T * B) ) ]
*
--- /dev/null
- *
+*> \brief \b ZHETRS_AA
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHETRS_AA + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrs_aa.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetrs_aa.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrs_aa.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
+* WORK, LWORK, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, NRHS, LDA, LDB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * )
+* COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
+* ..
- *
++*
++*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZHETRS_AA solves a system of linear equations A*X = B with a real
+*> hermitian matrix A using the factorization A = U*T*U**T or
+*> A = L*T*L**T computed by ZHETRF_AA.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> Specifies whether the details of the factorization are stored
+*> as an upper or lower triangular matrix.
+*> = 'U': Upper triangular, form is A = U*T*U**T;
+*> = 'L': Lower triangular, form is A = L*T*L**T.
+*> \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,out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N)
+*> Details of factors computed by ZHETRF_AA.
+*> \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)
+*> Details of the interchanges as computed by ZHETRF_AA.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*> B is COMPLEX*16 array, dimension (LDB,NRHS)
+*> On entry, the right hand side matrix B.
+*> On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*> LDB is INTEGER
+*> The leading dimension of the array B. LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] WORK
+*> \verbatim
+*> WORK is DOUBLE array, dimension (MAX(1,LWORK))
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER, LWORK >= 3*N-2.
+*>
+*> \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 2016
+*
+*> \ingroup complex16HEcomputational
+*
+* =====================================================================
+ SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
+ $ WORK, LWORK, INFO )
+*
+* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2016
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, NRHS, LDA, LDB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * )
+ COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+ COMPLEX*16 ONE
+ PARAMETER ( ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LQUERY, UPPER
+ INTEGER K, KP, LWKOPT
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZGTSV, ZSWAP, ZTRSM, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+ 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( 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
+ ELSE IF( LWORK.LT.(3*N-2) .AND. .NOT.LQUERY ) THEN
+ INFO = -10
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZHETRS_AA', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ LWKOPT = (3*N-2)
+ WORK( 1 ) = LWKOPT
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 .OR. NRHS.EQ.0 )
+ $ RETURN
+*
+ IF( UPPER ) THEN
+*
+* Solve A*X = B, where A = U*T*U**T.
+*
+* Pivot, P**T * B
+*
+ DO K = 1, N
+ KP = IPIV( K )
+ IF( KP.NE.K )
+ $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+ END DO
+*
+* Compute (U \P**T * B) -> B [ (U \P**T * B) ]
+*
+ CALL ZTRSM('L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
+ $ B( 2, 1 ), LDB)
+*
+* Compute T \ B -> B [ T \ (U \P**T * B) ]
- *
++*
+ CALL ZLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)
+ IF( N.GT.1 ) THEN
+ CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1)
+ CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1)
+ CALL ZLACGV( N-1, WORK( 1 ), 1 )
+ END IF
+ CALL ZGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
+ $ INFO)
- *
++*
+* Compute (U**T \ B) -> B [ U**T \ (T \ (U \P**T * B) ) ]
+*
+ CALL ZTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
+ $ B(2, 1), LDB)
+*
+* Pivot, P * B [ P * (U**T \ (T \ (U \P**T * B) )) ]
+*
+ DO K = N, 1, -1
+ KP = IPIV( K )
+ IF( KP.NE.K )
+ $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+ END DO
+*
+ ELSE
+*
+* Solve A*X = B, where A = L*T*L**T.
+*
+* Pivot, P**T * B
+*
+ DO K = 1, N
+ KP = IPIV( K )
+ IF( KP.NE.K )
+ $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+ END DO
+*
+* Compute (L \P**T * B) -> B [ (L \P**T * B) ]
+*
+ CALL ZTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,
+ $ B(2, 1), LDB)
+*
+* Compute T \ B -> B [ T \ (L \P**T * B) ]
+*
+ CALL ZLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)
+ IF( N.GT.1 ) THEN
+ CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1)
+ CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1)
+ CALL ZLACGV( N-1, WORK( 2*N ), 1 )
+ END IF
+ CALL ZGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
+ $ INFO)
++*
+* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ]
+*
+ CALL ZTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,
+ $ B( 2, 1 ), LDB)
+*
+* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ]
+*
+ DO K = N, 1, -1
+ KP = IPIV( K )
+ IF( KP.NE.K )
+ $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+ END DO
+*
+ END IF
+*
+ RETURN
+*
+* End of ZHETRS_AA
+*
+ END
K = 0
END IF
*
-* Check error code from CHESV_AASEN .
+* Check error code from CHESV_AA .
- *
+ *
IF( INFO.NE.K ) THEN
- CALL ALAERH( PATH, 'CHESV_AA', INFO, K,
- $ UPLO, N, N, -1, -1, NRHS,
- CALL ALAERH( PATH, 'CHESV_AASEN', INFO, K,
++ CALL ALAERH( PATH, 'CHESV_AA', INFO, K,
+ $ UPLO, N, N, -1, -1, NRHS,
$ IMAT, NFAIL, NERRS, NOUT )
GO TO 120
ELSE IF( INFO.NE.0 ) THEN
* Reconstruct matrix from factors and compute
* residual.
*
- CALL CHET01_AASEN( UPLO, N, A, LDA, AFAC, LDA,
+ CALL CHET01_AA( UPLO, N, A, LDA, AFAC, LDA,
- $ IWORK, AINV, LDA, RWORK,
+ $ IWORK, AINV, LDA, RWORK,
$ RESULT( 1 ) )
*
* Compute residual of the computed solution.
* Definition:
* ===========
*
- * SUBROUTINE CHET01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV,
-* SUBROUTINE CHET01_AASEN( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV,
++* SUBROUTINE CHET01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV,
* C, LDC, RWORK, RESID )
*
* .. Scalar Arguments ..
CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
*
IF( TSTCHK ) THEN
- CALL DCHKSY_AA( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS,
- CALL DCHKSY_AASEN( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS,
++ CALL DCHKSY_AA( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS,
$ NSVAL, THRESH, TSTERR, LDA,
- $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
$ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
$ WORK, RWORK, IWORK, NOUT )
ELSE
* the block structure of D. AINV is a work array for
* block factorization, LWORK is the length of AINV.
*
- SRNAMT = 'DSYTRF_AASEN'
+ SRNAMT = 'DSYTRF_AA'
LWORK = N*NB + N
- CALL DSYTRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV,
- CALL DSYTRF_AASEN( UPLO, N, AFAC, LDA, IWORK, AINV,
++ CALL DSYTRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV,
$ LWORK, INFO )
*
* Adjust the expected value of INFO to account for
* Check error code from DSYTRF and handle error.
*
IF( INFO.NE.K ) THEN
- CALL ALAERH( PATH, 'DSYTRF_AA', INFO, K, UPLO,
- $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS,
- CALL ALAERH( PATH, 'DSYTRF_AASEN', INFO, K, UPLO,
++ CALL ALAERH( PATH, 'DSYTRF_AA', INFO, K, UPLO,
+ $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS,
$ NOUT )
END IF
*
$ B, LDA, ISEED, INFO )
CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
*
- SRNAMT = 'DSYTRS_AASEN'
+ SRNAMT = 'DSYTRS_AA'
LWORK = 3*N-2
- CALL DSYTRS_AA( UPLO, N, NRHS, AFAC, LDA,
- CALL DSYTRS_AASEN( UPLO, N, NRHS, AFAC, LDA,
++ CALL DSYTRS_AA( UPLO, N, NRHS, AFAC, LDA,
$ IWORK, X, LDA, WORK, LWORK,
$ INFO )
*
* Reconstruct matrix from factors and compute
* residual.
*
- CALL DSYT01_AASEN( UPLO, N, A, LDA, AFAC, LDA,
+ CALL DSYT01_AA( UPLO, N, A, LDA, AFAC, LDA,
- $ IWORK, AINV, LDA, RWORK,
+ $ IWORK, AINV, LDA, RWORK,
$ RESULT( 1 ) )
*
* Compute residual of the computed solution.
* the block structure of D. AINV is a work array for
* block factorization, LWORK is the length of AINV.
*
- SRNAMT = 'SSYTRF_AASEN'
+ SRNAMT = 'SSYTRF_AA'
LWORK = N*NB + N
- CALL SSYTRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV,
- CALL SSYTRF_AASEN( UPLO, N, AFAC, LDA, IWORK, AINV,
++ CALL SSYTRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV,
$ LWORK, INFO )
*
* Adjust the expected value of INFO to account for
* Check error code from SSYTRF and handle error.
*
IF( INFO.NE.K ) THEN
- CALL ALAERH( PATH, 'SSYTRF_AA', INFO, K, UPLO,
- $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS,
- CALL ALAERH( PATH, 'SSYTRF_AASEN', INFO, K, UPLO,
++ CALL ALAERH( PATH, 'SSYTRF_AA', INFO, K, UPLO,
+ $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS,
$ NOUT )
END IF
*
$ B, LDA, ISEED, INFO )
CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
*
- SRNAMT = 'SSYTRS_AASEN'
+ SRNAMT = 'SSYTRS_AA'
LWORK = 3*N-2
- CALL SSYTRS_AA( UPLO, N, NRHS, AFAC, LDA,
- CALL SSYTRS_AASEN( UPLO, N, NRHS, AFAC, LDA,
++ CALL SSYTRS_AA( UPLO, N, NRHS, AFAC, LDA,
$ IWORK, X, LDA, WORK, LWORK,
$ INFO )
*
* Check error code from SSYTRS and handle error.
*
IF( INFO.NE.0 ) THEN
- CALL ALAERH( PATH, 'SSYTRS_AASEN', INFO, 0,
+ CALL ALAERH( PATH, 'SSYTRS_AA', INFO, 0,
- $ UPLO, N, N, -1, -1, NRHS, IMAT,
+ $ UPLO, N, N, -1, -1, NRHS, IMAT,
$ NFAIL, NERRS, NOUT )
END IF
*
K = 0
END IF
*
-* Check error code from SSYSV_AASEN .
+* Check error code from SSYSV_AA .
*
IF( INFO.NE.K ) THEN
- CALL ALAERH( PATH, 'SSYSV_AA ', INFO, K,
- $ UPLO, N, N, -1, -1, NRHS,
- CALL ALAERH( PATH, 'SSYSV_AASEN ', INFO, K,
++ CALL ALAERH( PATH, 'SSYSV_AA ', INFO, K,
+ $ UPLO, N, N, -1, -1, NRHS,
$ IMAT, NFAIL, NERRS, NOUT )
GO TO 120
ELSE IF( INFO.NE.0 ) THEN
* Reconstruct matrix from factors and compute
* residual.
*
- CALL SSYT01_AASEN( UPLO, N, A, LDA, AFAC, LDA,
+ CALL SSYT01_AA( UPLO, N, A, LDA, AFAC, LDA,
- $ IWORK, AINV, LDA, RWORK,
+ $ IWORK, AINV, LDA, RWORK,
$ RESULT( 1 ) )
*
* Compute residual of the computed solution.
CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
*
IF( TSTCHK ) THEN
- CALL ZCHKHE_AASEN( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS,
+ CALL ZCHKHE_AA( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS,
- $ NSVAL, THRESH, TSTERR, LDA,
+ $ NSVAL, THRESH, TSTERR, LDA,
$ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
$ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
$ WORK, RWORK, IWORK, NOUT )
END IF
*
IF( TSTDRV ) THEN
- CALL ZDRVHE_AASEN( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ CALL ZDRVHE_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
- $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
- $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+ $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
$ WORK, RWORK, IWORK, NOUT )
ELSE
WRITE( NOUT, FMT = 9988 )PATH
* ..
* .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRHE, ZGET04,
- $ ZHECON, ZHERFS, ZHET01, ZHETRF_AASEN, ZHETRI2,
- $ ZHETRS_AASEN, ZLACPY, ZLAIPD, ZLARHS, ZLATB4,
+ $ ZHECON, ZHERFS, ZHET01, ZHETRF_AA, ZHETRI2,
- $ ZHETRS_AA, ZLACPY, ZLAIPD, ZLARHS, ZLATB4,
++ $ ZHETRS_AA, ZLACPY, ZLAIPD, ZLARHS, ZLATB4,
$ ZLATMS, ZPOT02, ZPOT03, ZPOT05
* ..
* .. Intrinsic Functions ..
* block factorization, LWORK is the length of AINV.
*
LWORK = ( NB+1 )*LDA
- SRNAMT = 'ZHETRF_AASEN'
- CALL ZHETRF_AASEN( UPLO, N, AFAC, LDA, IWORK, AINV,
+ SRNAMT = 'ZHETRF_AA'
- CALL ZHETRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV,
++ CALL ZHETRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV,
$ LWORK, INFO )
*
* Adjust the expected value of INFO to account for
* Check error code from ZHETRF and handle error.
*
IF( INFO.NE.K ) THEN
- CALL ALAERH( PATH, 'ZHETRF_AA', INFO, K, UPLO,
- $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS,
- CALL ALAERH( PATH, 'ZHETRF_AASEN', INFO, K, UPLO,
++ CALL ALAERH( PATH, 'ZHETRF_AA', INFO, K, UPLO,
+ $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS,
$ NOUT )
END IF
*
*> \ingroup complex16_lin
*
* =====================================================================
- SUBROUTINE ZDRVHE_AASEN( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ SUBROUTINE ZDRVHE_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
- $ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
+ $ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
$ RWORK, IWORK, NOUT )
*
* -- LAPACK test routine (version 3.7.0) --
* ..
* .. External Subroutines ..
EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04,
- $ ZHESV_AA, ZHET01_AA, ZHETRF_AA,
- $ ZHESV_AASEN, ZHET01_AASEN, ZHETRF_AASEN,
++ $ ZHESV_AA, ZHET01_AA, ZHETRF_AA,
$ ZHETRI2, ZLACPY, ZLAIPD, ZLARHS, ZLATB4, ZLATMS,
$ ZPOT02
* ..
* Reconstruct matrix from factors and compute
* residual.
*
- CALL ZHET01_AASEN( UPLO, N, A, LDA, AFAC, LDA,
+ CALL ZHET01_AA( UPLO, N, A, LDA, AFAC, LDA,
- $ IWORK, AINV, LDA, RWORK,
+ $ IWORK, AINV, LDA, RWORK,
$ RESULT( 1 ) )
*
* Compute residual of the computed solution.
projects / platform / upstream / lapack.git / commitdiff