144 SUBROUTINE sgbcon( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND,
145 $ WORK, IWORK, INFO )
153 INTEGER INFO, KL, KU, LDAB, N
157 INTEGER IPIV( * ), IWORK( * )
158 REAL AB( LDAB, * ), WORK( * )
165 parameter( one = 1.0e+0, zero = 0.0e+0 )
168 LOGICAL LNOTI, ONENRM
170 INTEGER IX, J, JP, KASE, KASE1, KD, LM
171 REAL AINVNM, SCALE, SMLNUM, T
180 EXTERNAL lsame, isamax, sdot, slamch
193 onenrm = norm.EQ.
'1' .OR. lsame( norm,
'O' )
194 IF( .NOT.onenrm .AND. .NOT.lsame( norm,
'I' ) )
THEN
196 ELSE IF( n.LT.0 )
THEN
198 ELSE IF( kl.LT.0 )
THEN
200 ELSE IF( ku.LT.0 )
THEN
202 ELSE IF( ldab.LT.2*kl+ku+1 )
THEN
204 ELSE IF( anorm.LT.zero )
THEN
208 CALL xerbla(
'SGBCON', -info )
218 ELSE IF( anorm.EQ.zero )
THEN
222 smlnum = slamch(
'Safe minimum' )
237 CALL slacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
239 IF( kase.EQ.kase1 )
THEN
249 work( jp ) = work( j )
252 CALL saxpy( lm, -t, ab( kd+1, j ), 1, work( j+1 ), 1 )
258 CALL slatbs(
'Upper',
'No transpose',
'Non-unit', normin, n,
259 $ kl+ku, ab, ldab, work, scale, work( 2*n+1 ),
265 CALL slatbs(
'Upper',
'Transpose',
'Non-unit', normin, n,
266 $ kl+ku, ab, ldab, work, scale, work( 2*n+1 ),
272 DO 30 j = n - 1, 1, -1
274 work( j ) = work( j ) - sdot( lm, ab( kd+1, j ), 1,
279 work( jp ) = work( j )
289 IF( scale.NE.one )
THEN
290 ix = isamax( n, work, 1 )
291 IF( scale.LT.abs( work( ix ) )*smlnum .OR. scale.EQ.zero )
293 CALL srscl( n, scale, work, 1 )
301 $ rcond = ( one / ainvnm ) / anorm
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SGBCON
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.
subroutine srscl(N, SA, SX, INCX)
SRSCL multiplies a vector by the reciprocal of a real scalar.
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY