Annotation of rpl/lapack/lapack/zla_porcond_x.f, revision 1.6
1.6 ! bertrand 1: *> \brief \b ZLA_PORCOND_X
! 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_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">
! 15: *> [TXT]</a>
! 16: *> \endhtmlonly
! 17: *
! 18: * Definition:
! 19: * ===========
! 20: *
! 21: * DOUBLE PRECISION FUNCTION ZLA_PORCOND_X( UPLO, N, A, LDA, AF,
! 22: * LDAF, X, INFO, WORK,
! 23: * RWORK )
! 24: *
! 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: * ..
! 33: *
! 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: *>
! 99: *> \param[in] WORK
! 100: *> \verbatim
! 101: *> WORK is COMPLEX*16 array, dimension (2*N).
! 102: *> Workspace.
! 103: *> \endverbatim
! 104: *>
! 105: *> \param[in] RWORK
! 106: *> \verbatim
! 107: *> RWORK is DOUBLE PRECISION array, dimension (N).
! 108: *> Workspace.
! 109: *> \endverbatim
! 110: *
! 111: * Authors:
! 112: * ========
! 113: *
! 114: *> \author Univ. of Tennessee
! 115: *> \author Univ. of California Berkeley
! 116: *> \author Univ. of Colorado Denver
! 117: *> \author NAG Ltd.
! 118: *
! 119: *> \date November 2011
! 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.6 ! bertrand 128: * -- LAPACK computational routine (version 3.4.0) --
! 129: * -- LAPACK is a software package provided by Univ. of Tennessee, --
! 130: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! 131: * November 2011
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
147: LOGICAL UP
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
174: IF( N.LT.0 ) THEN
175: INFO = -2
176: END IF
177: IF( INFO.NE.0 ) THEN
178: CALL XERBLA( 'ZLA_PORCOND_X', -INFO )
179: RETURN
180: END IF
181: UP = .FALSE.
182: IF ( LSAME( UPLO, 'U' ) ) UP = .TRUE.
183: *
184: * Compute norm of op(A)*op2(C).
185: *
186: ANORM = 0.0D+0
187: IF ( UP ) THEN
188: DO I = 1, N
189: TMP = 0.0D+0
190: DO J = 1, I
191: TMP = TMP + CABS1( A( J, I ) * X( J ) )
192: END DO
193: DO J = I+1, N
194: TMP = TMP + CABS1( A( I, J ) * X( J ) )
195: END DO
196: RWORK( I ) = TMP
197: ANORM = MAX( ANORM, TMP )
198: END DO
199: ELSE
200: DO I = 1, N
201: TMP = 0.0D+0
202: DO J = 1, I
203: TMP = TMP + CABS1( A( I, J ) * X( J ) )
204: END DO
205: DO J = I+1, N
206: TMP = TMP + CABS1( A( J, I ) * X( J ) )
207: END DO
208: RWORK( I ) = TMP
209: ANORM = MAX( ANORM, TMP )
210: END DO
211: END IF
212: *
213: * Quick return if possible.
214: *
215: IF( N.EQ.0 ) THEN
216: ZLA_PORCOND_X = 1.0D+0
217: RETURN
218: ELSE IF( ANORM .EQ. 0.0D+0 ) THEN
219: RETURN
220: END IF
221: *
222: * Estimate the norm of inv(op(A)).
223: *
224: AINVNM = 0.0D+0
225: *
226: KASE = 0
227: 10 CONTINUE
228: CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
229: IF( KASE.NE.0 ) THEN
230: IF( KASE.EQ.2 ) THEN
231: *
232: * Multiply by R.
233: *
234: DO I = 1, N
235: WORK( I ) = WORK( I ) * RWORK( I )
236: END DO
237: *
238: IF ( UP ) THEN
239: CALL ZPOTRS( 'U', N, 1, AF, LDAF,
240: $ WORK, N, INFO )
241: ELSE
242: CALL ZPOTRS( 'L', N, 1, AF, LDAF,
243: $ WORK, N, INFO )
244: ENDIF
245: *
246: * Multiply by inv(X).
247: *
248: DO I = 1, N
249: WORK( I ) = WORK( I ) / X( I )
250: END DO
251: ELSE
252: *
1.5 bertrand 253: * Multiply by inv(X**H).
1.1 bertrand 254: *
255: DO I = 1, N
256: WORK( I ) = WORK( I ) / X( I )
257: END DO
258: *
259: IF ( UP ) THEN
260: CALL ZPOTRS( 'U', N, 1, AF, LDAF,
261: $ WORK, N, INFO )
262: ELSE
263: CALL ZPOTRS( 'L', N, 1, AF, LDAF,
264: $ WORK, N, INFO )
265: END IF
266: *
267: * Multiply by R.
268: *
269: DO I = 1, N
270: WORK( I ) = WORK( I ) * RWORK( I )
271: END DO
272: END IF
273: GO TO 10
274: END IF
275: *
276: * Compute the estimate of the reciprocal condition number.
277: *
278: IF( AINVNM .NE. 0.0D+0 )
279: $ ZLA_PORCOND_X = 1.0D+0 / AINVNM
280: *
281: RETURN
282: *
283: 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