161 SUBROUTINE dgebal( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
170 INTEGER ihi, ilo, info, lda, n
173 DOUBLE PRECISION a( lda, * ), scale( * )
179 DOUBLE PRECISION zero, one
180 parameter( zero = 0.0d+0, one = 1.0d+0 )
181 DOUBLE PRECISION sclfac
182 parameter( sclfac = 2.0d+0 )
183 DOUBLE PRECISION factor
184 parameter( factor = 0.95d+0 )
188 INTEGER i, ica, iexc, ira,
j, k, l, m
189 DOUBLE PRECISION c, ca, f, g, r, ra, s, sfmax1, sfmax2, sfmin1,
202 INTRINSIC abs, max, min
209 IF( .NOT.
lsame( job,
'N' ) .AND. .NOT.
lsame( job,
'P' ) .AND.
210 $ .NOT.
lsame( job,
'S' ) .AND. .NOT.
lsame( job,
'B' ) )
THEN
212 ELSE IF( n.LT.0 )
THEN
214 ELSE IF( lda.LT.max( 1, n ) )
THEN
218 CALL
xerbla(
'DGEBAL', -info )
228 IF(
lsame( job,
'N' ) )
THEN
235 IF(
lsame( job,
'S' ) )
249 CALL
dswap( l, a( 1,
j ), 1, a( 1, m ), 1 )
250 CALL
dswap( n-k+1, a(
j, k ), lda, a( m, k ), lda )
268 IF( a(
j, i ).NE.zero )
290 IF( a( i,
j ).NE.zero )
304 IF(
lsame( job,
'P' ) )
312 sfmax1 = one / sfmin1
313 sfmin2 = sfmin1*sclfac
314 sfmax2 = one / sfmin2
321 c =
dnrm2( l-k+1, a( k, i ), 1 )
322 r =
dnrm2( l-k+1, a( i, k ), lda )
323 ica =
idamax( l, a( 1, i ), 1 )
324 ca = abs( a( ica, i ) )
325 ira =
idamax( n-k+1, a( i, k ), lda )
326 ra = abs( a( i, ira+k-1 ) )
330 IF( c.EQ.zero .OR. r.EQ.zero )
336 IF( c.GE.g .OR. max( f, c, ca ).GE.sfmax2 .OR.
337 $ min( r, g, ra ).LE.sfmin2 )go to 170
338 IF(
disnan( c+f+ca+r+g+ra ) )
THEN
343 CALL
xerbla(
'DGEBAL', -info )
357 IF( g.LT.r .OR. max( r, ra ).GE.sfmax2 .OR.
358 $ min( f, c, g, ca ).LE.sfmin2 )go to 190
370 IF( ( c+r ).GE.factor*s )
372 IF( f.LT.one .AND. scale( i ).LT.one )
THEN
373 IF( f*scale( i ).LE.sfmin1 )
376 IF( f.GT.one .AND. scale( i ).GT.one )
THEN
377 IF( scale( i ).GE.sfmax1 / f )
381 scale( i ) = scale( i )*f
384 CALL
dscal( n-k+1, g, a( i, k ), lda )
385 CALL
dscal( l, f, a( 1, i ), 1 )