101 SUBROUTINE cgetrf ( M, N, A, LDA, IPIV, INFO)
109 INTEGER INFO, LDA, M, N
120 parameter( one = (1.0e+0, 0.0e+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(
'CGETRF', -info )
154 IF( m.EQ.0 .OR. n.EQ.0 )
159 nb = ilaenv( 1,
'CGETRF',
' ', m, n, -1, -1 )
160 IF( nb.LE.1 .OR. nb.GE.min( m, n ) )
THEN
164 CALL
cgetf2( m, n, a, lda, ipiv, info )
170 DO 20 j = 1, min( m, n ), nb
171 jb = min( min( m, n )-j+1, nb )
176 DO 30 k = 1, j-nb, nb
180 CALL
claswp( jb, a(1, j), lda, k, k+nb-1, ipiv, 1 )
184 CALL
ctrsm(
'Left',
'Lower',
'No transpose',
'Unit',
185 $ nb, jb, one, a( k, k ), lda,
190 CALL
cgemm(
'No transpose',
'No transpose',
191 $ m-k-nb+1, jb, nb, -one,
192 $ a( k+nb, k ), lda, a( k, j ), lda, one,
193 $ a( k+nb, j ), lda )
199 CALL
cgetf2( m-j+1, jb, a( j, j ), lda, ipiv( j ), iinfo )
203 IF( info.EQ.0 .AND. iinfo.GT.0 )
204 $ info = iinfo + j - 1
205 DO 10 i = j, min( m, j+jb-1 )
206 ipiv( i ) = j - 1 + ipiv( i )
214 DO 40 k = 1, min( m, n ), nb
215 CALL
claswp( k-1, a( 1, 1 ), lda, k,
216 $ min(k+nb-1, min( m, n )), ipiv, 1 )
223 CALL
claswp( n-m, a(1, m+1), lda, 1, m, ipiv, 1 )
227 jb = min( m-k+1, nb )
229 CALL
ctrsm(
'Left',
'Lower',
'No transpose',
'Unit',
230 $ jb, n-m, one, a( k, k ), lda,
234 IF ( k+nb.LE.m )
THEN
235 CALL
cgemm(
'No transpose',
'No transpose',
236 $ m-k-nb+1, n-m, nb, -one,
237 $ a( k+nb, k ), lda, a( k, m+1 ), lda, one,
238 $ a( k+nb, m+1 ), lda )
subroutine claswp(N, A, LDA, K1, K2, IPIV, INCX)
CLASWP performs a series of row interchanges on a general rectangular matrix.
subroutine ctrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRSM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cgetrf(M, N, A, LDA, IPIV, INFO)
CGETRF
subroutine cgetf2(M, N, A, LDA, IPIV, INFO)
CGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row inter...
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM