110 SUBROUTINE dppt03( UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND,
121 DOUBLE PRECISION rcond, resid
124 DOUBLE PRECISION a( * ), ainv( * ), rwork( * ),
131 DOUBLE PRECISION zero, one
132 parameter( zero = 0.0d+0, one = 1.0d+0 )
136 DOUBLE PRECISION ainvnm, anorm, eps
162 anorm =
dlansp(
'1', uplo, n, a, rwork )
163 ainvnm =
dlansp(
'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
dcopy(
j, ainv( jj ), 1, work( 1,
j+1 ), 1 )
183 CALL
dcopy(
j-1, ainv( jj ), 1, work(
j, 2 ), ldwork )
186 jj = ( ( n-1 )*n ) / 2 + 1
187 CALL
dcopy( n-1, ainv( jj ), 1, work( n, 2 ), ldwork )
192 CALL
dspmv(
'Upper', n, -one, a, work( 1,
j+1 ), 1, zero,
195 CALL
dspmv(
'Upper', n, -one, a, ainv( jj ), 1, zero,
206 CALL
dcopy( n-1, ainv( 2 ), 1, work( 1, 1 ), ldwork )
209 CALL
dcopy( n-
j+1, ainv( jj ), 1, work(
j,
j-1 ), 1 )
210 CALL
dcopy( n-
j, ainv( jj+1 ), 1, work(
j,
j ), ldwork )
217 CALL
dspmv(
'Lower', n, -one, a, work( 1,
j-1 ), 1, zero,
220 CALL
dspmv(
'Lower', n, -one, a, ainv( 1 ), 1, zero,
228 work( i, i ) = work( i, i ) + one
233 resid =
dlange(
'1', n, n, work, ldwork, rwork )
235 resid = ( ( resid*rcond ) / eps ) / dble( n )
subroutine dppt03(UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
DPPT03
subroutine dspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
DSPMV
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
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
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j