126 SUBROUTINE zunt01( ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK,
136 INTEGER ldu, lwork, m, n
137 DOUBLE PRECISION resid
140 DOUBLE PRECISION rwork( * )
141 COMPLEX*16 u( ldu, * ), work( * )
147 DOUBLE PRECISION zero, one
148 parameter( zero = 0.0d+0, one = 1.0d+0 )
152 INTEGER i,
j, k, ldwork, mnmin
166 INTRINSIC abs, dble, dcmplx, dimag, max, min
169 DOUBLE PRECISION cabs1
172 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
180 IF( m.LE.0 .OR. n.LE.0 )
183 eps =
dlamch(
'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
zlaset(
'Upper', mnmin, mnmin, dcmplx( zero ),
203 $ dcmplx( one ), work, ldwork )
204 CALL
zherk(
'Upper', transu, mnmin, k, -one, u, ldu, one, work,
209 resid =
zlansy(
'1',
'Upper', mnmin, work, ldwork, rwork )
210 resid = ( resid / dble( k ) ) / eps
211 ELSE IF( transu.EQ.
'C' )
THEN
222 tmp = tmp -
zdotc( m, u( 1, i ), 1, u( 1,
j ), 1 )
223 resid = max( resid, cabs1( tmp ) )
226 resid = ( resid / dble( m ) ) / eps
238 tmp = tmp -
zdotc( n, u(
j, 1 ), ldu, u( i, 1 ), ldu )
239 resid = max( resid, cabs1( tmp ) )
242 resid = ( resid / dble( n ) ) / eps
subroutine zherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
ZHERK
double precision function zlansy(NORM, UPLO, N, A, LDA, WORK)
ZLANSY 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 zunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
ZUNT01
complex *16 function zdotc(N, ZX, INCX, ZY, INCY)
ZDOTC
logical function lsame(CA, CB)
LSAME
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j