174 SUBROUTINE stbt03( 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 REAL resid, scale, tscal
189 REAL ab( ldab, * ),
b( ldb, * ), cnorm( * ),
190 $ work( * ),
x( ldx, * )
197 parameter( one = 1.0e+0, zero = 0.0e+0 )
201 REAL bignum, eps, err, smlnum, tnorm, xnorm, xscal
213 INTRINSIC abs, max, real
219 IF( n.LE.0 .OR. nrhs.LE.0 )
THEN
224 smlnum =
slamch(
'Safe minimum' )
225 bignum = one / smlnum
226 CALL
slabad( 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
scopy( n,
x( 1,
j ), 1, work, 1 )
256 xnorm = max( one, abs(
x( ix,
j ) ) )
257 xscal = ( one / xnorm ) /
REAL( kd+1 )
258 CALL
sscal( n, xscal, work, 1 )
259 CALL
stbmv( uplo, trans, diag, n, kd, ab, ldab, work, 1 )
260 CALL
saxpy( 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 )
LOGICAL function lsame(CA, CB)
LSAME
INTEGER function isamax(N, SX, INCX)
ISAMAX
REAL function slamch(CMACH)
SLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine stbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
STBMV
subroutine stbt03(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
STBT03
subroutine sscal(N, SA, SX, INCX)
SSCAL