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 )
subroutine ztrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRSM
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
LOGICAL function disnan(DIN)
DISNAN tests input for NaN.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zlaswp(N, A, LDA, K1, K2, IPIV, INCX)
ZLASWP performs a series of row interchanges on a general rectangular matrix.
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
INTEGER function izamax(N, ZX, INCX)
IZAMAX
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL