![]() ![]() | ![]() |
Mise à jour de lapack vers la version 3.5.0.
1: *> \brief \b ZHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization obtained with one of the bounded diagonal pivoting methods (max 2 interchanges) 2: * 3: * =========== DOCUMENTATION =========== 4: * 5: * Online html documentation available at 6: * http://www.netlib.org/lapack/explore-html/ 7: * 8: *> \htmlonly 9: *> Download ZHECON_ROOK + dependencies 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhecon_rook.f"> 11: *> [TGZ]</a> 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhecon_rook.f"> 13: *> [ZIP]</a> 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhecon_rook.f"> 15: *> [TXT]</a> 16: *> \endhtmlonly 17: * 18: * Definition: 19: * =========== 20: * 21: * SUBROUTINE ZHECON_ROOK( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, 22: * INFO ) 23: * 24: * .. Scalar Arguments .. 25: * CHARACTER UPLO 26: * INTEGER INFO, LDA, N 27: * DOUBLE PRECISION ANORM, RCOND 28: * .. 29: * .. Array Arguments .. 30: * INTEGER IPIV( * ) 31: * COMPLEX*16 A( LDA, * ), WORK( * ) 32: * .. 33: * 34: * 35: *> \par Purpose: 36: * ============= 37: *> 38: *> \verbatim 39: *> 40: *> ZHECON_ROOK estimates the reciprocal of the condition number of a complex 41: *> Hermitian matrix A using the factorization A = U*D*U**H or 42: *> A = L*D*L**H computed by CHETRF_ROOK. 43: *> 44: *> An estimate is obtained for norm(inv(A)), and the reciprocal of the 45: *> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). 46: *> \endverbatim 47: * 48: * Arguments: 49: * ========== 50: * 51: *> \param[in] UPLO 52: *> \verbatim 53: *> UPLO is CHARACTER*1 54: *> Specifies whether the details of the factorization are stored 55: *> as an upper or lower triangular matrix. 56: *> = 'U': Upper triangular, form is A = U*D*U**H; 57: *> = 'L': Lower triangular, form is A = L*D*L**H. 58: *> \endverbatim 59: *> 60: *> \param[in] N 61: *> \verbatim 62: *> N is INTEGER 63: *> The order of the matrix A. N >= 0. 64: *> \endverbatim 65: *> 66: *> \param[in] A 67: *> \verbatim 68: *> A is COMPLEX*16 array, dimension (LDA,N) 69: *> The block diagonal matrix D and the multipliers used to 70: *> obtain the factor U or L as computed by CHETRF_ROOK. 71: *> \endverbatim 72: *> 73: *> \param[in] LDA 74: *> \verbatim 75: *> LDA is INTEGER 76: *> The leading dimension of the array A. LDA >= max(1,N). 77: *> \endverbatim 78: *> 79: *> \param[in] IPIV 80: *> \verbatim 81: *> IPIV is INTEGER array, dimension (N) 82: *> Details of the interchanges and the block structure of D 83: *> as determined by CHETRF_ROOK. 84: *> \endverbatim 85: *> 86: *> \param[in] ANORM 87: *> \verbatim 88: *> ANORM is DOUBLE PRECISION 89: *> The 1-norm of the original matrix A. 90: *> \endverbatim 91: *> 92: *> \param[out] RCOND 93: *> \verbatim 94: *> RCOND is DOUBLE PRECISION 95: *> The reciprocal of the condition number of the matrix A, 96: *> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an 97: *> estimate of the 1-norm of inv(A) computed in this routine. 98: *> \endverbatim 99: *> 100: *> \param[out] WORK 101: *> \verbatim 102: *> WORK is COMPLEX*16 array, dimension (2*N) 103: *> \endverbatim 104: *> 105: *> \param[out] INFO 106: *> \verbatim 107: *> INFO is INTEGER 108: *> = 0: successful exit 109: *> < 0: if INFO = -i, the i-th argument had an illegal value 110: *> \endverbatim 111: * 112: * Authors: 113: * ======== 114: * 115: *> \author Univ. of Tennessee 116: *> \author Univ. of California Berkeley 117: *> \author Univ. of Colorado Denver 118: *> \author NAG Ltd. 119: * 120: *> \date November 2013 121: * 122: *> \ingroup complex16HEcomputational 123: * 124: *> \par Contributors: 125: * ================== 126: *> \verbatim 127: *> 128: *> November 2013, Igor Kozachenko, 129: *> Computer Science Division, 130: *> University of California, Berkeley 131: *> 132: *> September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas, 133: *> School of Mathematics, 134: *> University of Manchester 135: *> 136: *> \endverbatim 137: * 138: * ===================================================================== 139: SUBROUTINE ZHECON_ROOK( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, 140: $ INFO ) 141: * 142: * -- LAPACK computational routine (version 3.5.0) -- 143: * -- LAPACK is a software package provided by Univ. of Tennessee, -- 144: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 145: * November 2013 146: * 147: * .. Scalar Arguments .. 148: CHARACTER UPLO 149: INTEGER INFO, LDA, N 150: DOUBLE PRECISION ANORM, RCOND 151: * .. 152: * .. Array Arguments .. 153: INTEGER IPIV( * ) 154: COMPLEX*16 A( LDA, * ), WORK( * ) 155: * .. 156: * 157: * ===================================================================== 158: * 159: * .. Parameters .. 160: REAL ONE, ZERO 161: PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 162: * .. 163: * .. Local Scalars .. 164: LOGICAL UPPER 165: INTEGER I, KASE 166: DOUBLE PRECISION AINVNM 167: * .. 168: * .. Local Arrays .. 169: INTEGER ISAVE( 3 ) 170: * .. 171: * .. External Functions .. 172: LOGICAL LSAME 173: EXTERNAL LSAME 174: * .. 175: * .. External Subroutines .. 176: EXTERNAL ZHETRS_ROOK, ZLACN2, XERBLA 177: * .. 178: * .. Intrinsic Functions .. 179: INTRINSIC MAX 180: * .. 181: * .. Executable Statements .. 182: * 183: * Test the input parameters. 184: * 185: INFO = 0 186: UPPER = LSAME( UPLO, 'U' ) 187: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 188: INFO = -1 189: ELSE IF( N.LT.0 ) THEN 190: INFO = -2 191: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 192: INFO = -4 193: ELSE IF( ANORM.LT.ZERO ) THEN 194: INFO = -6 195: END IF 196: IF( INFO.NE.0 ) THEN 197: CALL XERBLA( 'ZHECON_ROOK', -INFO ) 198: RETURN 199: END IF 200: * 201: * Quick return if possible 202: * 203: RCOND = ZERO 204: IF( N.EQ.0 ) THEN 205: RCOND = ONE 206: RETURN 207: ELSE IF( ANORM.LE.ZERO ) THEN 208: RETURN 209: END IF 210: * 211: * Check that the diagonal matrix D is nonsingular. 212: * 213: IF( UPPER ) THEN 214: * 215: * Upper triangular storage: examine D from bottom to top 216: * 217: DO 10 I = N, 1, -1 218: IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO ) 219: $ RETURN 220: 10 CONTINUE 221: ELSE 222: * 223: * Lower triangular storage: examine D from top to bottom. 224: * 225: DO 20 I = 1, N 226: IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO ) 227: $ RETURN 228: 20 CONTINUE 229: END IF 230: * 231: * Estimate the 1-norm of the inverse. 232: * 233: KASE = 0 234: 30 CONTINUE 235: CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE ) 236: IF( KASE.NE.0 ) THEN 237: * 238: * Multiply by inv(L*D*L**H) or inv(U*D*U**H). 239: * 240: CALL ZHETRS_ROOK( UPLO, N, 1, A, LDA, IPIV, WORK, N, INFO ) 241: GO TO 30 242: END IF 243: * 244: * Compute the estimate of the reciprocal condition number. 245: * 246: IF( AINVNM.NE.ZERO ) 247: $ RCOND = ( ONE / AINVNM ) / ANORM 248: * 249: RETURN 250: * 251: * End of ZHECON_ROOK 252: * 253: END