129 SUBROUTINE zpbcon( UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK,
138 INTEGER INFO, KD, LDAB, N
139 DOUBLE PRECISION ANORM, RCOND
142 DOUBLE PRECISION RWORK( * )
143 COMPLEX*16 AB( LDAB, * ), WORK( * )
149 DOUBLE PRECISION ONE, ZERO
150 parameter( one = 1.0d+0, zero = 0.0d+0 )
156 DOUBLE PRECISION AINVNM, SCALE, SCALEL, SCALEU, SMLNUM
165 DOUBLE PRECISION DLAMCH
166 EXTERNAL lsame, izamax, dlamch
172 INTRINSIC abs, dble, dimag
175 DOUBLE PRECISION CABS1
178 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
185 upper = lsame( uplo,
'U' )
186 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
188 ELSE IF( n.LT.0 )
THEN
190 ELSE IF( kd.LT.0 )
THEN
192 ELSE IF( ldab.LT.kd+1 )
THEN
194 ELSE IF( anorm.LT.zero )
THEN
198 CALL xerbla(
'ZPBCON', -info )
208 ELSE IF( anorm.EQ.zero )
THEN
212 smlnum = dlamch(
'Safe minimum' )
219 CALL zlacn2( n, work( n+1 ), work, ainvnm, kase, isave )
225 CALL zlatbs(
'Upper',
'Conjugate transpose',
'Non-unit',
226 $ normin, n, kd, ab, ldab, work, scalel, rwork,
232 CALL zlatbs(
'Upper',
'No transpose',
'Non-unit', normin,
234 $ kd, ab, ldab, work, scaleu, rwork, info )
239 CALL zlatbs(
'Lower',
'No transpose',
'Non-unit', normin,
241 $ kd, ab, ldab, work, scalel, rwork, info )
246 CALL zlatbs(
'Lower',
'Conjugate transpose',
'Non-unit',
247 $ normin, n, kd, ab, ldab, work, scaleu, rwork,
253 scale = scalel*scaleu
254 IF( scale.NE.one )
THEN
255 ix = izamax( n, work, 1 )
256 IF( scale.LT.cabs1( work( ix ) )*smlnum .OR. scale.EQ.zero )
258 CALL zdrscl( n, scale, work, 1 )
266 $ rcond = ( one / ainvnm ) / anorm
subroutine zlacn2(n, v, x, est, kase, isave)
ZLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
subroutine zlatbs(uplo, trans, diag, normin, n, kd, ab, ldab, x, scale, cnorm, info)
ZLATBS solves a triangular banded system of equations.
subroutine zpbcon(uplo, n, kd, ab, ldab, anorm, rcond, work, rwork, info)
ZPBCON
subroutine zdrscl(n, sa, sx, incx)
ZDRSCL multiplies a vector by the reciprocal of a real scalar.