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 )
208 jp = j - 1 +
isamax( m-j+1, a( j, j ), 1 )
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 )
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 sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
integer function isamax(N, SX, INCX)
ISAMAX
subroutine sgetrf(M, N, A, LDA, IPIV, INFO)
SGETRF
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function sisnan(SIN)
SISNAN tests input for NaN.
real function slamch(CMACH)
SLAMCH
subroutine sscal(N, SA, SX, INCX)
SSCAL