107 SUBROUTINE dget01( M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK,
116 INTEGER lda, ldafac, m, n
117 DOUBLE PRECISION resid
121 DOUBLE PRECISION a( lda, * ), afac( ldafac, * ), rwork( * )
128 DOUBLE PRECISION zero, one
129 parameter( zero = 0.0d+0, one = 1.0d+0 )
133 DOUBLE PRECISION anorm, eps, t
149 IF( m.LE.0 .OR. n.LE.0 )
THEN
157 anorm =
dlange(
'1', m, n, a, lda, rwork )
165 CALL
dtrmv(
'Lower',
'No transpose',
'Unit', m, afac,
166 $ ldafac, afac( 1, k ), 1 )
173 CALL
dscal( m-k, t, afac( k+1, k ), 1 )
174 CALL
dgemv(
'No transpose', m-k, k-1, one,
175 $ afac( k+1, 1 ), ldafac, afac( 1, k ), 1, one,
176 $ afac( k+1, k ), 1 )
181 afac( k, k ) = t +
ddot( k-1, afac( k, 1 ), ldafac,
186 CALL
dtrmv(
'Lower',
'No transpose',
'Unit', k-1, afac,
187 $ ldafac, afac( 1, k ), 1 )
190 CALL
dlaswp( n, afac, ldafac, 1, min( m, n ), ipiv, -1 )
196 afac( i,
j ) = afac( i,
j ) - a( i,
j )
202 resid =
dlange(
'1', m, n, afac, ldafac, rwork )
204 IF( anorm.LE.zero )
THEN
208 resid = ( ( resid / dble( n ) ) / anorm ) / eps
subroutine dlaswp(N, A, LDA, K1, K2, IPIV, INCX)
DLASWP performs a series of row interchanges on a general rectangular matrix.
DOUBLE PRECISION function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
DGET01
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
DOUBLE PRECISION function ddot(N, DX, INCX, DY, INCY)
DDOT
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV
subroutine dtrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
DTRMV