135 SUBROUTINE cgetrf( M, N, A, LDA, IPIV, INFO )
143 INTEGER INFO, LDA, M, N
155 parameter ( one = (1.0e+0, 0.0e+0) )
156 parameter ( negone = (-1.0e+0, 0.0e+0) )
157 parameter ( zero = 0.0e+0 )
162 INTEGER I, J, JP, NSTEP, NTOPIV, NPIVED, KAHEAD
163 INTEGER KSTART, IPIVSTART, JPIVSTART, KCOLS
169 EXTERNAL slamch, icamax, sisnan
175 INTRINSIC max, min, iand, abs
184 ELSE IF( n.LT.0 )
THEN
186 ELSE IF( lda.LT.max( 1, m ) )
THEN
190 CALL xerbla(
'CGETRF', -info )
196 IF( m.EQ.0 .OR. n.EQ.0 )
201 sfmin = slamch(
'S' )
205 kahead = iand( j, -j )
206 kstart = j + 1 - kahead
207 kcols = min( kahead, m-j )
211 jp = j - 1 + icamax( m-j+1, a( j, j ), 1 )
217 a( j, j ) = a( jp, j )
224 jpivstart = j - ntopiv
225 DO WHILE ( ntopiv .LT. kahead )
226 CALL claswp( ntopiv, a( 1, jpivstart ), lda, ipivstart, j,
228 ipivstart = ipivstart - ntopiv;
230 jpivstart = jpivstart - ntopiv;
234 CALL claswp( kcols, a( 1,j+1 ), lda, kstart, j, ipiv, 1 )
237 pivmag = abs( a( j, j ) )
238 IF( pivmag.NE.zero .AND. .NOT.sisnan( pivmag ) )
THEN
239 IF( pivmag .GE. sfmin )
THEN
240 CALL cscal( m-j, one / a( j, j ), a( j+1, j ), 1 )
243 a( j+i, j ) = a( j+i, j ) / a( j, j )
246 ELSE IF( pivmag .EQ. zero .AND. info .EQ. 0 )
THEN
251 CALL ctrsm(
'Left',
'Lower',
'No transpose',
'Unit', kahead,
252 $ kcols, one, a( kstart, kstart ), lda,
253 $ a( kstart, j+1 ), lda )
255 CALL cgemm(
'No transpose',
'No transpose', m-j,
256 $ kcols, kahead, negone, a( j+1, kstart ), lda,
257 $ a( kstart, j+1 ), lda, one, a( j+1, j+1 ), lda )
261 npived = iand( nstep, -nstep )
263 DO WHILE ( j .GT. 0 )
264 ntopiv = iand( j, -j )
265 CALL claswp( ntopiv, a( 1, j-ntopiv+1 ), lda, j+1, nstep,
272 CALL claswp( n-m, a( 1, m+kcols+1 ), lda, 1, m, ipiv, 1 )
273 CALL ctrsm(
'Left',
'Lower',
'No transpose',
'Unit', m,
274 $ n-m, one, a, lda, a( 1,m+kcols+1 ), lda )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine ctrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRSM
subroutine cgetrf(M, N, A, LDA, IPIV, INFO)
CGETRF
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
subroutine claswp(N, A, LDA, K1, K2, IPIV, INCX)
CLASWP performs a series of row interchanges on a general rectangular matrix.