|
1
2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 |
SUBROUTINE DSYCON( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK,
$ IWORK, INFO ) * * -- LAPACK routine (version 3.3.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- April 2011 -- * * Modified to call DLACN2 in place of DLACON, 5 Feb 03, SJH. * * .. Scalar Arguments .. CHARACTER UPLO INTEGER INFO, LDA, N DOUBLE PRECISION ANORM, RCOND * .. * .. Array Arguments .. INTEGER IPIV( * ), IWORK( * ) DOUBLE PRECISION A( LDA, * ), WORK( * ) * .. * * Purpose * ======= * * DSYCON estimates the reciprocal of the condition number (in the * 1-norm) of a real symmetric matrix A using the factorization * A = U*D*U**T or A = L*D*L**T computed by DSYTRF. * * 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. * * A (input) DOUBLE PRECISION array, dimension (LDA,N) * The block diagonal matrix D and the multipliers used to * obtain the factor U or L as computed by DSYTRF. * * 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 DSYTRF. * * ANORM (input) DOUBLE PRECISION * The 1-norm of the original matrix A. * * RCOND (output) DOUBLE PRECISION * 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) DOUBLE PRECISION array, dimension (2*N) * * IWORK (workspace) INTEGER array, dimension (N) * * INFO (output) INTEGER * = 0: successful exit * < 0: if INFO = -i, the i-th argument had an illegal value * * ===================================================================== * * .. Parameters .. DOUBLE PRECISION ONE, ZERO PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) * .. * .. Local Scalars .. LOGICAL UPPER INTEGER I, KASE DOUBLE PRECISION AINVNM * .. * .. Local Arrays .. INTEGER ISAVE( 3 ) * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. EXTERNAL DLACN2, DSYTRS, 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( 'DSYCON', -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 DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE ) IF( KASE.NE.0 ) THEN * * Multiply by inv(L*D*L**T) or inv(U*D*U**T). * CALL DSYTRS( 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 DSYCON * END |