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,
193 LOGICAL DISNAN, LSAME
195 DOUBLE PRECISION DLAMCH, DNRM2
196 EXTERNAL disnan, lsame, idamax, dlamch, dnrm2
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' ) )
311 sfmin1 = dlamch(
'S' ) / dlamch(
'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 )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
DGEBAL
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP