Annotation of rpl/lapack/lapack/zla_syrcond_x.f, revision 1.6
1.6 ! bertrand 1: *> \brief \b ZLA_SYRCOND_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_SYRCOND_X + dependencies
! 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zla_syrcond_x.f">
! 11: *> [TGZ]</a>
! 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zla_syrcond_x.f">
! 13: *> [ZIP]</a>
! 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zla_syrcond_x.f">
! 15: *> [TXT]</a>
! 16: *> \endhtmlonly
! 17: *
! 18: * Definition:
! 19: * ===========
! 20: *
! 21: * DOUBLE PRECISION FUNCTION ZLA_SYRCOND_X( UPLO, N, A, LDA, AF,
! 22: * LDAF, IPIV, X, INFO,
! 23: * WORK, RWORK )
! 24: *
! 25: * .. Scalar Arguments ..
! 26: * CHARACTER UPLO
! 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_SYRCOND_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] 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 block diagonal matrix D and the multipliers used to
! 78: *> obtain the factor U or L as computed by ZSYTRF.
! 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] IPIV
! 88: *> \verbatim
! 89: *> IPIV is INTEGER array, dimension (N)
! 90: *> Details of the interchanges and the block structure of D
! 91: *> as determined by ZSYTRF.
! 92: *> \endverbatim
! 93: *>
! 94: *> \param[in] X
! 95: *> \verbatim
! 96: *> X is COMPLEX*16 array, dimension (N)
! 97: *> The vector X in the formula op(A) * diag(X).
! 98: *> \endverbatim
! 99: *>
! 100: *> \param[out] INFO
! 101: *> \verbatim
! 102: *> INFO is INTEGER
! 103: *> = 0: Successful exit.
! 104: *> i > 0: The ith argument is invalid.
! 105: *> \endverbatim
! 106: *>
! 107: *> \param[in] WORK
! 108: *> \verbatim
! 109: *> WORK is COMPLEX*16 array, dimension (2*N).
! 110: *> Workspace.
! 111: *> \endverbatim
! 112: *>
! 113: *> \param[in] RWORK
! 114: *> \verbatim
! 115: *> RWORK is DOUBLE PRECISION array, dimension (N).
! 116: *> Workspace.
! 117: *> \endverbatim
! 118: *
! 119: * Authors:
! 120: * ========
! 121: *
! 122: *> \author Univ. of Tennessee
! 123: *> \author Univ. of California Berkeley
! 124: *> \author Univ. of Colorado Denver
! 125: *> \author NAG Ltd.
! 126: *
! 127: *> \date November 2011
! 128: *
! 129: *> \ingroup complex16SYcomputational
! 130: *
! 131: * =====================================================================
1.1 bertrand 132: DOUBLE PRECISION FUNCTION ZLA_SYRCOND_X( UPLO, N, A, LDA, AF,
133: $ LDAF, IPIV, X, INFO,
134: $ WORK, RWORK )
135: *
1.6 ! bertrand 136: * -- LAPACK computational routine (version 3.4.0) --
! 137: * -- LAPACK is a software package provided by Univ. of Tennessee, --
! 138: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! 139: * November 2011
1.1 bertrand 140: *
141: * .. Scalar Arguments ..
142: CHARACTER UPLO
143: INTEGER N, LDA, LDAF, INFO
144: * ..
145: * .. Array Arguments ..
146: INTEGER IPIV( * )
147: COMPLEX*16 A( LDA, * ), AF( LDAF, * ), WORK( * ), X( * )
148: DOUBLE PRECISION RWORK( * )
149: * ..
150: *
151: * =====================================================================
152: *
153: * .. Local Scalars ..
154: INTEGER KASE
155: DOUBLE PRECISION AINVNM, ANORM, TMP
156: INTEGER I, J
157: LOGICAL UP
158: COMPLEX*16 ZDUM
159: * ..
160: * .. Local Arrays ..
161: INTEGER ISAVE( 3 )
162: * ..
163: * .. External Functions ..
164: LOGICAL LSAME
165: EXTERNAL LSAME
166: * ..
167: * .. External Subroutines ..
168: EXTERNAL ZLACN2, ZSYTRS, XERBLA
169: * ..
170: * .. Intrinsic Functions ..
171: INTRINSIC ABS, MAX
172: * ..
173: * .. Statement Functions ..
174: DOUBLE PRECISION CABS1
175: * ..
176: * .. Statement Function Definitions ..
177: CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
178: * ..
179: * .. Executable Statements ..
180: *
181: ZLA_SYRCOND_X = 0.0D+0
182: *
183: INFO = 0
184: IF( N.LT.0 ) THEN
185: INFO = -2
186: END IF
187: IF( INFO.NE.0 ) THEN
188: CALL XERBLA( 'ZLA_SYRCOND_X', -INFO )
189: RETURN
190: END IF
191: UP = .FALSE.
192: IF ( LSAME( UPLO, 'U' ) ) UP = .TRUE.
193: *
194: * Compute norm of op(A)*op2(C).
195: *
196: ANORM = 0.0D+0
197: IF ( UP ) THEN
198: DO I = 1, N
199: TMP = 0.0D+0
200: DO J = 1, I
201: TMP = TMP + CABS1( A( J, I ) * X( J ) )
202: END DO
203: DO J = I+1, N
204: TMP = TMP + CABS1( A( I, J ) * X( J ) )
205: END DO
206: RWORK( I ) = TMP
207: ANORM = MAX( ANORM, TMP )
208: END DO
209: ELSE
210: DO I = 1, N
211: TMP = 0.0D+0
212: DO J = 1, I
213: TMP = TMP + CABS1( A( I, J ) * X( J ) )
214: END DO
215: DO J = I+1, N
216: TMP = TMP + CABS1( A( J, I ) * X( J ) )
217: END DO
218: RWORK( I ) = TMP
219: ANORM = MAX( ANORM, TMP )
220: END DO
221: END IF
222: *
223: * Quick return if possible.
224: *
225: IF( N.EQ.0 ) THEN
226: ZLA_SYRCOND_X = 1.0D+0
227: RETURN
228: ELSE IF( ANORM .EQ. 0.0D+0 ) THEN
229: RETURN
230: END IF
231: *
232: * Estimate the norm of inv(op(A)).
233: *
234: AINVNM = 0.0D+0
235: *
236: KASE = 0
237: 10 CONTINUE
238: CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
239: IF( KASE.NE.0 ) THEN
240: IF( KASE.EQ.2 ) THEN
241: *
242: * Multiply by R.
243: *
244: DO I = 1, N
245: WORK( I ) = WORK( I ) * RWORK( I )
246: END DO
247: *
248: IF ( UP ) THEN
249: CALL ZSYTRS( 'U', N, 1, AF, LDAF, IPIV,
250: $ WORK, N, INFO )
251: ELSE
252: CALL ZSYTRS( 'L', N, 1, AF, LDAF, IPIV,
253: $ WORK, N, INFO )
254: ENDIF
255: *
256: * Multiply by inv(X).
257: *
258: DO I = 1, N
259: WORK( I ) = WORK( I ) / X( I )
260: END DO
261: ELSE
262: *
1.5 bertrand 263: * Multiply by inv(X**T).
1.1 bertrand 264: *
265: DO I = 1, N
266: WORK( I ) = WORK( I ) / X( I )
267: END DO
268: *
269: IF ( UP ) THEN
270: CALL ZSYTRS( 'U', N, 1, AF, LDAF, IPIV,
271: $ WORK, N, INFO )
272: ELSE
273: CALL ZSYTRS( 'L', N, 1, AF, LDAF, IPIV,
274: $ WORK, N, INFO )
275: END IF
276: *
277: * Multiply by R.
278: *
279: DO I = 1, N
280: WORK( I ) = WORK( I ) * RWORK( I )
281: END DO
282: END IF
283: GO TO 10
284: END IF
285: *
286: * Compute the estimate of the reciprocal condition number.
287: *
288: IF( AINVNM .NE. 0.0D+0 )
289: $ ZLA_SYRCOND_X = 1.0D+0 / AINVNM
290: *
291: RETURN
292: *
293: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zla_syrcond_x.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack