149 SUBROUTINE ztpt02( UPLO, TRANS, DIAG, N, NRHS, AP, X, LDX, B, LDB,
150 $ work, rwork, resid )
158 CHARACTER diag, trans, uplo
159 INTEGER ldb, ldx, n, nrhs
160 DOUBLE PRECISION resid
163 DOUBLE PRECISION rwork( * )
164 COMPLEX*16 ap( * ),
b( ldb, * ), work( * ),
x( ldx, * )
170 DOUBLE PRECISION zero, one
171 parameter( zero = 0.0d+0, one = 1.0d+0 )
175 DOUBLE PRECISION anorm, bnorm, eps, xnorm
186 INTRINSIC dcmplx, max
192 IF( n.LE.0 .OR. nrhs.LE.0 )
THEN
199 IF(
lsame( trans,
'N' ) )
THEN
200 anorm =
zlantp(
'1', uplo, diag, n, ap, rwork )
202 anorm =
zlantp(
'I', uplo, diag, n, ap, rwork )
208 IF( anorm.LE.zero )
THEN
218 CALL
zcopy( n,
x( 1,
j ), 1, work, 1 )
219 CALL
ztpmv( uplo, trans, diag, n, ap, work, 1 )
220 CALL
zaxpy( n, dcmplx( -one ),
b( 1,
j ), 1, work, 1 )
221 bnorm =
dzasum( n, work, 1 )
223 IF( xnorm.LE.zero )
THEN
226 resid = max( resid, ( ( bnorm / anorm ) / xnorm ) / eps )
LOGICAL function lsame(CA, CB)
LSAME
subroutine ztpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
ZTPMV
DOUBLE PRECISION function dzasum(N, ZX, INCX)
DZASUM
DOUBLE PRECISION function zlantp(NORM, UPLO, DIAG, N, AP, WORK)
ZLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine ztpt02(UPLO, TRANS, DIAG, N, NRHS, AP, X, LDX, B, LDB, WORK, RWORK, RESID)
ZTPT02
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH