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,
196 LOGICAL SISNAN, LSAME
199 EXTERNAL sisnan, lsame, icamax, slamch, scnrm2
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' ) )
320 sfmin1 = slamch(
'S' ) / slamch(
'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 )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine cgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
CGEBAL
subroutine csscal(N, SA, CX, INCX)
CSSCAL