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