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
136 DOUBLE PRECISION DDOT, DLAMCH, DLANGE
137 EXTERNAL ddot, dlamch, dlange
149 IF( m.LE.0 .OR. n.LE.0 )
THEN
156 eps = dlamch(
'Epsilon' )
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.
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
DGET01
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