julie
be91086043
Those are just cosmetic changes to update version number and various other minor change.
165 lines
4.5 KiB
FortranFixed
165 lines
4.5 KiB
FortranFixed
SUBROUTINE CHECON( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK,
|
|
$ INFO )
|
|
*
|
|
* -- LAPACK routine (version 3.2) --
|
|
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
|
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
|
* November 2006
|
|
*
|
|
* Modified to call CLACN2 in place of CLACON, 10 Feb 03, SJH.
|
|
*
|
|
* .. Scalar Arguments ..
|
|
CHARACTER UPLO
|
|
INTEGER INFO, LDA, N
|
|
REAL ANORM, RCOND
|
|
* ..
|
|
* .. Array Arguments ..
|
|
INTEGER IPIV( * )
|
|
COMPLEX A( LDA, * ), WORK( * )
|
|
* ..
|
|
*
|
|
* Purpose
|
|
* =======
|
|
*
|
|
* CHECON estimates the reciprocal of the condition number of a complex
|
|
* Hermitian matrix A using the factorization A = U*D*U**H or
|
|
* A = L*D*L**H computed by CHETRF.
|
|
*
|
|
* An estimate is obtained for norm(inv(A)), and the reciprocal of the
|
|
* condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
|
|
*
|
|
* Arguments
|
|
* =========
|
|
*
|
|
* UPLO (input) 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*D*U**H;
|
|
* = 'L': Lower triangular, form is A = L*D*L**H.
|
|
*
|
|
* N (input) INTEGER
|
|
* The order of the matrix A. N >= 0.
|
|
*
|
|
* A (input) COMPLEX array, dimension (LDA,N)
|
|
* The block diagonal matrix D and the multipliers used to
|
|
* obtain the factor U or L as computed by CHETRF.
|
|
*
|
|
* LDA (input) INTEGER
|
|
* The leading dimension of the array A. LDA >= max(1,N).
|
|
*
|
|
* IPIV (input) INTEGER array, dimension (N)
|
|
* Details of the interchanges and the block structure of D
|
|
* as determined by CHETRF.
|
|
*
|
|
* ANORM (input) REAL
|
|
* The 1-norm of the original matrix A.
|
|
*
|
|
* RCOND (output) REAL
|
|
* The reciprocal of the condition number of the matrix A,
|
|
* computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
|
|
* estimate of the 1-norm of inv(A) computed in this routine.
|
|
*
|
|
* WORK (workspace) COMPLEX array, dimension (2*N)
|
|
*
|
|
* INFO (output) INTEGER
|
|
* = 0: successful exit
|
|
* < 0: if INFO = -i, the i-th argument had an illegal value
|
|
*
|
|
* =====================================================================
|
|
*
|
|
* .. Parameters ..
|
|
REAL ONE, ZERO
|
|
PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
|
|
* ..
|
|
* .. Local Scalars ..
|
|
LOGICAL UPPER
|
|
INTEGER I, KASE
|
|
REAL AINVNM
|
|
* ..
|
|
* .. Local Arrays ..
|
|
INTEGER ISAVE( 3 )
|
|
* ..
|
|
* .. External Functions ..
|
|
LOGICAL LSAME
|
|
EXTERNAL LSAME
|
|
* ..
|
|
* .. External Subroutines ..
|
|
EXTERNAL CHETRS, CLACN2, XERBLA
|
|
* ..
|
|
* .. Intrinsic Functions ..
|
|
INTRINSIC MAX
|
|
* ..
|
|
* .. 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
|
|
ELSE IF( ANORM.LT.ZERO ) THEN
|
|
INFO = -6
|
|
END IF
|
|
IF( INFO.NE.0 ) THEN
|
|
CALL XERBLA( 'CHECON', -INFO )
|
|
RETURN
|
|
END IF
|
|
*
|
|
* Quick return if possible
|
|
*
|
|
RCOND = ZERO
|
|
IF( N.EQ.0 ) THEN
|
|
RCOND = ONE
|
|
RETURN
|
|
ELSE IF( ANORM.LE.ZERO ) THEN
|
|
RETURN
|
|
END IF
|
|
*
|
|
* Check that the diagonal matrix D is nonsingular.
|
|
*
|
|
IF( UPPER ) THEN
|
|
*
|
|
* Upper triangular storage: examine D from bottom to top
|
|
*
|
|
DO 10 I = N, 1, -1
|
|
IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
|
|
$ RETURN
|
|
10 CONTINUE
|
|
ELSE
|
|
*
|
|
* Lower triangular storage: examine D from top to bottom.
|
|
*
|
|
DO 20 I = 1, N
|
|
IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
|
|
$ RETURN
|
|
20 CONTINUE
|
|
END IF
|
|
*
|
|
* Estimate the 1-norm of the inverse.
|
|
*
|
|
KASE = 0
|
|
30 CONTINUE
|
|
CALL CLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
|
|
IF( KASE.NE.0 ) THEN
|
|
*
|
|
* Multiply by inv(L*D*L') or inv(U*D*U').
|
|
*
|
|
CALL CHETRS( UPLO, N, 1, A, LDA, IPIV, WORK, N, INFO )
|
|
GO TO 30
|
|
END IF
|
|
*
|
|
* Compute the estimate of the reciprocal condition number.
|
|
*
|
|
IF( AINVNM.NE.ZERO )
|
|
$ RCOND = ( ONE / AINVNM ) / ANORM
|
|
*
|
|
RETURN
|
|
*
|
|
* End of CHECON
|
|
*
|
|
END
|