107 SUBROUTINE sget01( M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK,
116 INTEGER lda, ldafac, m, n
121 REAL a( lda, * ), afac( ldafac, * ), rwork( * )
129 parameter( zero = 0.0e+0, one = 1.0e+0 )
149 IF( m.LE.0 .OR. n.LE.0 )
THEN
157 anorm =
slange(
'1', m, n, a, lda, rwork )
165 CALL
strmv(
'Lower',
'No transpose',
'Unit', m, afac,
166 $ ldafac, afac( 1, k ), 1 )
173 CALL
sscal( m-k, t, afac( k+1, k ), 1 )
174 CALL
sgemv(
'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 +
sdot( k-1, afac( k, 1 ), ldafac,
186 CALL
strmv(
'Lower',
'No transpose',
'Unit', k-1, afac,
187 $ ldafac, afac( 1, k ), 1 )
190 CALL
slaswp( n, afac, ldafac, 1, min( m, n ), ipiv, -1 )
196 afac( i,
j ) = afac( i,
j ) - a( i,
j )
202 resid =
slange(
'1', m, n, afac, ldafac, rwork )
204 IF( anorm.LE.zero )
THEN
208 resid = ( ( resid /
REAL( N ) ) / anorm ) / eps
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
real function sdot(N, SX, INCX, SY, INCY)
SDOT
subroutine strmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRMV
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
real function slamch(CMACH)
SLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine sget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
SGET01
subroutine slaswp(N, A, LDA, K1, K2, IPIV, INCX)
SLASWP performs a series of row interchanges on a general rectangular matrix.
subroutine sscal(N, SA, SX, INCX)
SSCAL