110 SUBROUTINE sppt03( UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND,
124 REAL a( * ), ainv( * ), rwork( * ),
132 parameter( zero = 0.0e+0, one = 1.0e+0 )
136 REAL ainvnm, anorm, eps
162 anorm =
slansp(
'1', uplo, n, a, rwork )
163 ainvnm =
slansp(
'1', uplo, n, ainv, rwork )
164 IF( anorm.LE.zero .OR. ainvnm.EQ.zero )
THEN
169 rcond = ( one / anorm ) / ainvnm
176 IF(
lsame( uplo,
'U' ) )
THEN
182 CALL
scopy(
j, ainv( jj ), 1, work( 1,
j+1 ), 1 )
183 CALL
scopy(
j-1, ainv( jj ), 1, work(
j, 2 ), ldwork )
186 jj = ( ( n-1 )*n ) / 2 + 1
187 CALL
scopy( n-1, ainv( jj ), 1, work( n, 2 ), ldwork )
192 CALL
sspmv(
'Upper', n, -one, a, work( 1,
j+1 ), 1, zero,
195 CALL
sspmv(
'Upper', n, -one, a, ainv( jj ), 1, zero,
206 CALL
scopy( n-1, ainv( 2 ), 1, work( 1, 1 ), ldwork )
209 CALL
scopy( n-
j+1, ainv( jj ), 1, work(
j,
j-1 ), 1 )
210 CALL
scopy( n-
j, ainv( jj+1 ), 1, work(
j,
j ), ldwork )
217 CALL
sspmv(
'Lower', n, -one, a, work( 1,
j-1 ), 1, zero,
220 CALL
sspmv(
'Lower', n, -one, a, ainv( 1 ), 1, zero,
228 work( i, i ) = work( i, i ) + one
233 resid =
slange(
'1', n, n, work, ldwork, rwork )
235 resid = ( ( resid*rcond ) / eps ) /
REAL( n )
real function slansp(NORM, UPLO, N, AP, WORK)
SLANSP 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 matrix supplied in packed form.
subroutine sspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
SSPMV
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
logical function lsame(CA, CB)
LSAME
real function slamch(CMACH)
SLAMCH
subroutine sppt03(UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
SPPT03
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j