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 )