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
subroutine spbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, IWORK, INFO)
SPBCON
integer function isamax(N, SX, INCX)
ISAMAX
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine srscl(N, SA, SX, INCX)
SRSCL multiplies a vector by the reciprocal of a real scalar.
real function slamch(CMACH)
SLAMCH
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.