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
166 DOUBLE PRECISION DLAMCH
169 EXTERNAL dlamch, izamax, disnan
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 )
201 sfmin = dlamch(
'S' )
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 )
subroutine zlaswp(N, A, LDA, K1, K2, IPIV, INCX)
ZLASWP performs a series of row interchanges on a general rectangular matrix.
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
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