96 SUBROUTINE zppt01( UPLO, N, A, AFAC, RWORK, RESID )
106 DOUBLE PRECISION resid
109 DOUBLE PRECISION rwork( * )
110 COMPLEX*16 a( * ), afac( * )
116 DOUBLE PRECISION zero, one
117 parameter( zero = 0.0d+0, one = 1.0d+0 )
121 DOUBLE PRECISION anorm, eps, tr
134 INTRINSIC dble, dimag
148 anorm =
zlanhp(
'1', uplo, n, a, rwork )
149 IF( anorm.LE.zero )
THEN
158 IF(
lsame( uplo,
'U' ) )
THEN
160 IF( dimag( afac( kc ) ).NE.zero )
THEN
168 IF( dimag( afac( kc ) ).NE.zero )
THEN
178 IF(
lsame( uplo,
'U' ) )
THEN
179 kc = ( n*( n-1 ) ) / 2 + 1
184 tr =
zdotc( k, afac( kc ), 1, afac( kc ), 1 )
190 CALL
ztpmv(
'Upper',
'Conjugate',
'Non-unit', k-1, afac,
201 afac( kc+i-1 ) = afac( kc+i-1 ) - a( kc+i-1 )
203 afac( kc+k-1 ) = afac( kc+k-1 ) - dble( a( kc+k-1 ) )
210 kc = ( n*( n+1 ) ) / 2
217 $ CALL
zhpr(
'Lower', n-k, one, afac( kc+1 ), 1,
223 CALL
zscal( n-k+1, tc, afac( kc ), 1 )
232 afac( kc ) = afac( kc ) - dble( a( kc ) )
234 afac( kc+i-k ) = afac( kc+i-k ) - a( kc+i-k )
242 resid =
zlanhp(
'1', uplo, n, afac, rwork )
244 resid = ( ( resid / dble( n ) ) / anorm ) / eps
subroutine zppt01(UPLO, N, A, AFAC, RWORK, RESID)
ZPPT01
LOGICAL function lsame(CA, CB)
LSAME
subroutine ztpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
ZTPMV
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 dlamch(CMACH)
DLAMCH
COMPLEX *16 function zdotc(N, ZX, INCX, ZY, INCY)
ZDOTC
subroutine zhpr(UPLO, N, ALPHA, X, INCX, AP)
ZHPR
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL