101 SUBROUTINE dgetrf ( M, N, A, LDA, IPIV, INFO)
109 INTEGER info, lda, m, n
113 DOUBLE PRECISION a( lda, * )
120 parameter( one = 1.0d+0 )
123 INTEGER i, iinfo,
j, jb, k, nb
142 ELSE IF( n.LT.0 )
THEN
144 ELSE IF( lda.LT.max( 1, m ) )
THEN
148 CALL
xerbla(
'DGETRF', -info )
154 IF( m.EQ.0 .OR. n.EQ.0 )
159 nb =
ilaenv( 1,
'DGETRF',
' ', m, n, -1, -1 )
160 IF( nb.LE.1 .OR. nb.GE.min( m, n ) )
THEN
164 CALL
dgetf2( m, n, a, lda, ipiv, info )
170 DO 20
j = 1, min( m, n ), nb
171 jb = min( min( m, n )-
j+1, nb )
175 DO 30 k = 1,
j-nb, nb
179 CALL
dlaswp( jb, a(1,
j), lda, k, k+nb-1, ipiv, 1 )
183 CALL
dtrsm(
'Left',
'Lower',
'No transpose',
'Unit',
184 $ nb, jb, one, a( k, k ), lda,
189 CALL
dgemm(
'No transpose',
'No transpose',
190 $ m-k-nb+1, jb, nb, -one,
191 $ a( k+nb, k ), lda, a( k,
j ), lda, one,
192 $ a( k+nb,
j ), lda )
198 CALL
dgetf2( m-
j+1, jb, a(
j,
j ), lda, ipiv(
j ), iinfo )
202 IF( info.EQ.0 .AND. iinfo.GT.0 )
203 $ info = iinfo +
j - 1
204 DO 10 i =
j, min( m,
j+jb-1 )
205 ipiv( i ) =
j - 1 + ipiv( i )
213 DO 40 k = 1, min( m, n ), nb
214 CALL
dlaswp( k-1, a( 1, 1 ), lda, k,
215 $ min(k+nb-1, min( m, n )), ipiv, 1 )
222 CALL
dlaswp( n-m, a(1, m+1), lda, 1, m, ipiv, 1 )
226 jb = min( m-k+1, nb )
228 CALL
dtrsm(
'Left',
'Lower',
'No transpose',
'Unit',
229 $ jb, n-m, one, a( k, k ), lda,
233 IF ( k+nb.LE.m )
THEN
234 CALL
dgemm(
'No transpose',
'No transpose',
235 $ m-k-nb+1, n-m, nb, -one,
236 $ a( k+nb, k ), lda, a( k, m+1 ), lda, one,
237 $ a( k+nb, m+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 dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRSM
subroutine dgetf2(M, N, A, LDA, IPIV, INFO)
DGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row inter...
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dgetrf(M, N, A, LDA, IPIV, INFO)
DGETRF