147 SUBROUTINE zgbcon( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND,
148 $ work, rwork, info )
157 INTEGER info, kl, ku, ldab, n
158 DOUBLE PRECISION anorm, rcond
162 DOUBLE PRECISION rwork( * )
163 COMPLEX*16 ab( ldab, * ), work( * )
169 DOUBLE PRECISION one, zero
170 parameter( one = 1.0d+0, zero = 0.0d+0 )
173 LOGICAL lnoti, onenrm
175 INTEGER ix, j, jp, kase, kase1, kd, lm
176 DOUBLE PRECISION ainvnm, scale, smlnum
193 INTRINSIC abs, dble, dimag, min
196 DOUBLE PRECISION cabs1
199 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
206 onenrm = norm.EQ.
'1' .OR.
lsame( norm,
'O' )
207 IF( .NOT.onenrm .AND. .NOT.
lsame( norm,
'I' ) )
THEN
209 ELSE IF( n.LT.0 )
THEN
211 ELSE IF( kl.LT.0 )
THEN
213 ELSE IF( ku.LT.0 )
THEN
215 ELSE IF( ldab.LT.2*kl+ku+1 )
THEN
217 ELSE IF( anorm.LT.zero )
THEN
221 CALL
xerbla(
'ZGBCON', -info )
231 ELSE IF( anorm.EQ.zero )
THEN
235 smlnum =
dlamch(
'Safe minimum' )
250 CALL
zlacn2( n, work( n+1 ), work, ainvnm, kase, isave )
252 IF( kase.EQ.kase1 )
THEN
262 work( jp ) = work( j )
265 CALL
zaxpy( lm, -t, ab( kd+1, j ), 1, work( j+1 ), 1 )
271 CALL
zlatbs(
'Upper',
'No transpose',
'Non-unit', normin, n,
272 $ kl+ku, ab, ldab, work, scale, rwork, info )
277 CALL
zlatbs(
'Upper',
'Conjugate transpose',
'Non-unit',
278 $ normin, n, kl+ku, ab, ldab, work, scale, rwork,
284 DO 30 j = n - 1, 1, -1
286 work( j ) = work( j ) -
zdotc( lm, ab( kd+1, j ), 1,
291 work( jp ) = work( j )
301 IF( scale.NE.one )
THEN
303 IF( scale.LT.cabs1( work( ix ) )*smlnum .OR. scale.EQ.zero )
305 CALL
zdrscl( n, scale, work, 1 )
313 $ rcond = ( one / ainvnm ) / anorm