Annotation of rpl/lapack/lapack/zla_syrcond_x.f, revision 1.18
1.10 bertrand 1: *> \brief \b ZLA_SYRCOND_X computes the infinity norm condition number of op(A)*diag(x) for symmetric indefinite matrices.
1.6 bertrand 2: *
3: * =========== DOCUMENTATION ===========
4: *
1.14 bertrand 5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
1.6 bertrand 7: *
8: *> \htmlonly
1.14 bertrand 9: *> Download ZLA_SYRCOND_X + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zla_syrcond_x.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zla_syrcond_x.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zla_syrcond_x.f">
1.6 bertrand 15: *> [TXT]</a>
1.14 bertrand 16: *> \endhtmlonly
1.6 bertrand 17: *
18: * Definition:
19: * ===========
20: *
21: * DOUBLE PRECISION FUNCTION ZLA_SYRCOND_X( UPLO, N, A, LDA, AF,
22: * LDAF, IPIV, X, INFO,
23: * WORK, RWORK )
1.14 bertrand 24: *
1.6 bertrand 25: * .. Scalar Arguments ..
26: * CHARACTER UPLO
27: * INTEGER N, LDA, LDAF, INFO
28: * ..
29: * .. Array Arguments ..
30: * INTEGER IPIV( * )
31: * COMPLEX*16 A( LDA, * ), AF( LDAF, * ), WORK( * ), X( * )
32: * DOUBLE PRECISION RWORK( * )
33: * ..
1.14 bertrand 34: *
1.6 bertrand 35: *
36: *> \par Purpose:
37: * =============
38: *>
39: *> \verbatim
40: *>
41: *> ZLA_SYRCOND_X Computes the infinity norm condition number of
42: *> op(A) * diag(X) where X is a COMPLEX*16 vector.
43: *> \endverbatim
44: *
45: * Arguments:
46: * ==========
47: *
48: *> \param[in] UPLO
49: *> \verbatim
50: *> UPLO is CHARACTER*1
51: *> = 'U': Upper triangle of A is stored;
52: *> = 'L': Lower triangle of A is stored.
53: *> \endverbatim
54: *>
55: *> \param[in] N
56: *> \verbatim
57: *> N is INTEGER
58: *> The number of linear equations, i.e., the order of the
59: *> matrix A. N >= 0.
60: *> \endverbatim
61: *>
62: *> \param[in] A
63: *> \verbatim
64: *> A is COMPLEX*16 array, dimension (LDA,N)
65: *> On entry, the N-by-N matrix A.
66: *> \endverbatim
67: *>
68: *> \param[in] LDA
69: *> \verbatim
70: *> LDA is INTEGER
71: *> The leading dimension of the array A. LDA >= max(1,N).
72: *> \endverbatim
73: *>
74: *> \param[in] AF
75: *> \verbatim
76: *> AF is COMPLEX*16 array, dimension (LDAF,N)
77: *> The block diagonal matrix D and the multipliers used to
78: *> obtain the factor U or L as computed by ZSYTRF.
79: *> \endverbatim
80: *>
81: *> \param[in] LDAF
82: *> \verbatim
83: *> LDAF is INTEGER
84: *> The leading dimension of the array AF. LDAF >= max(1,N).
85: *> \endverbatim
86: *>
87: *> \param[in] IPIV
88: *> \verbatim
89: *> IPIV is INTEGER array, dimension (N)
90: *> Details of the interchanges and the block structure of D
91: *> as determined by ZSYTRF.
92: *> \endverbatim
93: *>
94: *> \param[in] X
95: *> \verbatim
96: *> X is COMPLEX*16 array, dimension (N)
97: *> The vector X in the formula op(A) * diag(X).
98: *> \endverbatim
99: *>
100: *> \param[out] INFO
101: *> \verbatim
102: *> INFO is INTEGER
103: *> = 0: Successful exit.
104: *> i > 0: The ith argument is invalid.
105: *> \endverbatim
106: *>
1.17 bertrand 107: *> \param[out] WORK
1.6 bertrand 108: *> \verbatim
109: *> WORK is COMPLEX*16 array, dimension (2*N).
110: *> Workspace.
111: *> \endverbatim
112: *>
1.17 bertrand 113: *> \param[out] RWORK
1.6 bertrand 114: *> \verbatim
115: *> RWORK is DOUBLE PRECISION array, dimension (N).
116: *> Workspace.
117: *> \endverbatim
118: *
119: * Authors:
120: * ========
121: *
1.14 bertrand 122: *> \author Univ. of Tennessee
123: *> \author Univ. of California Berkeley
124: *> \author Univ. of Colorado Denver
125: *> \author NAG Ltd.
1.6 bertrand 126: *
127: *> \ingroup complex16SYcomputational
128: *
129: * =====================================================================
1.1 bertrand 130: DOUBLE PRECISION FUNCTION ZLA_SYRCOND_X( UPLO, N, A, LDA, AF,
131: $ LDAF, IPIV, X, INFO,
132: $ WORK, RWORK )
133: *
1.18 ! bertrand 134: * -- LAPACK computational routine --
1.6 bertrand 135: * -- LAPACK is a software package provided by Univ. of Tennessee, --
136: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.1 bertrand 137: *
138: * .. Scalar Arguments ..
139: CHARACTER UPLO
140: INTEGER N, LDA, LDAF, INFO
141: * ..
142: * .. Array Arguments ..
143: INTEGER IPIV( * )
144: COMPLEX*16 A( LDA, * ), AF( LDAF, * ), WORK( * ), X( * )
145: DOUBLE PRECISION RWORK( * )
146: * ..
147: *
148: * =====================================================================
149: *
150: * .. Local Scalars ..
151: INTEGER KASE
152: DOUBLE PRECISION AINVNM, ANORM, TMP
153: INTEGER I, J
1.8 bertrand 154: LOGICAL UP, UPPER
1.1 bertrand 155: COMPLEX*16 ZDUM
156: * ..
157: * .. Local Arrays ..
158: INTEGER ISAVE( 3 )
159: * ..
160: * .. External Functions ..
161: LOGICAL LSAME
162: EXTERNAL LSAME
163: * ..
164: * .. External Subroutines ..
165: EXTERNAL ZLACN2, ZSYTRS, XERBLA
166: * ..
167: * .. Intrinsic Functions ..
168: INTRINSIC ABS, MAX
169: * ..
170: * .. Statement Functions ..
171: DOUBLE PRECISION CABS1
172: * ..
173: * .. Statement Function Definitions ..
174: CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
175: * ..
176: * .. Executable Statements ..
177: *
178: ZLA_SYRCOND_X = 0.0D+0
179: *
180: INFO = 0
1.8 bertrand 181: UPPER = LSAME( UPLO, 'U' )
182: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
183: INFO = -1
184: ELSE IF( N.LT.0 ) THEN
1.1 bertrand 185: INFO = -2
1.8 bertrand 186: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
187: INFO = -4
188: ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
189: INFO = -6
1.1 bertrand 190: END IF
191: IF( INFO.NE.0 ) THEN
192: CALL XERBLA( 'ZLA_SYRCOND_X', -INFO )
193: RETURN
194: END IF
195: UP = .FALSE.
196: IF ( LSAME( UPLO, 'U' ) ) UP = .TRUE.
197: *
198: * Compute norm of op(A)*op2(C).
199: *
200: ANORM = 0.0D+0
201: IF ( UP ) THEN
202: DO I = 1, N
203: TMP = 0.0D+0
204: DO J = 1, I
205: TMP = TMP + CABS1( A( J, I ) * X( J ) )
206: END DO
207: DO J = I+1, N
208: TMP = TMP + CABS1( A( I, J ) * X( J ) )
209: END DO
210: RWORK( I ) = TMP
211: ANORM = MAX( ANORM, TMP )
212: END DO
213: ELSE
214: DO I = 1, N
215: TMP = 0.0D+0
216: DO J = 1, I
217: TMP = TMP + CABS1( A( I, J ) * X( J ) )
218: END DO
219: DO J = I+1, N
220: TMP = TMP + CABS1( A( J, I ) * X( J ) )
221: END DO
222: RWORK( I ) = TMP
223: ANORM = MAX( ANORM, TMP )
224: END DO
225: END IF
226: *
227: * Quick return if possible.
228: *
229: IF( N.EQ.0 ) THEN
230: ZLA_SYRCOND_X = 1.0D+0
231: RETURN
232: ELSE IF( ANORM .EQ. 0.0D+0 ) THEN
233: RETURN
234: END IF
235: *
236: * Estimate the norm of inv(op(A)).
237: *
238: AINVNM = 0.0D+0
239: *
240: KASE = 0
241: 10 CONTINUE
242: CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
243: IF( KASE.NE.0 ) THEN
244: IF( KASE.EQ.2 ) THEN
245: *
246: * Multiply by R.
247: *
248: DO I = 1, N
249: WORK( I ) = WORK( I ) * RWORK( I )
250: END DO
251: *
252: IF ( UP ) THEN
253: CALL ZSYTRS( 'U', N, 1, AF, LDAF, IPIV,
254: $ WORK, N, INFO )
255: ELSE
256: CALL ZSYTRS( 'L', N, 1, AF, LDAF, IPIV,
257: $ WORK, N, INFO )
258: ENDIF
259: *
260: * Multiply by inv(X).
261: *
262: DO I = 1, N
263: WORK( I ) = WORK( I ) / X( I )
264: END DO
265: ELSE
266: *
1.5 bertrand 267: * Multiply by inv(X**T).
1.1 bertrand 268: *
269: DO I = 1, N
270: WORK( I ) = WORK( I ) / X( I )
271: END DO
272: *
273: IF ( UP ) THEN
274: CALL ZSYTRS( 'U', N, 1, AF, LDAF, IPIV,
275: $ WORK, N, INFO )
276: ELSE
277: CALL ZSYTRS( 'L', N, 1, AF, LDAF, IPIV,
278: $ WORK, N, INFO )
279: END IF
280: *
281: * Multiply by R.
282: *
283: DO I = 1, N
284: WORK( I ) = WORK( I ) * RWORK( I )
285: END DO
286: END IF
287: GO TO 10
288: END IF
289: *
290: * Compute the estimate of the reciprocal condition number.
291: *
292: IF( AINVNM .NE. 0.0D+0 )
293: $ ZLA_SYRCOND_X = 1.0D+0 / AINVNM
294: *
295: RETURN
296: *
1.18 ! bertrand 297: * End of ZLA_SYRCOND_X
! 298: *
1.1 bertrand 299: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zla_syrcond_x.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack