![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zla_porcond_c.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack|
Return to zla_porcond_c.f CVS log | Up to [local] / rpl / lapack / lapack |
1.6 bertrand 1: *> \brief \b ZLA_PORCOND_C
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download ZLA_PORCOND_C + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zla_porcond_c.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zla_porcond_c.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zla_porcond_c.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * DOUBLE PRECISION FUNCTION ZLA_PORCOND_C( UPLO, N, A, LDA, AF,
22: * LDAF, C, CAPPLY, INFO,
23: * WORK, RWORK )
24: *
25: * .. Scalar Arguments ..
26: * CHARACTER UPLO
27: * LOGICAL CAPPLY
28: * INTEGER N, LDA, LDAF, INFO
29: * ..
30: * .. Array Arguments ..
31: * COMPLEX*16 A( LDA, * ), AF( LDAF, * ), WORK( * )
32: * DOUBLE PRECISION C( * ), RWORK( * )
33: * ..
34: *
35: *
36: *> \par Purpose:
37: * =============
38: *>
39: *> \verbatim
40: *>
41: *> ZLA_PORCOND_C Computes the infinity norm condition number of
42: *> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION 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 triangular factor U or L from the Cholesky factorization
78: *> A = U**H*U or A = L*L**H, as computed by ZPOTRF.
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] C
88: *> \verbatim
89: *> C is DOUBLE PRECISION array, dimension (N)
90: *> The vector C in the formula op(A) * inv(diag(C)).
91: *> \endverbatim
92: *>
93: *> \param[in] CAPPLY
94: *> \verbatim
95: *> CAPPLY is LOGICAL
96: *> If .TRUE. then access the vector C in the formula above.
97: *> \endverbatim
98: *>
99: *> \param[out] INFO
100: *> \verbatim
101: *> INFO is INTEGER
102: *> = 0: Successful exit.
103: *> i > 0: The ith argument is invalid.
104: *> \endverbatim
105: *>
106: *> \param[in] WORK
107: *> \verbatim
108: *> WORK is COMPLEX*16 array, dimension (2*N).
109: *> Workspace.
110: *> \endverbatim
111: *>
112: *> \param[in] RWORK
113: *> \verbatim
114: *> RWORK is DOUBLE PRECISION array, dimension (N).
115: *> Workspace.
116: *> \endverbatim
117: *
118: * Authors:
119: * ========
120: *
121: *> \author Univ. of Tennessee
122: *> \author Univ. of California Berkeley
123: *> \author Univ. of Colorado Denver
124: *> \author NAG Ltd.
125: *
126: *> \date November 2011
127: *
128: *> \ingroup complex16POcomputational
129: *
130: * =====================================================================
1.1 bertrand 131: DOUBLE PRECISION FUNCTION ZLA_PORCOND_C( UPLO, N, A, LDA, AF,
132: $ LDAF, C, CAPPLY, INFO,
133: $ WORK, RWORK )
134: *
1.6 bertrand 135: * -- LAPACK computational routine (version 3.4.0) --
136: * -- LAPACK is a software package provided by Univ. of Tennessee, --
137: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
138: * November 2011
1.1 bertrand 139: *
140: * .. Scalar Arguments ..
141: CHARACTER UPLO
142: LOGICAL CAPPLY
143: INTEGER N, LDA, LDAF, INFO
144: * ..
145: * .. Array Arguments ..
146: COMPLEX*16 A( LDA, * ), AF( LDAF, * ), WORK( * )
147: DOUBLE PRECISION C( * ), RWORK( * )
148: * ..
149: *
150: * =====================================================================
151: *
152: * .. Local Scalars ..
153: INTEGER KASE
154: DOUBLE PRECISION AINVNM, ANORM, TMP
155: INTEGER I, J
1.8 ! bertrand 156: LOGICAL UP, UPPER
1.1 bertrand 157: COMPLEX*16 ZDUM
158: * ..
159: * .. Local Arrays ..
160: INTEGER ISAVE( 3 )
161: * ..
162: * .. External Functions ..
163: LOGICAL LSAME
164: EXTERNAL LSAME
165: * ..
166: * .. External Subroutines ..
167: EXTERNAL ZLACN2, ZPOTRS, XERBLA
168: * ..
169: * .. Intrinsic Functions ..
170: INTRINSIC ABS, MAX, REAL, DIMAG
171: * ..
172: * .. Statement Functions ..
173: DOUBLE PRECISION CABS1
174: * ..
175: * .. Statement Function Definitions ..
176: CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
177: * ..
178: * .. Executable Statements ..
179: *
180: ZLA_PORCOND_C = 0.0D+0
181: *
182: INFO = 0
1.8 ! bertrand 183: UPPER = LSAME( UPLO, 'U' )
! 184: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
! 185: INFO = -1
! 186: ELSE IF( N.LT.0 ) THEN
1.1 bertrand 187: INFO = -2
1.8 ! bertrand 188: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
! 189: INFO = -4
! 190: ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
! 191: INFO = -6
1.1 bertrand 192: END IF
193: IF( INFO.NE.0 ) THEN
194: CALL XERBLA( 'ZLA_PORCOND_C', -INFO )
195: RETURN
196: END IF
197: UP = .FALSE.
198: IF ( LSAME( UPLO, 'U' ) ) UP = .TRUE.
199: *
200: * Compute norm of op(A)*op2(C).
201: *
202: ANORM = 0.0D+0
203: IF ( UP ) THEN
204: DO I = 1, N
205: TMP = 0.0D+0
206: IF ( CAPPLY ) THEN
207: DO J = 1, I
208: TMP = TMP + CABS1( A( J, I ) ) / C( J )
209: END DO
210: DO J = I+1, N
211: TMP = TMP + CABS1( A( I, J ) ) / C( J )
212: END DO
213: ELSE
214: DO J = 1, I
215: TMP = TMP + CABS1( A( J, I ) )
216: END DO
217: DO J = I+1, N
218: TMP = TMP + CABS1( A( I, J ) )
219: END DO
220: END IF
221: RWORK( I ) = TMP
222: ANORM = MAX( ANORM, TMP )
223: END DO
224: ELSE
225: DO I = 1, N
226: TMP = 0.0D+0
227: IF ( CAPPLY ) THEN
228: DO J = 1, I
229: TMP = TMP + CABS1( A( I, J ) ) / C( J )
230: END DO
231: DO J = I+1, N
232: TMP = TMP + CABS1( A( J, I ) ) / C( J )
233: END DO
234: ELSE
235: DO J = 1, I
236: TMP = TMP + CABS1( A( I, J ) )
237: END DO
238: DO J = I+1, N
239: TMP = TMP + CABS1( A( J, I ) )
240: END DO
241: END IF
242: RWORK( I ) = TMP
243: ANORM = MAX( ANORM, TMP )
244: END DO
245: END IF
246: *
247: * Quick return if possible.
248: *
249: IF( N.EQ.0 ) THEN
250: ZLA_PORCOND_C = 1.0D+0
251: RETURN
252: ELSE IF( ANORM .EQ. 0.0D+0 ) THEN
253: RETURN
254: END IF
255: *
256: * Estimate the norm of inv(op(A)).
257: *
258: AINVNM = 0.0D+0
259: *
260: KASE = 0
261: 10 CONTINUE
262: CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
263: IF( KASE.NE.0 ) THEN
264: IF( KASE.EQ.2 ) THEN
265: *
266: * Multiply by R.
267: *
268: DO I = 1, N
269: WORK( I ) = WORK( I ) * RWORK( I )
270: END DO
271: *
272: IF ( UP ) THEN
273: CALL ZPOTRS( 'U', N, 1, AF, LDAF,
274: $ WORK, N, INFO )
275: ELSE
276: CALL ZPOTRS( 'L', N, 1, AF, LDAF,
277: $ WORK, N, INFO )
278: ENDIF
279: *
280: * Multiply by inv(C).
281: *
282: IF ( CAPPLY ) THEN
283: DO I = 1, N
284: WORK( I ) = WORK( I ) * C( I )
285: END DO
286: END IF
287: ELSE
288: *
1.5 bertrand 289: * Multiply by inv(C**H).
1.1 bertrand 290: *
291: IF ( CAPPLY ) THEN
292: DO I = 1, N
293: WORK( I ) = WORK( I ) * C( I )
294: END DO
295: END IF
296: *
297: IF ( UP ) THEN
298: CALL ZPOTRS( 'U', N, 1, AF, LDAF,
299: $ WORK, N, INFO )
300: ELSE
301: CALL ZPOTRS( 'L', N, 1, AF, LDAF,
302: $ WORK, N, INFO )
303: END IF
304: *
305: * Multiply by R.
306: *
307: DO I = 1, N
308: WORK( I ) = WORK( I ) * RWORK( I )
309: END DO
310: END IF
311: GO TO 10
312: END IF
313: *
314: * Compute the estimate of the reciprocal condition number.
315: *
316: IF( AINVNM .NE. 0.0D+0 )
317: $ ZLA_PORCOND_C = 1.0D+0 / AINVNM
318: *
319: RETURN
320: *
321: END