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
real function sdot(N, SX, INCX, SY, INCY)
SDOT
subroutine spbt01(UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK, RESID)
SPBT01
subroutine strmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRMV
logical function lsame(CA, CB)
LSAME
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.
real function slamch(CMACH)
SLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ssyr(UPLO, N, ALPHA, X, INCX, A, LDA)
SSYR
subroutine sscal(N, SA, SX, INCX)
SSCAL