127 SUBROUTINE cheequb( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
140 COMPLEX a( lda, * ), work( * )
148 parameter( one = 1.0e+0, zero = 0.0e+0 )
150 parameter( max_iter = 100 )
154 REAL avg, std, tol, c0, c1, c2, t, u, si, d,
155 $ base, smin, smax, smlnum, bignum, scale, sumsq
168 INTRINSIC abs, aimag, int, log, max, min,
REAL, sqrt
174 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( aimag( zdum ) )
179 IF (.NOT. (
lsame( uplo,
'U' ) .OR.
lsame( uplo,
'L' ) ) )
THEN
181 ELSE IF ( n .LT. 0 )
THEN
183 ELSE IF ( lda .LT. max( 1, n ) )
THEN
186 IF ( info .NE. 0 )
THEN
187 CALL
xerbla(
'CHEEQUB', -info )
191 up =
lsame( uplo,
'U' )
209 s( i ) = max( s( i ), cabs1( a( i,
j ) ) )
210 s(
j ) = max( s(
j ), cabs1( a( i,
j ) ) )
211 amax = max( amax, cabs1( a( i,
j ) ) )
213 s(
j ) = max( s(
j ), cabs1( a(
j,
j ) ) )
214 amax = max( amax, cabs1( a(
j,
j ) ) )
218 s(
j ) = max( s(
j ), cabs1( a(
j,
j ) ) )
219 amax = max( amax, cabs1( a(
j,
j ) ) )
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 ) ) )
228 s(
j ) = 1.0 / s(
j )
231 tol = one / sqrt( 2.0e0 * n )
233 DO iter = 1, max_iter
243 t = cabs1( a( i,
j ) )
244 work( i ) = work( i ) + cabs1( a( i,
j ) ) * s(
j )
245 work(
j ) = work(
j ) + cabs1( a( i,
j ) ) * s( i )
247 work(
j ) = work(
j ) + cabs1( a(
j,
j ) ) * s(
j )
251 work(
j ) = work(
j ) + cabs1( a(
j,
j ) ) * s(
j )
253 t = cabs1( a( i,
j ) )
254 work( i ) = work( i ) + cabs1( a( i,
j ) ) * s(
j )
255 work(
j ) = work(
j ) + cabs1( a( i,
j ) ) * s( i )
263 avg = avg + s( i )*work( i )
269 work( i ) = s( i-2*n ) * work( i-2*n ) - avg
271 CALL
classq( n, work( 2*n+1 ), 1, scale, sumsq )
272 std = scale * sqrt( sumsq / n )
274 IF ( std .LT. tol * avg ) goto 999
277 t = cabs1( a( i, i ) )
280 c1 = ( n-2 ) * ( work( i ) - t*si )
281 c0 = -(t*si)*si + 2*work( i )*si - n*avg
288 si = -2*c0 / ( c1 + sqrt( d ) )
294 t = cabs1( a(
j, i ) )
296 work(
j ) = work(
j ) + d*t
299 t = cabs1( a( i,
j ) )
301 work(
j ) = work(
j ) + d*t
305 t = cabs1( a( i,
j ) )
307 work(
j ) = work(
j ) + d*t
310 t = cabs1( a(
j, i ) )
312 work(
j ) = work(
j ) + d*t
315 avg = avg + ( u + work( i ) ) * d / n
323 smlnum =
slamch(
'SAFEMIN' )
324 bignum = one / smlnum
327 t = one / sqrt( avg )
329 u = one / log( base )
331 s( i ) = base ** int( u * log( s( i ) * t ) )
332 smin = min( smin, s( i ) )
333 smax = max( smax, s( i ) )
335 scond = max( smin, smlnum ) / min( smax, bignum )
LOGICAL function lsame(CA, CB)
LSAME
subroutine cheequb(UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO)
CHEEQUB
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine classq(N, X, INCX, SCALE, SUMSQ)
CLASSQ updates a sum of squares represented in scaled form.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j