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
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 )
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
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 claswp(N, A, LDA, K1, K2, IPIV, INCX)
CLASWP performs a series of row interchanges on a general rectangular matrix.
subroutine ctrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRSM
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine xerbla(SRNAME, INFO)
XERBLA
integer function icamax(N, CX, INCX)
ICAMAX
subroutine cgetrf(M, N, A, LDA, IPIV, INFO)
CGETRF
real function slamch(CMACH)
SLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
logical function sisnan(SIN)
SISNAN tests input for NaN.