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
158 DOUBLE PRECISION DLAMCH, ZLANSY
160 EXTERNAL lsame, dlamch, zlansy, zdotc
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 zunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
ZUNT01
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...
subroutine zherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
ZHERK