161 SUBROUTINE sgebal( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
170 INTEGER ihi, ilo, info, lda, n
173 REAL a( lda, * ), scale( * )
180 parameter( zero = 0.0e+0, one = 1.0e+0 )
182 parameter( sclfac = 2.0e+0 )
184 parameter( factor = 0.95e+0 )
188 INTEGER i, ica, iexc, ira,
j, k, l, m
189 REAL 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(
'SGEBAL', -info )
228 IF(
lsame( job,
'N' ) )
THEN
235 IF(
lsame( job,
'S' ) )
249 CALL
sswap( l, a( 1,
j ), 1, a( 1, m ), 1 )
250 CALL
sswap( 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
320 c =
snrm2( l-k+1, a( k, i ), 1 )
321 r =
snrm2( l-k+1, a( i, k ), lda )
322 ica =
isamax( l, a( 1, i ), 1 )
323 ca = abs( a( ica, i ) )
324 ira =
isamax( n-k+1, a( i, k ), lda )
325 ra = abs( a( i, ira+k-1 ) )
329 IF( c.EQ.zero .OR. r.EQ.zero )
335 IF( c.GE.g .OR. max( f, c, ca ).GE.sfmax2 .OR.
336 $ min( r, g, ra ).LE.sfmin2 )go to 170
348 IF( g.LT.r .OR. max( r, ra ).GE.sfmax2 .OR.
349 $ min( f, c, g, ca ).LE.sfmin2 )go to 190
350 IF(
sisnan( c+f+ca+r+g+ra ) )
THEN
355 CALL
xerbla(
'SGEBAL', -info )
369 IF( ( c+r ).GE.factor*s )
371 IF( f.LT.one .AND. scale( i ).LT.one )
THEN
372 IF( f*scale( i ).LE.sfmin1 )
375 IF( f.GT.one .AND. scale( i ).GT.one )
THEN
376 IF( scale( i ).GE.sfmax1 / f )
380 scale( i ) = scale( i )*f
383 CALL
sscal( n-k+1, g, a( i, k ), lda )
384 CALL
sscal( l, f, a( 1, i ), 1 )
LOGICAL function lsame(CA, CB)
LSAME
INTEGER function isamax(N, SX, INCX)
ISAMAX
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
LOGICAL function sisnan(SIN)
SISNAN tests input for NaN.
subroutine sgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
SGEBAL
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
REAL function snrm2(N, X, INCX)
SNRM2
subroutine sscal(N, SA, SX, INCX)
SSCAL