162 SUBROUTINE cgebal( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
171 INTEGER ihi, ilo, info, lda, n
182 parameter( zero = 0.0e+0, one = 1.0e+0 )
184 parameter( sclfac = 2.0e+0 )
186 parameter( factor = 0.95e+0 )
190 INTEGER i, ica, iexc, ira,
j, k, l, m
191 REAL c, ca, f, g, r, ra, s, sfmax1, sfmax2, sfmin1,
205 INTRINSIC abs, aimag, max, min, real
211 cabs1( cdum ) = abs(
REAL( CDUM ) ) + abs( aimag( cdum ) )
218 IF( .NOT.
lsame( job,
'N' ) .AND. .NOT.
lsame( job,
'P' ) .AND.
219 $ .NOT.
lsame( job,
'S' ) .AND. .NOT.
lsame( job,
'B' ) )
THEN
221 ELSE IF( n.LT.0 )
THEN
223 ELSE IF( lda.LT.max( 1, n ) )
THEN
227 CALL
xerbla(
'CGEBAL', -info )
237 IF(
lsame( job,
'N' ) )
THEN
244 IF(
lsame( job,
'S' ) )
258 CALL
cswap( l, a( 1,
j ), 1, a( 1, m ), 1 )
259 CALL
cswap( n-k+1, a(
j, k ), lda, a( m, k ), lda )
277 IF(
REAL( A( J, I ) ).NE.zero .OR. aimag( a(
j, i ) ).NE.
299 IF(
REAL( A( I, J ) ).NE.zero .OR. aimag( a( i,
j ) ).NE.
313 IF(
lsame( job,
'P' ) )
321 sfmax1 = one / sfmin1
322 sfmin2 = sfmin1*sclfac
323 sfmax2 = one / sfmin2
329 c =
scnrm2( l-k+1, a( k, i ), 1 )
330 r =
scnrm2( l-k+1, a( i , k ), lda )
331 ica =
icamax( l, a( 1, i ), 1 )
332 ca = abs( a( ica, i ) )
333 ira =
icamax( n-k+1, a( i, k ), lda )
334 ra = abs( a( i, ira+k-1 ) )
338 IF( c.EQ.zero .OR. r.EQ.zero )
344 IF( c.GE.g .OR. max( f, c, ca ).GE.sfmax2 .OR.
345 $ min( r, g, ra ).LE.sfmin2 )go to 170
346 IF(
sisnan( c+f+ca+r+g+ra ) )
THEN
351 CALL
xerbla(
'CGEBAL', -info )
365 IF( g.LT.r .OR. max( r, ra ).GE.sfmax2 .OR.
366 $ min( f, c, g, ca ).LE.sfmin2 )go to 190
378 IF( ( c+r ).GE.factor*s )
380 IF( f.LT.one .AND. scale( i ).LT.one )
THEN
381 IF( f*scale( i ).LE.sfmin1 )
384 IF( f.GT.one .AND. scale( i ).GT.one )
THEN
385 IF( scale( i ).GE.sfmax1 / f )
389 scale( i ) = scale( i )*f
392 CALL
csscal( n-k+1, g, a( i, k ), lda )
393 CALL
csscal( l, f, a( 1, i ), 1 )
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
LOGICAL function sisnan(SIN)
SISNAN tests input for NaN.
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine cgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
CGEBAL
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
REAL function scnrm2(N, X, INCX)
SCNRM2
subroutine csscal(N, SA, CX, INCX)
CSSCAL
INTEGER function icamax(N, CX, INCX)
ICAMAX