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, 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 )
169 DO 20
j = 1, min( m, n ), nb
170 jb = min( min( m, n )-
j+1, nb )
174 CALL
cgemm(
'No transpose',
'No transpose',
175 $ m-
j+1, jb,
j-1, -one,
176 $ a(
j, 1 ), lda, a( 1,
j ), lda, one,
183 CALL
cgetf2( m-
j+1, jb, a(
j,
j ), lda, ipiv(
j ), iinfo )
187 IF( info.EQ.0 .AND. iinfo.GT.0 )
188 $ info = iinfo +
j - 1
189 DO 10 i =
j, min( m,
j+jb-1 )
190 ipiv( i ) =
j - 1 + ipiv( i )
195 CALL
claswp(
j-1, a, lda,
j,
j+jb-1, ipiv, 1 )
197 IF (
j+jb.LE.n )
THEN
201 CALL
claswp( n-
j-jb+1, a( 1,
j+jb ), lda,
j,
j+jb-1,
204 CALL
cgemm(
'No transpose',
'No transpose',
205 $ jb, n-
j-jb+1,
j-1, -one,
206 $ a(
j, 1 ), lda, a( 1,
j+jb ), lda, one,
207 $ a(
j,
j+jb ), lda )
211 CALL
ctrsm(
'Left',
'Lower',
'No transpose',
'Unit',
212 $ jb, n-
j-jb+1, one, a(
j,
j ), lda,
213 $ a(
j,
j+jb ), 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...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM