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 )
double precision function dlamch(CMACH)
DLAMCH
subroutine dgetrf(M, N, A, LDA, IPIV, INFO)
DGETRF
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRSM
integer function idamax(N, DX, INCX)
IDAMAX
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
logical function disnan(DIN)
DISNAN tests input for NaN.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlaswp(N, A, LDA, K1, K2, IPIV, INCX)
DLASWP performs a series of row interchanges on a general rectangular matrix.
subroutine dscal(N, DA, DX, INCX)
DSCAL