146 SUBROUTINE sgbcon( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND,
147 $ work, iwork, info )
156 INTEGER info, kl, ku, ldab, n
160 INTEGER ipiv( * ), iwork( * )
161 REAL ab( ldab, * ), work( * )
168 parameter( one = 1.0e+0, zero = 0.0e+0 )
171 LOGICAL lnoti, onenrm
173 INTEGER ix,
j, jp, kase, kase1, kd, lm
174 REAL ainvnm, scale, smlnum, t
196 onenrm = norm.EQ.
'1' .OR.
lsame( norm,
'O' )
197 IF( .NOT.onenrm .AND. .NOT.
lsame( norm,
'I' ) )
THEN
199 ELSE IF( n.LT.0 )
THEN
201 ELSE IF( kl.LT.0 )
THEN
203 ELSE IF( ku.LT.0 )
THEN
205 ELSE IF( ldab.LT.2*kl+ku+1 )
THEN
207 ELSE IF( anorm.LT.zero )
THEN
211 CALL
xerbla(
'SGBCON', -info )
221 ELSE IF( anorm.EQ.zero )
THEN
225 smlnum =
slamch(
'Safe minimum' )
240 CALL
slacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
242 IF( kase.EQ.kase1 )
THEN
252 work( jp ) = work(
j )
255 CALL
saxpy( lm, -t, ab( kd+1,
j ), 1, work(
j+1 ), 1 )
261 CALL
slatbs(
'Upper',
'No transpose',
'Non-unit', normin, n,
262 $ kl+ku, ab, ldab, work, scale, work( 2*n+1 ),
268 CALL
slatbs(
'Upper',
'Transpose',
'Non-unit', normin, n,
269 $ kl+ku, ab, ldab, work, scale, work( 2*n+1 ),
275 DO 30
j = n - 1, 1, -1
277 work(
j ) = work(
j ) -
sdot( lm, ab( kd+1,
j ), 1,
282 work( jp ) = work(
j )
292 IF( scale.NE.one )
THEN
294 IF( scale.LT.abs( work( ix ) )*smlnum .OR. scale.EQ.zero )
296 CALL
srscl( n, scale, work, 1 )
304 $ rcond = ( one / ainvnm ) / anorm
integer function isamax(N, SX, INCX)
ISAMAX
real function sdot(N, SX, INCX, SY, INCY)
SDOT
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
subroutine sgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SGBCON
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...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine slatbs(UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, SCALE, CNORM, INFO)
SLATBS solves a triangular banded system of equations.