julie
be91086043
Those are just cosmetic changes to update version number and various other minor change.
161 lines
4.4 KiB
FortranFixed
161 lines
4.4 KiB
FortranFixed
SUBROUTINE CSPCON( UPLO, N, AP, 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, N
|
|
REAL ANORM, RCOND
|
|
* ..
|
|
* .. Array Arguments ..
|
|
INTEGER IPIV( * )
|
|
COMPLEX AP( * ), WORK( * )
|
|
* ..
|
|
*
|
|
* Purpose
|
|
* =======
|
|
*
|
|
* CSPCON estimates the reciprocal of the condition number (in the
|
|
* 1-norm) of a complex symmetric packed matrix A using the
|
|
* factorization A = U*D*U**T or A = L*D*L**T computed by CSPTRF.
|
|
*
|
|
* 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**T;
|
|
* = 'L': Lower triangular, form is A = L*D*L**T.
|
|
*
|
|
* N (input) INTEGER
|
|
* The order of the matrix A. N >= 0.
|
|
*
|
|
* AP (input) COMPLEX array, dimension (N*(N+1)/2)
|
|
* The block diagonal matrix D and the multipliers used to
|
|
* obtain the factor U or L as computed by CSPTRF, stored as a
|
|
* packed triangular matrix.
|
|
*
|
|
* IPIV (input) INTEGER array, dimension (N)
|
|
* Details of the interchanges and the block structure of D
|
|
* as determined by CSPTRF.
|
|
*
|
|
* 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, IP, KASE
|
|
REAL AINVNM
|
|
* ..
|
|
* .. Local Arrays ..
|
|
INTEGER ISAVE( 3 )
|
|
* ..
|
|
* .. External Functions ..
|
|
LOGICAL LSAME
|
|
EXTERNAL LSAME
|
|
* ..
|
|
* .. External Subroutines ..
|
|
EXTERNAL CLACN2, CSPTRS, XERBLA
|
|
* ..
|
|
* .. 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( ANORM.LT.ZERO ) THEN
|
|
INFO = -5
|
|
END IF
|
|
IF( INFO.NE.0 ) THEN
|
|
CALL XERBLA( 'CSPCON', -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
|
|
*
|
|
IP = N*( N+1 ) / 2
|
|
DO 10 I = N, 1, -1
|
|
IF( IPIV( I ).GT.0 .AND. AP( IP ).EQ.ZERO )
|
|
$ RETURN
|
|
IP = IP - I
|
|
10 CONTINUE
|
|
ELSE
|
|
*
|
|
* Lower triangular storage: examine D from top to bottom.
|
|
*
|
|
IP = 1
|
|
DO 20 I = 1, N
|
|
IF( IPIV( I ).GT.0 .AND. AP( IP ).EQ.ZERO )
|
|
$ RETURN
|
|
IP = IP + N - I + 1
|
|
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 CSPTRS( UPLO, N, 1, AP, 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 CSPCON
|
|
*
|
|
END
|