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