124 SUBROUTINE cunt01( ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK,
133 INTEGER LDU, LWORK, M, N
138 COMPLEX U( LDU, * ), WORK( * )
145 parameter( zero = 0.0e+0, one = 1.0e+0 )
149 INTEGER I, J, K, LDWORK, MNMIN
157 EXTERNAL lsame, clansy, slamch, cdotc
163 INTRINSIC abs, aimag, cmplx, max, min, real
169 cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( zdum ) )
177 IF( m.LE.0 .OR. n.LE.0 )
180 eps = slamch(
'Precision' )
181 IF( m.LT.n .OR. ( m.EQ.n .AND. lsame( rowcol,
'R' ) ) )
THEN
190 IF( ( mnmin+1 )*mnmin.LE.lwork )
THEN
195 IF( ldwork.GT.0 )
THEN
199 CALL claset(
'Upper', mnmin, mnmin, cmplx( zero ),
200 $ cmplx( one ), work, ldwork )
201 CALL cherk(
'Upper', transu, mnmin, k, -one, u, ldu, one, work,
206 resid = clansy(
'1',
'Upper', mnmin, work, ldwork, rwork )
207 resid = ( resid / real( k ) ) / eps
208 ELSE IF( transu.EQ.
'C' )
THEN
219 tmp = tmp - cdotc( m, u( 1, i ), 1, u( 1, j ), 1 )
220 resid = max( resid, cabs1( tmp ) )
223 resid = ( resid / real( m ) ) / eps
235 tmp = tmp - cdotc( n, u( j, 1 ), ldu, u( i, 1 ), ldu )
236 resid = max( resid, cabs1( tmp ) )
239 resid = ( resid / real( n ) ) / eps
subroutine cherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
CHERK
subroutine cunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
CUNT01
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.