119 SUBROUTINE spbt01( UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK,
129 INTEGER kd, lda, ldafac, n
133 REAL a( lda, * ), afac( ldafac, * ), rwork( * )
141 parameter( zero = 0.0e+0, one = 1.0e+0 )
144 INTEGER i,
j, k, kc, klen, ml, mu
156 INTRINSIC max, min, real
170 anorm =
slansb(
'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 =
sdot( klen+1, afac( kc, k ), 1, afac( kc, k ), 1 )
191 $ CALL
strmv(
'Upper',
'Transpose',
'Non-unit', klen,
192 $ afac( kd+1, k-klen ), ldafac-1,
201 klen = min( kd, n-k )
207 $ CALL
ssyr(
'Lower', klen, one, afac( 2, k ), 1,
208 $ afac( 1, k+1 ), ldafac-1 )
213 CALL
sscal( 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 =
slansb(
'I', uplo, n, kd, afac, ldafac, rwork )
240 resid = ( ( resid /
REAL( N ) ) / anorm ) / eps
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
subroutine spbt01(UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK, RESID)
SPBT01
REAL function slansb(NORM, UPLO, N, K, AB, LDAB, WORK)
SLANSB 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.
subroutine strmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRMV
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ssyr(UPLO, N, ALPHA, X, INCX, A, LDA)
SSYR
REAL function sdot(N, SX, INCX, SY, INCY)
SDOT
subroutine sscal(N, SA, SX, INCX)
SSCAL