Annotation of rpl/lapack/lapack/zla_gercond_x.f, revision 1.6
1.6 ! bertrand 1: *> \brief \b ZLA_GERCOND_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_GERCOND_X + dependencies
! 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zla_gercond_x.f">
! 11: *> [TGZ]</a>
! 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zla_gercond_x.f">
! 13: *> [ZIP]</a>
! 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zla_gercond_x.f">
! 15: *> [TXT]</a>
! 16: *> \endhtmlonly
! 17: *
! 18: * Definition:
! 19: * ===========
! 20: *
! 21: * DOUBLE PRECISION FUNCTION ZLA_GERCOND_X( TRANS, N, A, LDA, AF,
! 22: * LDAF, IPIV, X, INFO,
! 23: * WORK, RWORK )
! 24: *
! 25: * .. Scalar Arguments ..
! 26: * CHARACTER TRANS
! 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: * ..
! 34: *
! 35: *
! 36: *> \par Purpose:
! 37: * =============
! 38: *>
! 39: *> \verbatim
! 40: *>
! 41: *> ZLA_GERCOND_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] TRANS
! 49: *> \verbatim
! 50: *> TRANS is CHARACTER*1
! 51: *> Specifies the form of the system of equations:
! 52: *> = 'N': A * X = B (No transpose)
! 53: *> = 'T': A**T * X = B (Transpose)
! 54: *> = 'C': A**H * X = B (Conjugate Transpose = Transpose)
! 55: *> \endverbatim
! 56: *>
! 57: *> \param[in] N
! 58: *> \verbatim
! 59: *> N is INTEGER
! 60: *> The number of linear equations, i.e., the order of the
! 61: *> matrix A. N >= 0.
! 62: *> \endverbatim
! 63: *>
! 64: *> \param[in] A
! 65: *> \verbatim
! 66: *> A is COMPLEX*16 array, dimension (LDA,N)
! 67: *> On entry, the N-by-N matrix A.
! 68: *> \endverbatim
! 69: *>
! 70: *> \param[in] LDA
! 71: *> \verbatim
! 72: *> LDA is INTEGER
! 73: *> The leading dimension of the array A. LDA >= max(1,N).
! 74: *> \endverbatim
! 75: *>
! 76: *> \param[in] AF
! 77: *> \verbatim
! 78: *> AF is COMPLEX*16 array, dimension (LDAF,N)
! 79: *> The factors L and U from the factorization
! 80: *> A = P*L*U as computed by ZGETRF.
! 81: *> \endverbatim
! 82: *>
! 83: *> \param[in] LDAF
! 84: *> \verbatim
! 85: *> LDAF is INTEGER
! 86: *> The leading dimension of the array AF. LDAF >= max(1,N).
! 87: *> \endverbatim
! 88: *>
! 89: *> \param[in] IPIV
! 90: *> \verbatim
! 91: *> IPIV is INTEGER array, dimension (N)
! 92: *> The pivot indices from the factorization A = P*L*U
! 93: *> as computed by ZGETRF; row i of the matrix was interchanged
! 94: *> with row IPIV(i).
! 95: *> \endverbatim
! 96: *>
! 97: *> \param[in] X
! 98: *> \verbatim
! 99: *> X is COMPLEX*16 array, dimension (N)
! 100: *> The vector X in the formula op(A) * diag(X).
! 101: *> \endverbatim
! 102: *>
! 103: *> \param[out] INFO
! 104: *> \verbatim
! 105: *> INFO is INTEGER
! 106: *> = 0: Successful exit.
! 107: *> i > 0: The ith argument is invalid.
! 108: *> \endverbatim
! 109: *>
! 110: *> \param[in] WORK
! 111: *> \verbatim
! 112: *> WORK is COMPLEX*16 array, dimension (2*N).
! 113: *> Workspace.
! 114: *> \endverbatim
! 115: *>
! 116: *> \param[in] RWORK
! 117: *> \verbatim
! 118: *> RWORK is DOUBLE PRECISION array, dimension (N).
! 119: *> Workspace.
! 120: *> \endverbatim
! 121: *
! 122: * Authors:
! 123: * ========
! 124: *
! 125: *> \author Univ. of Tennessee
! 126: *> \author Univ. of California Berkeley
! 127: *> \author Univ. of Colorado Denver
! 128: *> \author NAG Ltd.
! 129: *
! 130: *> \date November 2011
! 131: *
! 132: *> \ingroup complex16GEcomputational
! 133: *
! 134: * =====================================================================
1.1 bertrand 135: DOUBLE PRECISION FUNCTION ZLA_GERCOND_X( TRANS, N, A, LDA, AF,
136: $ LDAF, IPIV, X, INFO,
137: $ WORK, RWORK )
138: *
1.6 ! bertrand 139: * -- LAPACK computational routine (version 3.4.0) --
! 140: * -- LAPACK is a software package provided by Univ. of Tennessee, --
! 141: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! 142: * November 2011
1.1 bertrand 143: *
144: * .. Scalar Arguments ..
145: CHARACTER TRANS
146: INTEGER N, LDA, LDAF, INFO
147: * ..
148: * .. Array Arguments ..
149: INTEGER IPIV( * )
150: COMPLEX*16 A( LDA, * ), AF( LDAF, * ), WORK( * ), X( * )
151: DOUBLE PRECISION RWORK( * )
152: * ..
153: *
154: * =====================================================================
155: *
156: * .. Local Scalars ..
157: LOGICAL NOTRANS
158: INTEGER KASE
159: DOUBLE PRECISION AINVNM, ANORM, TMP
160: INTEGER I, J
161: COMPLEX*16 ZDUM
162: * ..
163: * .. Local Arrays ..
164: INTEGER ISAVE( 3 )
165: * ..
166: * .. External Functions ..
167: LOGICAL LSAME
168: EXTERNAL LSAME
169: * ..
170: * .. External Subroutines ..
171: EXTERNAL ZLACN2, ZGETRS, XERBLA
172: * ..
173: * .. Intrinsic Functions ..
174: INTRINSIC ABS, MAX, REAL, DIMAG
175: * ..
176: * .. Statement Functions ..
177: DOUBLE PRECISION CABS1
178: * ..
179: * .. Statement Function Definitions ..
180: CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
181: * ..
182: * .. Executable Statements ..
183: *
184: ZLA_GERCOND_X = 0.0D+0
185: *
186: INFO = 0
187: NOTRANS = LSAME( TRANS, 'N' )
188: IF ( .NOT. NOTRANS .AND. .NOT. LSAME( TRANS, 'T' ) .AND. .NOT.
189: $ LSAME( TRANS, 'C' ) ) THEN
190: INFO = -1
191: ELSE IF( N.LT.0 ) THEN
192: INFO = -2
193: END IF
194: IF( INFO.NE.0 ) THEN
195: CALL XERBLA( 'ZLA_GERCOND_X', -INFO )
196: RETURN
197: END IF
198: *
199: * Compute norm of op(A)*op2(C).
200: *
201: ANORM = 0.0D+0
202: IF ( NOTRANS ) THEN
203: DO I = 1, N
204: TMP = 0.0D+0
205: DO J = 1, N
206: TMP = TMP + CABS1( A( I, J ) * X( J ) )
207: END DO
208: RWORK( I ) = TMP
209: ANORM = MAX( ANORM, TMP )
210: END DO
211: ELSE
212: DO I = 1, N
213: TMP = 0.0D+0
214: DO J = 1, N
215: TMP = TMP + CABS1( A( J, I ) * X( J ) )
216: END DO
217: RWORK( I ) = TMP
218: ANORM = MAX( ANORM, TMP )
219: END DO
220: END IF
221: *
222: * Quick return if possible.
223: *
224: IF( N.EQ.0 ) THEN
225: ZLA_GERCOND_X = 1.0D+0
226: RETURN
227: ELSE IF( ANORM .EQ. 0.0D+0 ) THEN
228: RETURN
229: END IF
230: *
231: * Estimate the norm of inv(op(A)).
232: *
233: AINVNM = 0.0D+0
234: *
235: KASE = 0
236: 10 CONTINUE
237: CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
238: IF( KASE.NE.0 ) THEN
239: IF( KASE.EQ.2 ) THEN
240: * Multiply by R.
241: DO I = 1, N
242: WORK( I ) = WORK( I ) * RWORK( I )
243: END DO
244: *
245: IF ( NOTRANS ) THEN
246: CALL ZGETRS( 'No transpose', N, 1, AF, LDAF, IPIV,
247: $ WORK, N, INFO )
248: ELSE
249: CALL ZGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV,
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 ( NOTRANS ) THEN
267: CALL ZGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV,
268: $ WORK, N, INFO )
269: ELSE
270: CALL ZGETRS( 'No transpose', N, 1, AF, LDAF, IPIV,
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_GERCOND_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_gercond_x.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack