110 SUBROUTINE cppt03( UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND,
125 COMPLEX a( * ), ainv( * ), work( ldwork, * )
132 parameter( zero = 0.0e+0, one = 1.0e+0 )
134 parameter( czero = ( 0.0e+0, 0.0e+0 ),
135 $ cone = ( 1.0e+0, 0.0e+0 ) )
139 REAL ainvnm, anorm, eps
147 INTRINSIC conjg, real
165 anorm =
clanhp(
'1', uplo, n, a, rwork )
166 ainvnm =
clanhp(
'1', uplo, n, ainv, rwork )
167 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
172 rcond = ( one/anorm ) / ainvnm
179 IF(
lsame( uplo,
'U' ) )
THEN
185 CALL
ccopy(
j, ainv( jj ), 1, work( 1,
j+1 ), 1 )
187 work(
j, i+1 ) = conjg( ainv( jj+i-1 ) )
191 jj = ( ( n-1 )*n ) / 2 + 1
193 work( n, i+1 ) = conjg( ainv( jj+i-1 ) )
199 CALL
chpmv(
'Upper', n, -cone, a, work( 1,
j+1 ), 1, czero,
202 CALL
chpmv(
'Upper', n, -cone, a, ainv( jj ), 1, czero,
214 work( 1, i ) = conjg( ainv( i+1 ) )
218 CALL
ccopy( n-
j+1, ainv( jj ), 1, work(
j,
j-1 ), 1 )
220 work(
j,
j+i-1 ) = conjg( ainv( jj+i ) )
228 CALL
chpmv(
'Lower', n, -cone, a, work( 1,
j-1 ), 1, czero,
231 CALL
chpmv(
'Lower', n, -cone, a, ainv( 1 ), 1, czero,
239 work( i, i ) = work( i, i ) + cone
244 resid =
clange(
'1', n, n, work, ldwork, rwork )
246 resid = ( ( resid*rcond )/eps ) /
REAL( n )
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
REAL function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine chpmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
CHPMV
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cppt03(UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
CPPT03
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
REAL function clanhp(NORM, UPLO, N, AP, WORK)
CLANHP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix supplied in packed form.