94 SUBROUTINE dppt01( UPLO, N, A, AFAC, RWORK, RESID )
104 DOUBLE PRECISION resid
107 DOUBLE PRECISION a( * ), afac( * ), rwork( * )
113 DOUBLE PRECISION zero, one
114 parameter( zero = 0.0d+0, one = 1.0d+0 )
117 INTEGER i, k, kc, npp
118 DOUBLE PRECISION anorm, eps, t
143 anorm =
dlansp(
'1', uplo, n, a, rwork )
144 IF( anorm.LE.zero )
THEN
151 IF(
lsame( uplo,
'U' ) )
THEN
152 kc = ( n*( n-1 ) ) / 2 + 1
157 t =
ddot( k, afac( kc ), 1, afac( kc ), 1 )
163 CALL
dtpmv(
'Upper',
'Transpose',
'Non-unit', k-1, afac,
172 kc = ( n*( n+1 ) ) / 2
179 $ CALL
dspr(
'Lower', n-k, one, afac( kc+1 ), 1,
185 CALL
dscal( n-k+1, t, afac( kc ), 1 )
195 afac( i ) = afac( i ) - a( i )
200 resid =
dlansp(
'1', uplo, n, afac, rwork )
202 resid = ( ( resid / dble( n ) ) / anorm ) / eps
subroutine dspr(UPLO, N, ALPHA, X, INCX, AP)
DSPR
double precision function dlansp(NORM, UPLO, N, AP, WORK)
DLANSP 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.
logical function lsame(CA, CB)
LSAME
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dtpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
DTPMV
double precision function ddot(N, DX, INCX, DY, INCY)
DDOT
subroutine dppt01(UPLO, N, A, AFAC, RWORK, RESID)
DPPT01
double precision function dlamch(CMACH)
DLAMCH