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