146 SUBROUTINE dgbcon( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND,
147 $ work, iwork, info )
156 INTEGER info, kl, ku, ldab, n
157 DOUBLE PRECISION anorm, rcond
160 INTEGER ipiv( * ), iwork( * )
161 DOUBLE PRECISION ab( ldab, * ), work( * )
167 DOUBLE PRECISION one, zero
168 parameter( one = 1.0d+0, zero = 0.0d+0 )
171 LOGICAL lnoti, onenrm
173 INTEGER ix,
j, jp, kase, kase1, kd, lm
174 DOUBLE PRECISION 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(
'DGBCON', -info )
221 ELSE IF( anorm.EQ.zero )
THEN
225 smlnum =
dlamch(
'Safe minimum' )
240 CALL
dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
242 IF( kase.EQ.kase1 )
THEN
252 work( jp ) = work(
j )
255 CALL
daxpy( lm, -t, ab( kd+1,
j ), 1, work(
j+1 ), 1 )
261 CALL
dlatbs(
'Upper',
'No transpose',
'Non-unit', normin, n,
262 $ kl+ku, ab, ldab, work, scale, work( 2*n+1 ),
268 CALL
dlatbs(
'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 ) -
ddot( 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
drscl( n, scale, work, 1 )
304 $ rcond = ( one / ainvnm ) / anorm
subroutine dlatbs(UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, SCALE, CNORM, INFO)
DLATBS solves a triangular banded system of equations.
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
double precision function ddot(N, DX, INCX, DY, INCY)
DDOT
subroutine dgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DGBCON
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY
subroutine dlacn2(N, V, X, ISGN, EST, KASE, ISAVE)
DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
integer function idamax(N, DX, INCX)
IDAMAX
subroutine drscl(N, SA, SX, INCX)
DRSCL multiplies a vector by the reciprocal of a real scalar.