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 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...
subroutine dgetrf(M, N, A, LDA, IPIV, INFO)
DGETRF
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRSM
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
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.