92 SUBROUTINE dppt01( UPLO, N, A, AFAC, RWORK, RESID )
101 DOUBLE PRECISION RESID
104 DOUBLE PRECISION A( * ), AFAC( * ), RWORK( * )
110 DOUBLE PRECISION ZERO, ONE
111 parameter( zero = 0.0d+0, one = 1.0d+0 )
114 INTEGER I, K, KC, NPP
115 DOUBLE PRECISION ANORM, EPS, T
119 DOUBLE PRECISION DDOT, DLAMCH, DLANSP
120 EXTERNAL lsame, ddot, dlamch, dlansp
139 eps = dlamch(
'Epsilon' )
140 anorm = dlansp(
'1', uplo, n, a, rwork )
141 IF( anorm.LE.zero )
THEN
148 IF( lsame( uplo,
'U' ) )
THEN
149 kc = ( n*( n-1 ) ) / 2 + 1
154 t = ddot( k, afac( kc ), 1, afac( kc ), 1 )
160 CALL dtpmv(
'Upper',
'Transpose',
'Non-unit', k-1, afac,
169 kc = ( n*( n+1 ) ) / 2
176 $
CALL dspr(
'Lower', n-k, one, afac( kc+1 ), 1,
182 CALL dscal( n-k+1, t, afac( kc ), 1 )
192 afac( i ) = afac( i ) - a( i )
197 resid = dlansp(
'1', uplo, n, afac, rwork )
199 resid = ( ( resid / dble( n ) ) / anorm ) / eps
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dtpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
DTPMV
subroutine dspr(UPLO, N, ALPHA, X, INCX, AP)
DSPR
subroutine dppt01(UPLO, N, A, AFAC, RWORK, RESID)
DPPT01