108 SUBROUTINE cget01( M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK,
117 INTEGER lda, ldafac, m, n
123 COMPLEX a( lda, * ), afac( ldafac, * )
130 parameter( zero = 0.0e+0, one = 1.0e+0 )
132 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
154 IF( m.LE.0 .OR. n.LE.0 )
THEN
162 anorm =
clange(
'1', m, n, a, lda, rwork )
170 CALL
ctrmv(
'Lower',
'No transpose',
'Unit', m, afac,
171 $ ldafac, afac( 1, k ), 1 )
178 CALL
cscal( m-k, t, afac( k+1, k ), 1 )
179 CALL
cgemv(
'No transpose', m-k, k-1, cone,
180 $ afac( k+1, 1 ), ldafac, afac( 1, k ), 1,
181 $ cone, afac( k+1, k ), 1 )
186 afac( k, k ) = t +
cdotu( k-1, afac( k, 1 ), ldafac,
191 CALL
ctrmv(
'Lower',
'No transpose',
'Unit', k-1, afac,
192 $ ldafac, afac( 1, k ), 1 )
195 CALL
claswp( n, afac, ldafac, 1, min( m, n ), ipiv, -1 )
201 afac( i,
j ) = afac( i,
j ) - a( i,
j )
207 resid =
clange(
'1', m, n, afac, ldafac, rwork )
209 IF( anorm.LE.zero )
THEN
213 resid = ( ( resid/
REAL( N ) )/anorm ) / eps
subroutine claswp(N, A, LDA, K1, K2, IPIV, INCX)
CLASWP performs a series of row interchanges on a general rectangular matrix.
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine cget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
CGET01
REAL function slamch(CMACH)
SLAMCH
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
COMPLEX function cdotu(N, CX, INCX, CY, INCY)
CDOTU
REAL function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ctrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
CTRMV