161 SUBROUTINE zgebal( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
170 INTEGER ihi, ilo, info, lda, n
173 DOUBLE PRECISION scale( * )
174 COMPLEX*16 a( lda, * )
180 DOUBLE PRECISION zero, one
181 parameter( zero = 0.0d+0, one = 1.0d+0 )
182 DOUBLE PRECISION sclfac
183 parameter( sclfac = 2.0d+0 )
184 DOUBLE PRECISION factor
185 parameter( factor = 0.95d+0 )
189 INTEGER i, ica, iexc, ira,
j, k, l, m
190 DOUBLE PRECISION c, ca, f, g, r, ra, s, sfmax1, sfmax2, sfmin1,
204 INTRINSIC abs, dble, dimag, max, min
207 DOUBLE PRECISION cabs1
210 cabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( cdum ) )
217 IF( .NOT.
lsame( job,
'N' ) .AND. .NOT.
lsame( job,
'P' ) .AND.
218 $ .NOT.
lsame( job,
'S' ) .AND. .NOT.
lsame( job,
'B' ) )
THEN
220 ELSE IF( n.LT.0 )
THEN
222 ELSE IF( lda.LT.max( 1, n ) )
THEN
226 CALL
xerbla(
'ZGEBAL', -info )
236 IF(
lsame( job,
'N' ) )
THEN
243 IF(
lsame( job,
'S' ) )
257 CALL
zswap( l, a( 1,
j ), 1, a( 1, m ), 1 )
258 CALL
zswap( n-k+1, a(
j, k ), lda, a( m, k ), lda )
276 IF( dble( a(
j, i ) ).NE.zero .OR. dimag( a(
j, i ) ).NE.
298 IF( dble( a( i,
j ) ).NE.zero .OR. dimag( a( i,
j ) ).NE.
312 IF(
lsame( job,
'P' ) )
320 sfmax1 = one / sfmin1
321 sfmin2 = sfmin1*sclfac
322 sfmax2 = one / sfmin2
328 c =
dznrm2( l-k+1, a( k, i ), 1 )
329 r =
dznrm2( l-k+1, a( i, k ), lda )
330 ica =
izamax( l, a( 1, i ), 1 )
331 ca = abs( a( ica, i ) )
332 ira =
izamax( n-k+1, a( i, k ), lda )
333 ra = abs( a( i, ira+k-1 ) )
337 IF( c.EQ.zero .OR. r.EQ.zero )
343 IF( c.GE.g .OR. max( f, c, ca ).GE.sfmax2 .OR.
344 $ min( r, g, ra ).LE.sfmin2 )go to 170
345 IF(
disnan( c+f+ca+r+g+ra ) )
THEN
350 CALL
xerbla(
'ZGEBAL', -info )
364 IF( g.LT.r .OR. max( r, ra ).GE.sfmax2 .OR.
365 $ min( f, c, g, ca ).LE.sfmin2 )go to 190
377 IF( ( c+r ).GE.factor*s )
379 IF( f.LT.one .AND. scale( i ).LT.one )
THEN
380 IF( f*scale( i ).LE.sfmin1 )
383 IF( f.GT.one .AND. scale( i ).GT.one )
THEN
384 IF( scale( i ).GE.sfmax1 / f )
388 scale( i ) = scale( i )*f
391 CALL
zdscal( n-k+1, g, a( i, k ), lda )
392 CALL
zdscal( l, f, a( 1, i ), 1 )
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
LOGICAL function lsame(CA, CB)
LSAME
subroutine zgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
ZGEBAL
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine xerbla(SRNAME, INFO)
XERBLA
LOGICAL function disnan(DIN)
DISNAN tests input for NaN.
DOUBLE PRECISION function dznrm2(N, X, INCX)
DZNRM2
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
INTEGER function izamax(N, ZX, INCX)
IZAMAX