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