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
166 EXTERNAL slamch, isamax, sisnan
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 )
198 sfmin = slamch(
'S' )
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 sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slaswp(N, A, LDA, K1, K2, IPIV, INCX)
SLASWP performs a series of row interchanges on a general rectangular matrix.
subroutine sgetrf(M, N, A, LDA, IPIV, INFO)
SGETRF
subroutine sscal(N, SA, SX, INCX)
SSCAL