157 SUBROUTINE ztrt02( UPLO, TRANS, DIAG, N, NRHS, A, LDA, X, LDX, B,
158 $ ldb, work, rwork, resid )
166 CHARACTER diag, trans, uplo
167 INTEGER lda, ldb, ldx, n, nrhs
168 DOUBLE PRECISION resid
171 DOUBLE PRECISION rwork( * )
172 COMPLEX*16 a( lda, * ),
b( ldb, * ), work( * ),
179 DOUBLE PRECISION zero, one
180 parameter( zero = 0.0d+0, one = 1.0d+0 )
184 DOUBLE PRECISION anorm, bnorm, eps, xnorm
195 INTRINSIC dcmplx, max
201 IF( n.LE.0 .OR. nrhs.LE.0 )
THEN
208 IF(
lsame( trans,
'N' ) )
THEN
209 anorm =
zlantr(
'1', uplo, diag, n, n, a, lda, rwork )
211 anorm =
zlantr(
'I', uplo, diag, n, n, a, lda, rwork )
217 IF( anorm.LE.zero )
THEN
227 CALL
zcopy( n,
x( 1,
j ), 1, work, 1 )
228 CALL
ztrmv( uplo, trans, diag, n, a, lda, work, 1 )
229 CALL
zaxpy( n, dcmplx( -one ),
b( 1,
j ), 1, work, 1 )
230 bnorm =
dzasum( n, work, 1 )
232 IF( xnorm.LE.zero )
THEN
235 resid = max( resid, ( ( bnorm / anorm ) / xnorm ) / eps )
LOGICAL function lsame(CA, CB)
LSAME
DOUBLE PRECISION function dzasum(N, ZX, INCX)
DZASUM
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine ztrt02(UPLO, TRANS, DIAG, N, NRHS, A, LDA, X, LDX, B, LDB, WORK, RWORK, RESID)
ZTRT02
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine ztrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
ZTRMV
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
DOUBLE PRECISION function zlantr(NORM, UPLO, DIAG, M, N, A, LDA, WORK)
ZLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix.