110 SUBROUTINE zppt03( UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND,
121 DOUBLE PRECISION rcond, resid
124 DOUBLE PRECISION rwork( * )
125 COMPLEX*16 a( * ), ainv( * ), work( ldwork, * )
131 DOUBLE PRECISION zero, one
132 parameter( zero = 0.0d+0, one = 1.0d+0 )
133 COMPLEX*16 czero, cone
134 parameter( czero = ( 0.0d+0, 0.0d+0 ),
135 $ cone = ( 1.0d+0, 0.0d+0 ) )
139 DOUBLE PRECISION ainvnm, anorm, eps
147 INTRINSIC dble, dconjg
165 anorm =
zlanhp(
'1', uplo, n, a, rwork )
166 ainvnm =
zlanhp(
'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
zcopy(
j, ainv( jj ), 1, work( 1,
j+1 ), 1 )
187 work(
j, i+1 ) = dconjg( ainv( jj+i-1 ) )
191 jj = ( ( n-1 )*n ) / 2 + 1
193 work( n, i+1 ) = dconjg( ainv( jj+i-1 ) )
199 CALL
zhpmv(
'Upper', n, -cone, a, work( 1,
j+1 ), 1, czero,
202 CALL
zhpmv(
'Upper', n, -cone, a, ainv( jj ), 1, czero,
214 work( 1, i ) = dconjg( ainv( i+1 ) )
218 CALL
zcopy( n-
j+1, ainv( jj ), 1, work(
j,
j-1 ), 1 )
220 work(
j,
j+i-1 ) = dconjg( ainv( jj+i ) )
228 CALL
zhpmv(
'Lower', n, -cone, a, work( 1,
j-1 ), 1, czero,
231 CALL
zhpmv(
'Lower', n, -cone, a, ainv( 1 ), 1, czero,
239 work( i, i ) = work( i, i ) + cone
244 resid =
zlange(
'1', n, n, work, ldwork, rwork )
246 resid = ( ( resid*rcond ) / eps ) / dble( n )
subroutine zppt03(UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPPT03
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
logical function lsame(CA, CB)
LSAME
double precision function zlanhp(NORM, UPLO, N, AP, WORK)
ZLANHP 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.
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE 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
subroutine zhpmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
ZHPMV