Annotation of rpl/lapack/lapack/zhecon_3.f, revision 1.3
1.1 bertrand 1: *> \brief \b ZHECON_3
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download ZHECON_3 + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhecon_3.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhecon_3.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhecon_3.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE ZHECON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
22: * WORK, IWORK, 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( * ), IWORK( * )
31: * COMPLEX*16 A( LDA, * ), E ( * ), WORK( * )
32: * ..
33: *
34: *
35: *> \par Purpose:
36: * =============
37: *>
38: *> \verbatim
39: *> ZHECON_3 estimates the reciprocal of the condition number (in the
40: *> 1-norm) of a complex Hermitian matrix A using the factorization
41: *> computed by ZHETRF_RK or ZHETRF_BK:
42: *>
43: *> A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
44: *>
45: *> where U (or L) is unit upper (or lower) triangular matrix,
46: *> U**H (or L**H) is the conjugate of U (or L), P is a permutation
47: *> matrix, P**T is the transpose of P, and D is Hermitian and block
48: *> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
49: *>
50: *> An estimate is obtained for norm(inv(A)), and the reciprocal of the
51: *> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
52: *> This routine uses BLAS3 solver ZHETRS_3.
53: *> \endverbatim
54: *
55: * Arguments:
56: * ==========
57: *
58: *> \param[in] UPLO
59: *> \verbatim
60: *> UPLO is CHARACTER*1
61: *> Specifies whether the details of the factorization are
62: *> stored as an upper or lower triangular matrix:
63: *> = 'U': Upper triangular, form is A = P*U*D*(U**H)*(P**T);
64: *> = 'L': Lower triangular, form is A = P*L*D*(L**H)*(P**T).
65: *> \endverbatim
66: *>
67: *> \param[in] N
68: *> \verbatim
69: *> N is INTEGER
70: *> The order of the matrix A. N >= 0.
71: *> \endverbatim
72: *>
73: *> \param[in] A
74: *> \verbatim
75: *> A is COMPLEX*16 array, dimension (LDA,N)
76: *> Diagonal of the block diagonal matrix D and factors U or L
77: *> as computed by ZHETRF_RK and ZHETRF_BK:
78: *> a) ONLY diagonal elements of the Hermitian block diagonal
79: *> matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
80: *> (superdiagonal (or subdiagonal) elements of D
81: *> should be provided on entry in array E), and
82: *> b) If UPLO = 'U': factor U in the superdiagonal part of A.
83: *> If UPLO = 'L': factor L in the subdiagonal part of A.
84: *> \endverbatim
85: *>
86: *> \param[in] LDA
87: *> \verbatim
88: *> LDA is INTEGER
89: *> The leading dimension of the array A. LDA >= max(1,N).
90: *> \endverbatim
91: *>
92: *> \param[in] E
93: *> \verbatim
94: *> E is COMPLEX*16 array, dimension (N)
95: *> On entry, contains the superdiagonal (or subdiagonal)
96: *> elements of the Hermitian block diagonal matrix D
97: *> with 1-by-1 or 2-by-2 diagonal blocks, where
1.3 ! bertrand 98: *> If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
1.1 bertrand 99: *> If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
100: *>
101: *> NOTE: For 1-by-1 diagonal block D(k), where
102: *> 1 <= k <= N, the element E(k) is not referenced in both
103: *> UPLO = 'U' or UPLO = 'L' cases.
104: *> \endverbatim
105: *>
106: *> \param[in] IPIV
107: *> \verbatim
108: *> IPIV is INTEGER array, dimension (N)
109: *> Details of the interchanges and the block structure of D
110: *> as determined by ZHETRF_RK or ZHETRF_BK.
111: *> \endverbatim
112: *>
113: *> \param[in] ANORM
114: *> \verbatim
115: *> ANORM is DOUBLE PRECISION
116: *> The 1-norm of the original matrix A.
117: *> \endverbatim
118: *>
119: *> \param[out] RCOND
120: *> \verbatim
121: *> RCOND is DOUBLE PRECISION
122: *> The reciprocal of the condition number of the matrix A,
123: *> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
124: *> estimate of the 1-norm of inv(A) computed in this routine.
125: *> \endverbatim
126: *>
127: *> \param[out] WORK
128: *> \verbatim
129: *> WORK is COMPLEX*16 array, dimension (2*N)
130: *> \endverbatim
131: *>
132: *> \param[out] IWORK
133: *> \verbatim
134: *> IWORK is INTEGER array, dimension (N)
135: *> \endverbatim
136: *>
137: *> \param[out] INFO
138: *> \verbatim
139: *> INFO is INTEGER
140: *> = 0: successful exit
141: *> < 0: if INFO = -i, the i-th argument had an illegal value
142: *> \endverbatim
143: *
144: * Authors:
145: * ========
146: *
147: *> \author Univ. of Tennessee
148: *> \author Univ. of California Berkeley
149: *> \author Univ. of Colorado Denver
150: *> \author NAG Ltd.
151: *
1.3 ! bertrand 152: *> \date June 2017
1.1 bertrand 153: *
154: *> \ingroup complex16HEcomputational
155: *
156: *> \par Contributors:
157: * ==================
158: *> \verbatim
159: *>
1.3 ! bertrand 160: *> June 2017, Igor Kozachenko,
1.1 bertrand 161: *> Computer Science Division,
162: *> University of California, Berkeley
163: *>
164: *> September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
165: *> School of Mathematics,
166: *> University of Manchester
167: *>
168: *> \endverbatim
169: *
170: * =====================================================================
171: SUBROUTINE ZHECON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
172: $ WORK, INFO )
173: *
1.3 ! bertrand 174: * -- LAPACK computational routine (version 3.7.1) --
1.1 bertrand 175: * -- LAPACK is a software package provided by Univ. of Tennessee, --
176: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.3 ! bertrand 177: * June 2017
1.1 bertrand 178: *
179: * .. Scalar Arguments ..
180: CHARACTER UPLO
181: INTEGER INFO, LDA, N
182: DOUBLE PRECISION ANORM, RCOND
183: * ..
184: * .. Array Arguments ..
185: INTEGER IPIV( * )
186: COMPLEX*16 A( LDA, * ), E( * ), WORK( * )
187: * ..
188: *
189: * =====================================================================
190: *
191: * .. Parameters ..
1.3 ! bertrand 192: DOUBLE PRECISION ONE, ZERO
1.1 bertrand 193: PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
194: * ..
195: * .. Local Scalars ..
196: LOGICAL UPPER
197: INTEGER I, KASE
198: DOUBLE PRECISION AINVNM
199: * ..
200: * .. Local Arrays ..
201: INTEGER ISAVE( 3 )
202: * ..
203: * .. External Functions ..
204: LOGICAL LSAME
205: EXTERNAL LSAME
206: * ..
207: * .. External Subroutines ..
208: EXTERNAL ZHETRS_3, ZLACN2, XERBLA
209: * ..
210: * .. Intrinsic Functions ..
211: INTRINSIC MAX
212: * ..
213: * .. Executable Statements ..
214: *
215: * Test the input parameters.
216: *
217: INFO = 0
218: UPPER = LSAME( UPLO, 'U' )
219: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
220: INFO = -1
221: ELSE IF( N.LT.0 ) THEN
222: INFO = -2
223: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
224: INFO = -4
225: ELSE IF( ANORM.LT.ZERO ) THEN
226: INFO = -7
227: END IF
228: IF( INFO.NE.0 ) THEN
229: CALL XERBLA( 'ZHECON_3', -INFO )
230: RETURN
231: END IF
232: *
233: * Quick return if possible
234: *
235: RCOND = ZERO
236: IF( N.EQ.0 ) THEN
237: RCOND = ONE
238: RETURN
239: ELSE IF( ANORM.LE.ZERO ) THEN
240: RETURN
241: END IF
242: *
243: * Check that the diagonal matrix D is nonsingular.
244: *
245: IF( UPPER ) THEN
246: *
247: * Upper triangular storage: examine D from bottom to top
248: *
249: DO I = N, 1, -1
250: IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
251: $ RETURN
252: END DO
253: ELSE
254: *
255: * Lower triangular storage: examine D from top to bottom.
256: *
257: DO I = 1, N
258: IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
259: $ RETURN
260: END DO
261: END IF
262: *
263: * Estimate the 1-norm of the inverse.
264: *
265: KASE = 0
266: 30 CONTINUE
267: CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
268: IF( KASE.NE.0 ) THEN
269: *
270: * Multiply by inv(L*D*L**H) or inv(U*D*U**H).
271: *
272: CALL ZHETRS_3( UPLO, N, 1, A, LDA, E, IPIV, WORK, N, INFO )
273: GO TO 30
274: END IF
275: *
276: * Compute the estimate of the reciprocal condition number.
277: *
278: IF( AINVNM.NE.ZERO )
279: $ RCOND = ( ONE / AINVNM ) / ANORM
280: *
281: RETURN
282: *
283: * End of ZHECON_3
284: *
285: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zhecon_3.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack