Annotation of rpl/lapack/lapack/zla_porcond_c.f, revision 1.6
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
156: LOGICAL UP
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
183: IF( N.LT.0 ) THEN
184: INFO = -2
185: END IF
186: IF( INFO.NE.0 ) THEN
187: CALL XERBLA( 'ZLA_PORCOND_C', -INFO )
188: RETURN
189: END IF
190: UP = .FALSE.
191: IF ( LSAME( UPLO, 'U' ) ) UP = .TRUE.
192: *
193: * Compute norm of op(A)*op2(C).
194: *
195: ANORM = 0.0D+0
196: IF ( UP ) THEN
197: DO I = 1, N
198: TMP = 0.0D+0
199: IF ( CAPPLY ) THEN
200: DO J = 1, I
201: TMP = TMP + CABS1( A( J, I ) ) / C( J )
202: END DO
203: DO J = I+1, N
204: TMP = TMP + CABS1( A( I, J ) ) / C( J )
205: END DO
206: ELSE
207: DO J = 1, I
208: TMP = TMP + CABS1( A( J, I ) )
209: END DO
210: DO J = I+1, N
211: TMP = TMP + CABS1( A( I, J ) )
212: END DO
213: END IF
214: RWORK( I ) = TMP
215: ANORM = MAX( ANORM, TMP )
216: END DO
217: ELSE
218: DO I = 1, N
219: TMP = 0.0D+0
220: IF ( CAPPLY ) THEN
221: DO J = 1, I
222: TMP = TMP + CABS1( A( I, J ) ) / C( J )
223: END DO
224: DO J = I+1, N
225: TMP = TMP + CABS1( A( J, I ) ) / C( J )
226: END DO
227: ELSE
228: DO J = 1, I
229: TMP = TMP + CABS1( A( I, J ) )
230: END DO
231: DO J = I+1, N
232: TMP = TMP + CABS1( A( J, I ) )
233: END DO
234: END IF
235: RWORK( I ) = TMP
236: ANORM = MAX( ANORM, TMP )
237: END DO
238: END IF
239: *
240: * Quick return if possible.
241: *
242: IF( N.EQ.0 ) THEN
243: ZLA_PORCOND_C = 1.0D+0
244: RETURN
245: ELSE IF( ANORM .EQ. 0.0D+0 ) THEN
246: RETURN
247: END IF
248: *
249: * Estimate the norm of inv(op(A)).
250: *
251: AINVNM = 0.0D+0
252: *
253: KASE = 0
254: 10 CONTINUE
255: CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
256: IF( KASE.NE.0 ) THEN
257: IF( KASE.EQ.2 ) THEN
258: *
259: * Multiply by R.
260: *
261: DO I = 1, N
262: WORK( I ) = WORK( I ) * RWORK( I )
263: END DO
264: *
265: IF ( UP ) THEN
266: CALL ZPOTRS( 'U', N, 1, AF, LDAF,
267: $ WORK, N, INFO )
268: ELSE
269: CALL ZPOTRS( 'L', N, 1, AF, LDAF,
270: $ WORK, N, INFO )
271: ENDIF
272: *
273: * Multiply by inv(C).
274: *
275: IF ( CAPPLY ) THEN
276: DO I = 1, N
277: WORK( I ) = WORK( I ) * C( I )
278: END DO
279: END IF
280: ELSE
281: *
1.5 bertrand 282: * Multiply by inv(C**H).
1.1 bertrand 283: *
284: IF ( CAPPLY ) THEN
285: DO I = 1, N
286: WORK( I ) = WORK( I ) * C( I )
287: END DO
288: END IF
289: *
290: IF ( UP ) THEN
291: CALL ZPOTRS( 'U', N, 1, AF, LDAF,
292: $ WORK, N, INFO )
293: ELSE
294: CALL ZPOTRS( 'L', N, 1, AF, LDAF,
295: $ WORK, N, INFO )
296: END IF
297: *
298: * Multiply by R.
299: *
300: DO I = 1, N
301: WORK( I ) = WORK( I ) * RWORK( I )
302: END DO
303: END IF
304: GO TO 10
305: END IF
306: *
307: * Compute the estimate of the reciprocal condition number.
308: *
309: IF( AINVNM .NE. 0.0D+0 )
310: $ ZLA_PORCOND_C = 1.0D+0 / AINVNM
311: *
312: RETURN
313: *
314: END
CVSweb interface <joel.bertrand@systella.fr>
![[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