176 SUBROUTINE ztbt03( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB,
177 $ scale, cnorm, tscal,
x, ldx,
b, ldb, work,
186 CHARACTER diag, trans, uplo
187 INTEGER kd, ldab, ldb, ldx, n, nrhs
188 DOUBLE PRECISION resid, scale, tscal
191 DOUBLE PRECISION cnorm( * )
192 COMPLEX*16 ab( ldab, * ),
b( ldb, * ), work( * ),
200 DOUBLE PRECISION one, zero
201 parameter( one = 1.0d+0, zero = 0.0d+0 )
205 DOUBLE PRECISION eps, err, smlnum, tnorm, xnorm, xscal
217 INTRINSIC abs, dble, dcmplx, max
223 IF( n.LE.0 .OR. nrhs.LE.0 )
THEN
228 smlnum =
dlamch(
'Safe minimum' )
234 IF(
lsame( diag,
'N' ) )
THEN
235 IF(
lsame( uplo,
'U' ) )
THEN
237 tnorm = max( tnorm, tscal*abs( ab( kd+1,
j ) )+
242 tnorm = max( tnorm, tscal*abs( ab( 1,
j ) )+cnorm(
j ) )
247 tnorm = max( tnorm, tscal+cnorm(
j ) )
256 CALL
zcopy( n,
x( 1,
j ), 1, work, 1 )
258 xnorm = max( one, abs(
x( ix,
j ) ) )
259 xscal = ( one / xnorm ) / dble( kd+1 )
260 CALL
zdscal( n, xscal, work, 1 )
261 CALL
ztbmv( uplo, trans, diag, n, kd, ab, ldab, work, 1 )
262 CALL
zaxpy( n, dcmplx( -scale*xscal ),
b( 1,
j ), 1, work, 1 )
264 err = tscal*abs( work( ix ) )
266 xnorm = abs(
x( ix,
j ) )
267 IF( err*smlnum.LE.xnorm )
THEN
274 IF( err*smlnum.LE.tnorm )
THEN
281 resid = max( resid, err )
LOGICAL function lsame(CA, CB)
LSAME
subroutine ztbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
ZTBMV
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine ztbt03(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
ZTBT03
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
INTEGER function izamax(N, ZX, INCX)
IZAMAX