174 SUBROUTINE dtbt03( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB,
175 $ scale, cnorm, tscal, x, ldx,
b, ldb, work,
184 CHARACTER diag, trans, uplo
185 INTEGER kd, ldab, ldb, ldx, n, nrhs
186 DOUBLE PRECISION resid, scale, tscal
189 DOUBLE PRECISION ab( ldab, * ),
b( ldb, * ), cnorm( * ),
190 $ work( * ), x( ldx, * )
196 DOUBLE PRECISION one, zero
197 parameter( one = 1.0d+0, zero = 0.0d+0 )
201 DOUBLE PRECISION bignum, eps, err, smlnum, tnorm, xnorm, xscal
213 INTRINSIC abs, dble, max
219 IF( n.LE.0 .OR. nrhs.LE.0 )
THEN
224 smlnum =
dlamch(
'Safe minimum' )
225 bignum = one / smlnum
226 CALL
dlabad( smlnum, bignum )
232 IF(
lsame( diag,
'N' ) )
THEN
233 IF(
lsame( uplo,
'U' ) )
THEN
235 tnorm = max( tnorm, tscal*abs( ab( kd+1,
j ) )+
240 tnorm = max( tnorm, tscal*abs( ab( 1,
j ) )+cnorm(
j ) )
245 tnorm = max( tnorm, tscal+cnorm(
j ) )
254 CALL
dcopy( n, x( 1,
j ), 1, work, 1 )
256 xnorm = max( one, abs( x( ix,
j ) ) )
257 xscal = ( one / xnorm ) / dble( kd+1 )
258 CALL
dscal( n, xscal, work, 1 )
259 CALL
dtbmv( uplo, trans, diag, n, kd, ab, ldab, work, 1 )
260 CALL
daxpy( n, -scale*xscal,
b( 1,
j ), 1, work, 1 )
262 err = tscal*abs( work( ix ) )
264 xnorm = abs( x( ix,
j ) )
265 IF( err*smlnum.LE.xnorm )
THEN
272 IF( err*smlnum.LE.tnorm )
THEN
279 resid = max( resid, err )
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dlabad(SMALL, LARGE)
DLABAD
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dtbt03(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
DTBT03
subroutine dtbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
DTBMV
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
integer function idamax(N, DX, INCX)
IDAMAX