108 SUBROUTINE zget01( M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK,
117 INTEGER lda, ldafac, m, n
118 DOUBLE PRECISION resid
122 DOUBLE PRECISION rwork( * )
123 COMPLEX*16 a( lda, * ), afac( ldafac, * )
129 DOUBLE PRECISION zero, one
130 parameter( zero = 0.0d+0, one = 1.0d+0 )
132 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
136 DOUBLE PRECISION anorm, eps
154 IF( m.LE.0 .OR. n.LE.0 )
THEN
162 anorm =
zlange(
'1', m, n, a, lda, rwork )
170 CALL
ztrmv(
'Lower',
'No transpose',
'Unit', m, afac,
171 $ ldafac, afac( 1, k ), 1 )
178 CALL
zscal( m-k, t, afac( k+1, k ), 1 )
179 CALL
zgemv(
'No transpose', m-k, k-1, cone,
180 $ afac( k+1, 1 ), ldafac, afac( 1, k ), 1,
181 $ cone, afac( k+1, k ), 1 )
186 afac( k, k ) = t +
zdotu( k-1, afac( k, 1 ), ldafac,
191 CALL
ztrmv(
'Lower',
'No transpose',
'Unit', k-1, afac,
192 $ ldafac, afac( 1, k ), 1 )
195 CALL
zlaswp( n, afac, ldafac, 1, min( m, n ), ipiv, -1 )
201 afac( i,
j ) = afac( i,
j ) - a( i,
j )
207 resid =
zlange(
'1', m, n, afac, ldafac, rwork )
209 IF( anorm.LE.zero )
THEN
213 resid = ( ( resid / dble( n ) ) / anorm ) / eps
COMPLEX *16 function zdotu(N, ZX, INCX, ZY, INCY)
ZDOTU
subroutine zget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
ZGET01
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
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 ...
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
subroutine zlaswp(N, A, LDA, K1, K2, IPIV, INCX)
ZLASWP performs a series of row interchanges on a general rectangular matrix.
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL