126 SUBROUTINE cunt01( ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK,
136 INTEGER ldu, lwork, m, n
141 COMPLEX u( ldu, * ), work( * )
148 parameter( zero = 0.0e+0, one = 1.0e+0 )
152 INTEGER i,
j, k, ldwork, mnmin
166 INTRINSIC abs, aimag, cmplx, max, min, real
172 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( aimag( zdum ) )
180 IF( m.LE.0 .OR. n.LE.0 )
183 eps =
slamch(
'Precision' )
184 IF( m.LT.n .OR. ( m.EQ.n .AND.
lsame( rowcol,
'R' ) ) )
THEN
193 IF( ( mnmin+1 )*mnmin.LE.lwork )
THEN
198 IF( ldwork.GT.0 )
THEN
202 CALL
claset(
'Upper', mnmin, mnmin, cmplx( zero ),
203 $ cmplx( one ), work, ldwork )
204 CALL
cherk(
'Upper', transu, mnmin, k, -one, u, ldu, one, work,
209 resid =
clansy(
'1',
'Upper', mnmin, work, ldwork, rwork )
210 resid = ( resid /
REAL( K ) ) / eps
211 ELSE IF( transu.EQ.
'C' )
THEN
222 tmp = tmp -
cdotc( m, u( 1, i ), 1, u( 1,
j ), 1 )
223 resid = max( resid, cabs1( tmp ) )
226 resid = ( resid /
REAL( M ) ) / eps
238 tmp = tmp -
cdotc( n, u(
j, 1 ), ldu, u( i, 1 ), ldu )
239 resid = max( resid, cabs1( tmp ) )
242 resid = ( resid /
REAL( N ) ) / eps
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine cunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
CUNT01
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
COMPLEX function cdotc(N, CX, INCX, CY, INCY)
CDOTC
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
REAL function clansy(NORM, UPLO, N, A, LDA, WORK)
CLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex symmetric matrix.
subroutine cherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
CHERK