119 SUBROUTINE dpbt01( UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK,
129 INTEGER kd, lda, ldafac, n
130 DOUBLE PRECISION resid
133 DOUBLE PRECISION a( lda, * ), afac( ldafac, * ), rwork( * )
140 DOUBLE PRECISION zero, one
141 parameter( zero = 0.0d+0, one = 1.0d+0 )
144 INTEGER i,
j, k, kc, klen, ml, mu
145 DOUBLE PRECISION anorm, eps, t
156 INTRINSIC dble, max, min
170 anorm =
dlansb(
'1', uplo, n, kd, a, lda, rwork )
171 IF( anorm.LE.zero )
THEN
178 IF(
lsame( uplo,
'U' ) )
THEN
180 kc = max( 1, kd+2-k )
185 t =
ddot( klen+1, afac( kc, k ), 1, afac( kc, k ), 1 )
191 $ CALL
dtrmv(
'Upper',
'Transpose',
'Non-unit', klen,
192 $ afac( kd+1, k-klen ), ldafac-1,
201 klen = min( kd, n-k )
207 $ CALL
dsyr(
'Lower', klen, one, afac( 2, k ), 1,
208 $ afac( 1, k+1 ), ldafac-1 )
213 CALL
dscal( klen+1, t, afac( 1, k ), 1 )
220 IF(
lsame( uplo,
'U' ) )
THEN
222 mu = max( 1, kd+2-
j )
224 afac( i,
j ) = afac( i,
j ) - a( i,
j )
229 ml = min( kd+1, n-
j+1 )
231 afac( i,
j ) = afac( i,
j ) - a( i,
j )
238 resid =
dlansb(
'I', uplo, n, kd, afac, ldafac, rwork )
240 resid = ( ( resid / dble( n ) ) / anorm ) / eps
LOGICAL function lsame(CA, CB)
LSAME
subroutine dsyr(UPLO, N, ALPHA, X, INCX, A, LDA)
DSYR
subroutine dpbt01(UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK, RESID)
DPBT01
subroutine dscal(N, DA, DX, INCX)
DSCAL
DOUBLE PRECISION function dlansb(NORM, UPLO, N, K, AB, LDAB, WORK)
DLANSB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric band matrix.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
DOUBLE PRECISION function ddot(N, DX, INCX, DY, INCY)
DDOT
subroutine dtrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
DTRMV