135 SUBROUTINE zgetrf( M, N, A, LDA, IPIV, INFO )
143 INTEGER info, lda, m, n
147 COMPLEX*16 a( lda, * )
153 COMPLEX*16 one, negone
154 DOUBLE PRECISION zero
155 parameter ( one = (1.0d+0, 0.0d+0) )
156 parameter ( negone = (-1.0d+0, 0.0d+0) )
157 parameter ( zero = 0.0d+0 )
160 DOUBLE PRECISION sfmin, pivmag
162 INTEGER i, j, jp, nstep, ntopiv, npived, kahead
163 INTEGER kstart, ipivstart, jpivstart, kcols
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(
'ZGETRF', -info )
196 IF( m.EQ.0 .OR. n.EQ.0 )
205 kahead = iand( j, -j )
206 kstart = j + 1 - kahead
207 kcols = min( kahead, m-j )
211 jp = j - 1 +
izamax( 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 zlaswp( ntopiv, a( 1, jpivstart ), lda, ipivstart, j,
228 ipivstart = ipivstart - ntopiv;
230 jpivstart = jpivstart - ntopiv;
234 CALL zlaswp( kcols, a( 1,j+1 ), lda, kstart, j, ipiv, 1 )
237 pivmag = abs( a( j, j ) )
238 IF( pivmag.NE.zero .AND. .NOT.
disnan( pivmag ) )
THEN
239 IF( pivmag .GE. sfmin )
THEN
240 CALL zscal( 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 ztrsm(
'Left',
'Lower',
'No transpose',
'Unit', kahead,
252 $ kcols, one, a( kstart, kstart ), lda,
253 $ a( kstart, j+1 ), lda )
255 CALL zgemm(
'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 zlaswp( ntopiv, a( 1, j-ntopiv+1 ), lda, j+1, nstep,
272 CALL zlaswp( n-m, a( 1, m+kcols+1 ), lda, 1, m, ipiv, 1 )
273 CALL ztrsm(
'Left',
'Lower',
'No transpose',
'Unit', m,
274 $ n-m, one, a, lda, a( 1,m+kcols+1 ), lda )
double precision function dlamch(CMACH)
DLAMCH
subroutine zlaswp(N, A, LDA, K1, K2, IPIV, INCX)
ZLASWP performs a series of row interchanges on a general rectangular matrix.
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
integer function izamax(N, ZX, INCX)
IZAMAX
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
logical function disnan(DIN)
DISNAN tests input for NaN.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ztrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRSM
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL