133 SUBROUTINE cpbcon( UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK,
143 INTEGER info, kd, ldab, n
148 COMPLEX ab( ldab, * ), work( * )
155 parameter( one = 1.0e+0, zero = 0.0e+0 )
161 REAL ainvnm, scale, scalel, scaleu, smlnum
177 INTRINSIC abs, aimag, real
183 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( aimag( zdum ) )
190 upper =
lsame( uplo,
'U' )
191 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
193 ELSE IF( n.LT.0 )
THEN
195 ELSE IF( kd.LT.0 )
THEN
197 ELSE IF( ldab.LT.kd+1 )
THEN
199 ELSE IF( anorm.LT.zero )
THEN
203 CALL
xerbla(
'CPBCON', -info )
213 ELSE IF( anorm.EQ.zero )
THEN
217 smlnum =
slamch(
'Safe minimum' )
224 CALL
clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
230 CALL
clatbs(
'Upper',
'Conjugate transpose',
'Non-unit',
231 $ normin, n, kd, ab, ldab, work, scalel, rwork,
237 CALL
clatbs(
'Upper',
'No transpose',
'Non-unit', normin, n,
238 $ kd, ab, ldab, work, scaleu, rwork, info )
243 CALL
clatbs(
'Lower',
'No transpose',
'Non-unit', normin, n,
244 $ kd, ab, ldab, work, scalel, rwork, info )
249 CALL
clatbs(
'Lower',
'Conjugate transpose',
'Non-unit',
250 $ normin, n, kd, ab, ldab, work, scaleu, rwork,
256 scale = scalel*scaleu
257 IF( scale.NE.one )
THEN
259 IF( scale.LT.cabs1( work( ix ) )*smlnum .OR. scale.EQ.zero )
261 CALL
csrscl( n, scale, work, 1 )
269 $ rcond = ( one / ainvnm ) / anorm
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
subroutine cpbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, RWORK, INFO)
CPBCON
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine csrscl(N, SA, SX, INCX)
CSRSCL multiplies a vector by the reciprocal of a real scalar.
subroutine clatbs(UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, SCALE, CNORM, INFO)
CLATBS solves a triangular banded system of equations.
subroutine clacn2(N, V, X, EST, KASE, ISAVE)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
INTEGER function icamax(N, CX, INCX)
ICAMAX