version 1.1, 2017/06/17 11:02:51
|
version 1.5, 2020/05/21 21:46:02
|
Line 37
|
Line 37
|
*> DSYTRF_AA computes the factorization of a real symmetric matrix A |
*> DSYTRF_AA 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 tridiagonal matrix. |
*> triangular matrices, and T is a symmetric tridiagonal matrix. |
Line 114
|
Line 114
|
*> \verbatim |
*> \verbatim |
*> INFO is INTEGER |
*> INFO is INTEGER |
*> = 0: successful exit |
*> = 0: successful exit |
*> < 0: if INFO = -i, the i-th argument had an illegal value |
*> < 0: if INFO = -i, the i-th argument had an illegal value. |
*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization |
|
*> has been completed, but the block diagonal matrix D is |
|
*> exactly singular, and division by zero will occur if it |
|
*> is used to solve a system of equations. |
|
*> \endverbatim |
*> \endverbatim |
* |
* |
* Authors: |
* Authors: |
Line 129
|
Line 125
|
*> \author Univ. of Colorado Denver |
*> \author Univ. of Colorado Denver |
*> \author NAG Ltd. |
*> \author NAG Ltd. |
* |
* |
*> \date December 2016 |
*> \date November 2017 |
* |
* |
*> \ingroup doubleSYcomputational |
*> \ingroup doubleSYcomputational |
* |
* |
* ===================================================================== |
* ===================================================================== |
SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) |
SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) |
* |
* |
* -- LAPACK computational routine (version 3.7.0) -- |
* -- LAPACK computational routine (version 3.8.0) -- |
* -- 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..-- |
* December 2016 |
* November 2017 |
* |
* |
IMPLICIT NONE |
IMPLICIT NONE |
* |
* |
Line 159
|
Line 155
|
* |
* |
* .. Local Scalars .. |
* .. Local Scalars .. |
LOGICAL LQUERY, UPPER |
LOGICAL LQUERY, UPPER |
INTEGER J, LWKOPT, IINFO |
INTEGER J, LWKOPT |
INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB |
INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB |
DOUBLE PRECISION ALPHA |
DOUBLE PRECISION ALPHA |
* .. |
* .. |
Line 169
|
Line 165
|
EXTERNAL LSAME, ILAENV |
EXTERNAL LSAME, ILAENV |
* .. |
* .. |
* .. External Subroutines .. |
* .. External Subroutines .. |
EXTERNAL XERBLA |
EXTERNAL DLASYF_AA, DGEMM, DGEMV, DSCAL, DCOPY, DSWAP, |
|
$ XERBLA |
* .. |
* .. |
* .. Intrinsic Functions .. |
* .. Intrinsic Functions .. |
INTRINSIC MAX |
INTRINSIC MAX |
Line 178
|
Line 175
|
* |
* |
* Determine the block size |
* Determine the block size |
* |
* |
NB = ILAENV( 1, 'DSYTRF', UPLO, N, -1, -1, -1 ) |
NB = ILAENV( 1, 'DSYTRF_AA', UPLO, N, -1, -1, -1 ) |
* |
* |
* Test the input parameters. |
* Test the input parameters. |
* |
* |
Line 214
|
Line 211
|
ENDIF |
ENDIF |
IPIV( 1 ) = 1 |
IPIV( 1 ) = 1 |
IF ( N.EQ.1 ) THEN |
IF ( N.EQ.1 ) THEN |
IF ( A( 1, 1 ).EQ.ZERO ) THEN |
|
INFO = 1 |
|
END IF |
|
RETURN |
RETURN |
END IF |
END IF |
* |
* |
* Adjubst block size based on the workspace size |
* Adjust block size based on the workspace size |
* |
* |
IF( LWORK.LT.((1+NB)*N) ) THEN |
IF( LWORK.LT.((1+NB)*N) ) THEN |
NB = ( LWORK-N ) / N |
NB = ( LWORK-N ) / N |
Line 229
|
Line 223
|
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 |
* ..................................................... |
* ..................................................... |
* |
* |
* Copy first row A(1, 1:N) into H(1:n) (stored in WORK(1:N)) |
* Copy first row A(1, 1:N) into H(1:n) (stored in WORK(1:N)) |
Line 260
|
Line 254
|
* |
* |
CALL DLASYF_AA( UPLO, 2-K1, N-J, JB, |
CALL DLASYF_AA( UPLO, 2-K1, N-J, JB, |
$ A( MAX(1, J), J+1 ), LDA, |
$ A( MAX(1, J), J+1 ), LDA, |
$ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), |
$ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) |
$ IINFO ) |
|
IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN |
|
INFO = IINFO+J |
|
ENDIF |
|
* |
* |
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) |
* Adjust IPIV and apply it back (J-th step picks (J+1)-th pivot) |
* |
* |
DO J2 = J+2, MIN(N, J+JB+1) |
DO J2 = J+2, MIN(N, J+JB+1) |
IPIV( J2 ) = IPIV( J2 ) + J |
IPIV( J2 ) = IPIV( J2 ) + J |
Line 383
|
Line 373
|
* |
* |
CALL DLASYF_AA( UPLO, 2-K1, N-J, JB, |
CALL DLASYF_AA( UPLO, 2-K1, N-J, JB, |
$ A( J+1, MAX(1, J) ), LDA, |
$ A( J+1, MAX(1, J) ), LDA, |
$ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO) |
$ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) |
IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN |
|
INFO = IINFO+J |
|
ENDIF |
|
* |
* |
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) |
* Adjust IPIV and apply it back (J-th step picks (J+1)-th pivot) |
* |
* |
DO J2 = J+2, MIN(N, J+JB+1) |
DO J2 = J+2, MIN(N, J+JB+1) |
IPIV( J2 ) = IPIV( J2 ) + J |
IPIV( J2 ) = IPIV( J2 ) + J |