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 )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
DGEBAL
logical function lsame(CA, CB)
LSAME
subroutine dscal(N, DA, DX, INCX)
DSCAL
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
integer function idamax(N, DX, INCX)
IDAMAX
double precision function dnrm2(N, X, INCX)
DNRM2
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
logical function disnan(DIN)
DISNAN tests input for NaN.