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