version 1.1, 2018/05/29 14:49:25
|
version 1.3, 2023/08/07 08:39:11
|
Line 38
|
Line 38
|
*> DSYTRF_AA_2STAGE computes the factorization of a real symmetric matrix A |
*> DSYTRF_AA_2STAGE computes the factorization of a real symmetric matrix A |
*> using the Aasen's algorithm. The form of the factorization is |
*> using the Aasen's algorithm. The form of the factorization is |
*> |
*> |
*> A = U*T*U**T or A = L*T*L**T |
*> A = U**T*T*U or A = L*T*L**T |
*> |
*> |
*> where U (or L) is a product of permutation and unit upper (lower) |
*> where U (or L) is a product of permutation and unit upper (lower) |
*> triangular matrices, and T is a symmetric band matrix with the |
*> triangular matrices, and T is a symmetric band matrix with the |
Line 93
|
Line 93
|
*> |
*> |
*> \param[in] LTB |
*> \param[in] LTB |
*> \verbatim |
*> \verbatim |
|
*> LTB is INTEGER |
*> The size of the array TB. LTB >= 4*N, internally |
*> The size of the array TB. LTB >= 4*N, internally |
*> used to select NB such that LTB >= (3*NB+1)*N. |
*> used to select NB such that LTB >= (3*NB+1)*N. |
*> |
*> |
Line 102
|
Line 103
|
*> no error message related to LTB is issued by XERBLA. |
*> no error message related to LTB is issued by XERBLA. |
*> \endverbatim |
*> \endverbatim |
*> |
*> |
|
*> \param[out] IPIV |
|
*> \verbatim |
|
*> IPIV is INTEGER array, dimension (N) |
|
*> On exit, it contains the details of the interchanges, i.e., |
|
*> the row and column k of A were interchanged with the |
|
*> row and column IPIV(k). |
|
*> \endverbatim |
|
*> |
|
*> \param[out] IPIV2 |
|
*> \verbatim |
|
*> IPIV2 is INTEGER array, dimension (N) |
|
*> On exit, it contains the details of the interchanges, i.e., |
|
*> the row and column k of T were interchanged with the |
|
*> row and column IPIV2(k). |
|
*> \endverbatim |
|
*> |
*> \param[out] WORK |
*> \param[out] WORK |
*> \verbatim |
*> \verbatim |
*> WORK is DOUBLE PRECISION workspace of size LWORK |
*> WORK is DOUBLE PRECISION workspace of size LWORK |
Line 109
|
Line 126
|
*> |
*> |
*> \param[in] LWORK |
*> \param[in] LWORK |
*> \verbatim |
*> \verbatim |
|
*> LWORK is INTEGER |
*> The size of WORK. LWORK >= N, internally used to select NB |
*> The size of WORK. LWORK >= N, internally used to select NB |
*> such that LWORK >= N*NB. |
*> such that LWORK >= N*NB. |
*> |
*> |
Line 118
|
Line 136
|
*> no error message related to LWORK is issued by XERBLA. |
*> no error message related to LWORK is issued by XERBLA. |
*> \endverbatim |
*> \endverbatim |
*> |
*> |
*> \param[out] IPIV |
|
*> \verbatim |
|
*> IPIV is INTEGER array, dimension (N) |
|
*> On exit, it contains the details of the interchanges, i.e., |
|
*> the row and column k of A were interchanged with the |
|
*> row and column IPIV(k). |
|
*> \endverbatim |
|
*> |
|
*> \param[out] IPIV2 |
|
*> \verbatim |
|
*> IPIV is INTEGER array, dimension (N) |
|
*> On exit, it contains the details of the interchanges, i.e., |
|
*> the row and column k of T were interchanged with the |
|
*> row and column IPIV(k). |
|
*> \endverbatim |
|
*> |
|
*> \param[out] INFO |
*> \param[out] INFO |
*> \verbatim |
*> \verbatim |
*> INFO is INTEGER |
*> INFO is INTEGER |
Line 150
|
Line 152
|
*> \author Univ. of Colorado Denver |
*> \author Univ. of Colorado Denver |
*> \author NAG Ltd. |
*> \author NAG Ltd. |
* |
* |
*> \date November 2017 |
|
* |
|
*> \ingroup doubleSYcomputational |
*> \ingroup doubleSYcomputational |
* |
* |
* ===================================================================== |
* ===================================================================== |
SUBROUTINE DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, |
SUBROUTINE DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, |
$ IPIV2, WORK, LWORK, INFO ) |
$ IPIV2, WORK, LWORK, INFO ) |
* |
* |
* -- LAPACK computational routine (version 3.8.0) -- |
* -- LAPACK computational routine -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* November 2017 |
|
* |
* |
IMPLICIT NONE |
IMPLICIT NONE |
* |
* |
Line 191
|
Line 190
|
EXTERNAL LSAME, ILAENV |
EXTERNAL LSAME, ILAENV |
* .. |
* .. |
* .. External Subroutines .. |
* .. External Subroutines .. |
EXTERNAL XERBLA, DCOPY, DLACGV, DLACPY, |
EXTERNAL XERBLA, DCOPY, DLACPY, |
$ DLASET, DGBTRF, DGEMM, DGETRF, |
$ DLASET, DGBTRF, DGEMM, DGETRF, |
$ DSYGST, DSWAP, DTRSM |
$ DSYGST, DSWAP, DTRSM |
* .. |
* .. |
Line 273
|
Line 272
|
IF( UPPER ) THEN |
IF( UPPER ) THEN |
* |
* |
* ..................................................... |
* ..................................................... |
* Factorize A as L*D*L**T using the upper triangle of A |
* Factorize A as U**T*D*U using the upper triangle of A |
* ..................................................... |
* ..................................................... |
* |
* |
DO J = 0, NT-1 |
DO J = 0, NT-1 |
Line 440 c END IF
|
Line 439 c END IF
|
* > Apply pivots to previous columns of L |
* > Apply pivots to previous columns of L |
CALL DSWAP( K-1, A( (J+1)*NB+1, I1 ), 1, |
CALL DSWAP( K-1, A( (J+1)*NB+1, I1 ), 1, |
$ A( (J+1)*NB+1, I2 ), 1 ) |
$ A( (J+1)*NB+1, I2 ), 1 ) |
* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) |
* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) |
CALL DSWAP( I2-I1-1, A( I1, I1+1 ), LDA, |
IF( I2.GT.(I1+1) ) |
$ A( I1+1, I2 ), 1 ) |
$ CALL DSWAP( I2-I1-1, A( I1, I1+1 ), LDA, |
|
$ A( I1+1, I2 ), 1 ) |
* > Swap A(I2+1:M, I1) with A(I2+1:M, I2) |
* > Swap A(I2+1:M, I1) with A(I2+1:M, I2) |
CALL DSWAP( N-I2, A( I1, I2+1 ), LDA, |
IF( I2.LT.N ) |
$ A( I2, I2+1 ), LDA ) |
$ CALL DSWAP( N-I2, A( I1, I2+1 ), LDA, |
|
$ A( I2, I2+1 ), LDA ) |
* > Swap A(I1, I1) with A(I2, I2) |
* > Swap A(I1, I1) with A(I2, I2) |
PIV = A( I1, I1 ) |
PIV = A( I1, I1 ) |
A( I1, I1 ) = A( I2, I2 ) |
A( I1, I1 ) = A( I2, I2 ) |
Line 614 c END IF
|
Line 615 c END IF
|
CALL DSWAP( K-1, A( I1, (J+1)*NB+1 ), LDA, |
CALL DSWAP( K-1, A( I1, (J+1)*NB+1 ), LDA, |
$ A( I2, (J+1)*NB+1 ), LDA ) |
$ A( I2, (J+1)*NB+1 ), LDA ) |
* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) |
* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) |
CALL DSWAP( I2-I1-1, A( I1+1, I1 ), 1, |
IF( I2.GT.(I1+1) ) |
$ A( I2, I1+1 ), LDA ) |
$ CALL DSWAP( I2-I1-1, A( I1+1, I1 ), 1, |
|
$ A( I2, I1+1 ), LDA ) |
* > Swap A(I2+1:M, I1) with A(I2+1:M, I2) |
* > Swap A(I2+1:M, I1) with A(I2+1:M, I2) |
CALL DSWAP( N-I2, A( I2+1, I1 ), 1, |
IF( I2.LT.N ) |
$ A( I2+1, I2 ), 1 ) |
$ CALL DSWAP( N-I2, A( I2+1, I1 ), 1, |
|
$ A( I2+1, I2 ), 1 ) |
* > Swap A(I1, I1) with A(I2, I2) |
* > Swap A(I1, I1) with A(I2, I2) |
PIV = A( I1, I1 ) |
PIV = A( I1, I1 ) |
A( I1, I1 ) = A( I2, I2 ) |
A( I1, I1 ) = A( I2, I2 ) |
Line 642 c $ (J+1)*NB+1,
|
Line 645 c $ (J+1)*NB+1,
|
* Factor the band matrix |
* Factor the band matrix |
CALL DGBTRF( N, N, NB, NB, TB, LDTB, IPIV2, INFO ) |
CALL DGBTRF( N, N, NB, NB, TB, LDTB, IPIV2, INFO ) |
* |
* |
|
RETURN |
|
* |
* End of DSYTRF_AA_2STAGE |
* End of DSYTRF_AA_2STAGE |
* |
* |
END |
END |