132 SUBROUTINE spbcon( UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK,
142 INTEGER info, kd, ldab, n
147 REAL ab( ldab, * ), work( * )
154 parameter( one = 1.0e+0, zero = 0.0e+0 )
160 REAL ainvnm, scale, scalel, scaleu, smlnum
182 upper =
lsame( uplo,
'U' )
183 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
185 ELSE IF( n.LT.0 )
THEN
187 ELSE IF( kd.LT.0 )
THEN
189 ELSE IF( ldab.LT.kd+1 )
THEN
191 ELSE IF( anorm.LT.zero )
THEN
195 CALL
xerbla(
'SPBCON', -info )
205 ELSE IF( anorm.EQ.zero )
THEN
209 smlnum =
slamch(
'Safe minimum' )
216 CALL
slacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
222 CALL
slatbs(
'Upper',
'Transpose',
'Non-unit', normin, n,
223 $ kd, ab, ldab, work, scalel, work( 2*n+1 ),
229 CALL
slatbs(
'Upper',
'No transpose',
'Non-unit', normin, n,
230 $ kd, ab, ldab, work, scaleu, work( 2*n+1 ),
236 CALL
slatbs(
'Lower',
'No transpose',
'Non-unit', normin, n,
237 $ kd, ab, ldab, work, scalel, work( 2*n+1 ),
243 CALL
slatbs(
'Lower',
'Transpose',
'Non-unit', normin, n,
244 $ kd, ab, ldab, work, scaleu, work( 2*n+1 ),
250 scale = scalel*scaleu
251 IF( scale.NE.one )
THEN
253 IF( scale.LT.abs( work( ix ) )*smlnum .OR. scale.EQ.zero )
255 CALL
srscl( n, scale, work, 1 )
263 $ rcond = ( one / ainvnm ) / anorm
LOGICAL function lsame(CA, CB)
LSAME
INTEGER function isamax(N, SX, INCX)
ISAMAX
subroutine spbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, IWORK, INFO)
SPBCON
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine srscl(N, SA, SX, INCX)
SRSCL multiplies a vector by the reciprocal of a real scalar.
subroutine slacn2(N, V, X, ISGN, EST, KASE, ISAVE)
SLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
subroutine slatbs(UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, SCALE, CNORM, INFO)
SLATBS solves a triangular banded system of equations.