135 SUBROUTINE dgetrf( M, N, A, LDA, IPIV, INFO )
143 INTEGER info, lda, m, n
147 DOUBLE PRECISION a( lda, * )
153 DOUBLE PRECISION one, zero, negone
154 parameter( one = 1.0d+0, zero = 0.0d+0 )
155 parameter( negone = -1.0d+0 )
158 DOUBLE PRECISION sfmin, tmp
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(
'DGETRF', -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 +
idamax( 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
dlaswp( ntopiv, a( 1, jpivstart ), lda, ipivstart, j,
225 ipivstart = ipivstart - ntopiv;
227 jpivstart = jpivstart - ntopiv;
231 CALL
dlaswp( kcols, a( 1,j+1 ), lda, kstart, j, ipiv, 1 )
234 IF( a( j, j ).NE.zero .AND. .NOT.
disnan( a( j, j ) ) )
THEN
235 IF( abs(a( j, j )) .GE. sfmin )
THEN
236 CALL
dscal( 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
dtrsm(
'Left',
'Lower',
'No transpose',
'Unit', kahead,
248 $ kcols, one, a( kstart, kstart ), lda,
249 $ a( kstart, j+1 ), lda )
251 CALL
dgemm(
'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
dlaswp( ntopiv, a( 1, j-ntopiv+1 ), lda, j+1, nstep,
268 CALL
dlaswp( n-m, a( 1, m+kcols+1 ), lda, 1, m, ipiv, 1 )
269 CALL
dtrsm(
'Left',
'Lower',
'No transpose',
'Unit', m,
270 $ n-m, one, a, lda, a( 1,m+kcols+1 ), lda )