version 1.1, 2017/06/17 11:02:54
|
version 1.6, 2023/08/07 08:39:25
|
Line 37
|
Line 37
|
*> ZHETRF_AA computes the factorization of a complex hermitian matrix A |
*> ZHETRF_AA computes the factorization of a complex hermitian 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**H or A = L*T*L**H |
*> A = U**H*T*U or A = L*T*L**H |
*> |
*> |
*> 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 hermitian tridiagonal matrix. |
*> triangular matrices, and T is a hermitian 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 |
|
* |
|
*> \ingroup complex16HEcomputational |
*> \ingroup complex16HEcomputational |
* |
* |
* ===================================================================== |
* ===================================================================== |
SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) |
SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) |
* |
* |
* -- LAPACK computational routine (version 3.7.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..-- |
* December 2016 |
|
* |
* |
IMPLICIT NONE |
IMPLICIT NONE |
* |
* |
Line 159
|
Line 152
|
* |
* |
* .. 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 |
COMPLEX*16 ALPHA |
COMPLEX*16 ALPHA |
* .. |
* .. |
Line 169
|
Line 162
|
EXTERNAL LSAME, ILAENV |
EXTERNAL LSAME, ILAENV |
* .. |
* .. |
* .. External Subroutines .. |
* .. External Subroutines .. |
EXTERNAL XERBLA |
EXTERNAL ZLAHEF_AA, ZGEMM, ZGEMV, ZCOPY, ZSCAL, ZSWAP, XERBLA |
* .. |
* .. |
* .. Intrinsic Functions .. |
* .. Intrinsic Functions .. |
INTRINSIC DBLE, DCONJG, MAX |
INTRINSIC DBLE, DCONJG, MAX |
Line 178
|
Line 171
|
* |
* |
* Determine the block size |
* Determine the block size |
* |
* |
NB = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 ) |
NB = ILAENV( 1, 'ZHETRF_AA', UPLO, N, -1, -1, -1 ) |
* |
* |
* Test the input parameters. |
* Test the input parameters. |
* |
* |
Line 215
|
Line 208
|
IPIV( 1 ) = 1 |
IPIV( 1 ) = 1 |
IF ( N.EQ.1 ) THEN |
IF ( N.EQ.1 ) THEN |
A( 1, 1 ) = DBLE( A( 1, 1 ) ) |
A( 1, 1 ) = DBLE( A( 1, 1 ) ) |
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 230
|
Line 220
|
IF( UPPER ) THEN |
IF( UPPER ) THEN |
* |
* |
* ..................................................... |
* ..................................................... |
* Factorize A as L*D*L**H using the upper triangle of A |
* Factorize A as U**H*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 261
|
Line 251
|
* |
* |
CALL ZLAHEF_AA( UPLO, 2-K1, N-J, JB, |
CALL ZLAHEF_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 385
|
Line 371
|
* |
* |
CALL ZLAHEF_AA( UPLO, 2-K1, N-J, JB, |
CALL ZLAHEF_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 |
Line 476
|
Line 459
|
END IF |
END IF |
* |
* |
20 CONTINUE |
20 CONTINUE |
|
WORK( 1 ) = LWKOPT |
RETURN |
RETURN |
* |
* |
* End of ZHETRF_AA |
* End of ZHETRF_AA |