Annotation of rpl/lapack/lapack/zsyequb.f, revision 1.5
1.5 ! bertrand 1: *> \brief \b ZSYEQUB
! 2: *
! 3: * =========== DOCUMENTATION ===========
! 4: *
! 5: * Online html documentation available at
! 6: * http://www.netlib.org/lapack/explore-html/
! 7: *
! 8: *> \htmlonly
! 9: *> Download ZSYEQUB + dependencies
! 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsyequb.f">
! 11: *> [TGZ]</a>
! 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsyequb.f">
! 13: *> [ZIP]</a>
! 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsyequb.f">
! 15: *> [TXT]</a>
! 16: *> \endhtmlonly
! 17: *
! 18: * Definition:
! 19: * ===========
! 20: *
! 21: * SUBROUTINE ZSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
! 22: *
! 23: * .. Scalar Arguments ..
! 24: * INTEGER INFO, LDA, N
! 25: * DOUBLE PRECISION AMAX, SCOND
! 26: * CHARACTER UPLO
! 27: * ..
! 28: * .. Array Arguments ..
! 29: * COMPLEX*16 A( LDA, * ), WORK( * )
! 30: * DOUBLE PRECISION S( * )
! 31: * ..
! 32: *
! 33: *
! 34: *> \par Purpose:
! 35: * =============
! 36: *>
! 37: *> \verbatim
! 38: *>
! 39: *> ZSYEQUB computes row and column scalings intended to equilibrate a
! 40: *> symmetric matrix A and reduce its condition number
! 41: *> (with respect to the two-norm). S contains the scale factors,
! 42: *> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
! 43: *> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
! 44: *> choice of S puts the condition number of B within a factor N of the
! 45: *> smallest possible condition number over all possible diagonal
! 46: *> scalings.
! 47: *> \endverbatim
! 48: *
! 49: * Arguments:
! 50: * ==========
! 51: *
! 52: *> \param[in] UPLO
! 53: *> \verbatim
! 54: *> UPLO is CHARACTER*1
! 55: *> Specifies whether the details of the factorization are stored
! 56: *> as an upper or lower triangular matrix.
! 57: *> = 'U': Upper triangular, form is A = U*D*U**T;
! 58: *> = 'L': Lower triangular, form is A = L*D*L**T.
! 59: *> \endverbatim
! 60: *>
! 61: *> \param[in] N
! 62: *> \verbatim
! 63: *> N is INTEGER
! 64: *> The order of the matrix A. N >= 0.
! 65: *> \endverbatim
! 66: *>
! 67: *> \param[in] A
! 68: *> \verbatim
! 69: *> A is COMPLEX*16 array, dimension (LDA,N)
! 70: *> The N-by-N symmetric matrix whose scaling
! 71: *> factors are to be computed. Only the diagonal elements of A
! 72: *> are referenced.
! 73: *> \endverbatim
! 74: *>
! 75: *> \param[in] LDA
! 76: *> \verbatim
! 77: *> LDA is INTEGER
! 78: *> The leading dimension of the array A. LDA >= max(1,N).
! 79: *> \endverbatim
! 80: *>
! 81: *> \param[out] S
! 82: *> \verbatim
! 83: *> S is DOUBLE PRECISION array, dimension (N)
! 84: *> If INFO = 0, S contains the scale factors for A.
! 85: *> \endverbatim
! 86: *>
! 87: *> \param[out] SCOND
! 88: *> \verbatim
! 89: *> SCOND is DOUBLE PRECISION
! 90: *> If INFO = 0, S contains the ratio of the smallest S(i) to
! 91: *> the largest S(i). If SCOND >= 0.1 and AMAX is neither too
! 92: *> large nor too small, it is not worth scaling by S.
! 93: *> \endverbatim
! 94: *>
! 95: *> \param[out] AMAX
! 96: *> \verbatim
! 97: *> AMAX is DOUBLE PRECISION
! 98: *> Absolute value of largest matrix element. If AMAX is very
! 99: *> close to overflow or very close to underflow, the matrix
! 100: *> should be scaled.
! 101: *> \endverbatim
! 102: *>
! 103: *> \param[out] WORK
! 104: *> \verbatim
! 105: *> WORK is COMPLEX*16 array, dimension (3*N)
! 106: *> \endverbatim
! 107: *>
! 108: *> \param[out] INFO
! 109: *> \verbatim
! 110: *> INFO is INTEGER
! 111: *> = 0: successful exit
! 112: *> < 0: if INFO = -i, the i-th argument had an illegal value
! 113: *> > 0: if INFO = i, the i-th diagonal element is nonpositive.
! 114: *> \endverbatim
! 115: *
! 116: * Authors:
! 117: * ========
! 118: *
! 119: *> \author Univ. of Tennessee
! 120: *> \author Univ. of California Berkeley
! 121: *> \author Univ. of Colorado Denver
! 122: *> \author NAG Ltd.
! 123: *
! 124: *> \date November 2011
! 125: *
! 126: *> \ingroup complex16SYcomputational
! 127: *
! 128: *> \par References:
! 129: * ================
! 130: *>
! 131: *> Livne, O.E. and Golub, G.H., "Scaling by Binormalization", \n
! 132: *> Numerical Algorithms, vol. 35, no. 1, pp. 97-120, January 2004. \n
! 133: *> DOI 10.1023/B:NUMA.0000016606.32820.69 \n
! 134: *> Tech report version: http://ruready.utah.edu/archive/papers/bin.pdf
! 135: *>
! 136: * =====================================================================
1.1 bertrand 137: SUBROUTINE ZSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
138: *
1.5 ! 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: INTEGER INFO, LDA, N
146: DOUBLE PRECISION AMAX, SCOND
147: CHARACTER UPLO
148: * ..
149: * .. Array Arguments ..
150: COMPLEX*16 A( LDA, * ), WORK( * )
151: DOUBLE PRECISION S( * )
152: * ..
153: *
154: * =====================================================================
155: *
156: * .. Parameters ..
157: DOUBLE PRECISION ONE, ZERO
158: PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 )
159: INTEGER MAX_ITER
160: PARAMETER ( MAX_ITER = 100 )
161: * ..
162: * .. Local Scalars ..
163: INTEGER I, J, ITER
164: DOUBLE PRECISION AVG, STD, TOL, C0, C1, C2, T, U, SI, D, BASE,
165: $ SMIN, SMAX, SMLNUM, BIGNUM, SCALE, SUMSQ
166: LOGICAL UP
167: COMPLEX*16 ZDUM
168: * ..
169: * .. External Functions ..
170: DOUBLE PRECISION DLAMCH
171: LOGICAL LSAME
172: EXTERNAL DLAMCH, LSAME
173: * ..
174: * .. External Subroutines ..
175: EXTERNAL ZLASSQ
176: * ..
177: * .. Intrinsic Functions ..
178: INTRINSIC ABS, DBLE, DIMAG, INT, LOG, MAX, MIN, SQRT
179: * ..
180: * .. Statement Functions ..
181: DOUBLE PRECISION CABS1
182: * ..
183: * Statement Function Definitions
184: CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
185: * ..
186: * .. Executable Statements ..
187: *
188: * Test the input parameters.
189: *
190: INFO = 0
191: IF ( .NOT. ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN
192: INFO = -1
193: ELSE IF ( N .LT. 0 ) THEN
194: INFO = -2
195: ELSE IF ( LDA .LT. MAX( 1, N ) ) THEN
196: INFO = -4
197: END IF
198: IF ( INFO .NE. 0 ) THEN
199: CALL XERBLA( 'ZSYEQUB', -INFO )
200: RETURN
201: END IF
202:
203: UP = LSAME( UPLO, 'U' )
204: AMAX = ZERO
205: *
206: * Quick return if possible.
207: *
208: IF ( N .EQ. 0 ) THEN
209: SCOND = ONE
210: RETURN
211: END IF
212:
213: DO I = 1, N
214: S( I ) = ZERO
215: END DO
216:
217: AMAX = ZERO
218: IF ( UP ) THEN
219: DO J = 1, N
220: DO I = 1, J-1
221: S( I ) = MAX( S( I ), CABS1( A( I, J ) ) )
222: S( J ) = MAX( S( J ), CABS1( A( I, J ) ) )
223: AMAX = MAX( AMAX, CABS1( A( I, J ) ) )
224: END DO
225: S( J ) = MAX( S( J ), CABS1( A( J, J) ) )
226: AMAX = MAX( AMAX, CABS1( A( J, J ) ) )
227: END DO
228: ELSE
229: DO J = 1, N
230: S( J ) = MAX( S( J ), CABS1( A( J, J ) ) )
231: AMAX = MAX( AMAX, CABS1( A( J, J ) ) )
232: DO I = J+1, N
233: S( I ) = MAX( S( I ), CABS1( A( I, J ) ) )
234: S( J ) = MAX( S( J ), CABS1 (A( I, J ) ) )
235: AMAX = MAX( AMAX, CABS1( A( I, J ) ) )
236: END DO
237: END DO
238: END IF
239: DO J = 1, N
240: S( J ) = 1.0D+0 / S( J )
241: END DO
242:
243: TOL = ONE / SQRT( 2.0D0 * N )
244:
245: DO ITER = 1, MAX_ITER
246: SCALE = 0.0D+0
247: SUMSQ = 0.0D+0
248: * beta = |A|s
249: DO I = 1, N
250: WORK( I ) = ZERO
251: END DO
252: IF ( UP ) THEN
253: DO J = 1, N
254: DO I = 1, J-1
255: T = CABS1( A( I, J ) )
256: WORK( I ) = WORK( I ) + CABS1( A( I, J ) ) * S( J )
257: WORK( J ) = WORK( J ) + CABS1( A( I, J ) ) * S( I )
258: END DO
259: WORK( J ) = WORK( J ) + CABS1( A( J, J ) ) * S( J )
260: END DO
261: ELSE
262: DO J = 1, N
263: WORK( J ) = WORK( J ) + CABS1( A( J, J ) ) * S( J )
264: DO I = J+1, N
265: T = CABS1( A( I, J ) )
266: WORK( I ) = WORK( I ) + CABS1( A( I, J ) ) * S( J )
267: WORK( J ) = WORK( J ) + CABS1( A( I, J ) ) * S( I )
268: END DO
269: END DO
270: END IF
271:
272: * avg = s^T beta / n
273: AVG = 0.0D+0
274: DO I = 1, N
275: AVG = AVG + S( I )*WORK( I )
276: END DO
277: AVG = AVG / N
278:
279: STD = 0.0D+0
280: DO I = N+1, 2*N
281: WORK( I ) = S( I-N ) * WORK( I-N ) - AVG
282: END DO
283: CALL ZLASSQ( N, WORK( N+1 ), 1, SCALE, SUMSQ )
284: STD = SCALE * SQRT( SUMSQ / N )
285:
286: IF ( STD .LT. TOL * AVG ) GOTO 999
287:
288: DO I = 1, N
289: T = CABS1( A( I, I ) )
290: SI = S( I )
291: C2 = ( N-1 ) * T
292: C1 = ( N-2 ) * ( WORK( I ) - T*SI )
293: C0 = -(T*SI)*SI + 2*WORK( I )*SI - N*AVG
294: D = C1*C1 - 4*C0*C2
295:
296: IF ( D .LE. 0 ) THEN
297: INFO = -1
298: RETURN
299: END IF
300: SI = -2*C0 / ( C1 + SQRT( D ) )
301:
302: D = SI - S( I )
303: U = ZERO
304: IF ( UP ) THEN
305: DO J = 1, I
306: T = CABS1( A( J, I ) )
307: U = U + S( J )*T
308: WORK( J ) = WORK( J ) + D*T
309: END DO
310: DO J = I+1,N
311: T = CABS1( A( I, J ) )
312: U = U + S( J )*T
313: WORK( J ) = WORK( J ) + D*T
314: END DO
315: ELSE
316: DO J = 1, I
317: T = CABS1( A( I, J ) )
318: U = U + S( J )*T
319: WORK( J ) = WORK( J ) + D*T
320: END DO
321: DO J = I+1,N
322: T = CABS1( A( J, I ) )
323: U = U + S( J )*T
324: WORK( J ) = WORK( J ) + D*T
325: END DO
326: END IF
327: AVG = AVG + ( U + WORK( I ) ) * D / N
328: S( I ) = SI
329: END DO
330: END DO
331:
332: 999 CONTINUE
333:
334: SMLNUM = DLAMCH( 'SAFEMIN' )
335: BIGNUM = ONE / SMLNUM
336: SMIN = BIGNUM
337: SMAX = ZERO
338: T = ONE / SQRT( AVG )
339: BASE = DLAMCH( 'B' )
340: U = ONE / LOG( BASE )
341: DO I = 1, N
342: S( I ) = BASE ** INT( U * LOG( S( I ) * T ) )
343: SMIN = MIN( SMIN, S( I ) )
344: SMAX = MAX( SMAX, S( I ) )
345: END DO
346: SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM )
347: *
348: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zsyequb.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack