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 )
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 )