135 SUBROUTINE sgetrf( M, N, A, LDA, IPIV, INFO )
143 INTEGER info, lda, m, n
153 REAL one, zero, negone
154 parameter( one = 1.0e+0, zero = 0.0e+0 )
155 parameter( negone = -1.0e+0 )
159 INTEGER i,
j, jp, nstep, ntopiv, npived, kahead
160 INTEGER kstart, ipivstart, jpivstart, kcols
172 INTRINSIC max, min, iand
181 ELSE IF( n.LT.0 )
THEN
183 ELSE IF( lda.LT.max( 1, m ) )
THEN
187 CALL
xerbla(
'SGETRF', -info )
193 IF( m.EQ.0 .OR. n.EQ.0 )
202 kahead = iand(
j, -
j )
203 kstart =
j + 1 - kahead
204 kcols = min( kahead, m-
j )
214 a(
j,
j ) = a( jp,
j )
221 jpivstart =
j - ntopiv
222 DO WHILE ( ntopiv .LT. kahead )
223 CALL
slaswp( ntopiv, a( 1, jpivstart ), lda, ipivstart,
j,
225 ipivstart = ipivstart - ntopiv;
227 jpivstart = jpivstart - ntopiv;
231 CALL
slaswp( kcols, a( 1,
j+1 ), lda, kstart,
j, ipiv, 1 )
234 IF( a(
j,
j ).NE.zero .AND. .NOT.
sisnan( a(
j,
j ) ) )
THEN
235 IF( abs(a(
j,
j )) .GE. sfmin )
THEN
236 CALL
sscal( m-
j, one / a(
j,
j ), a(
j+1,
j ), 1 )
239 a(
j+i,
j ) = a(
j+i,
j ) / a(
j,
j )
242 ELSE IF( a(
j,
j ) .EQ. zero .AND. info .EQ. 0 )
THEN
247 CALL
strsm(
'Left',
'Lower',
'No transpose',
'Unit', kahead,
248 $ kcols, one, a( kstart, kstart ), lda,
249 $ a( kstart,
j+1 ), lda )
251 CALL
sgemm(
'No transpose',
'No transpose', m-
j,
252 $ kcols, kahead, negone, a(
j+1, kstart ), lda,
253 $ a( kstart,
j+1 ), lda, one, a(
j+1,
j+1 ), lda )
257 npived = iand( nstep, -nstep )
259 DO WHILE (
j .GT. 0 )
260 ntopiv = iand(
j, -
j )
261 CALL
slaswp( ntopiv, a( 1,
j-ntopiv+1 ), lda,
j+1, nstep,
268 CALL
slaswp( n-m, a( 1, m+kcols+1 ), lda, 1, m, ipiv, 1 )
269 CALL
strsm(
'Left',
'Lower',
'No transpose',
'Unit', m,
270 $ n-m, one, a, lda, a( 1,m+kcols+1 ), lda )
integer function isamax(N, SX, INCX)
ISAMAX
subroutine sgetrf(M, N, A, LDA, IPIV, INFO)
SGETRF
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
real function slamch(CMACH)
SLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
logical function sisnan(SIN)
SISNAN tests input for NaN.
subroutine strsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
STRSM
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