137 SUBROUTINE cchktz( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
138 $ copya, s, tau, work, rwork, nout )
152 INTEGER MVAL( * ), NVAL( * )
153 REAL S( * ), RWORK( * )
154 COMPLEX A( * ), COPYA( * ), TAU( * ), WORK( * )
161 parameter ( ntypes = 3 )
163 parameter ( ntests = 3 )
165 parameter ( one = 1.0e0, zero = 0.0e0 )
169 INTEGER I, IM, IMODE, IN, INFO, K, LDA, LWORK, M,
170 $ mnmin, mode, n, nerrs, nfail, nrun
174 INTEGER ISEED( 4 ), ISEEDY( 4 )
175 REAL RESULT( ntests )
178 REAL CQRT12, CRZT01, CRZT02, SLAMCH
179 EXTERNAL cqrt12, crzt01, crzt02, slamch
186 INTRINSIC cmplx, max, min
191 INTEGER INFOT, IOUNIT
194 COMMON / infoc / infot, iounit, ok, lerr
195 COMMON / srnamc / srnamt
198 DATA iseedy / 1988, 1989, 1990, 1991 /
204 path( 1: 1 ) =
'Complex precision'
210 iseed( i ) = iseedy( i )
212 eps = slamch(
'Epsilon' )
217 $
CALL cerrtz( path, nout )
233 lwork = max( 1, n*n+4*m+n )
236 DO 50 imode = 1, ntypes
237 IF( .NOT.dotype( imode ) )
253 CALL claset(
'Full', m, n, cmplx( zero ),
254 $ cmplx( zero ), a, lda )
259 CALL clatms( m, n,
'Uniform', iseed,
260 $
'Nonsymmetric', s, imode,
261 $ one / eps, one, m, n,
'No packing', a,
263 CALL cgeqr2( m, n, a, lda, work, work( mnmin+1 ),
265 CALL claset(
'Lower', m-1, n, cmplx( zero ),
266 $ cmplx( zero ), a( 2 ), lda )
267 CALL slaord(
'Decreasing', mnmin, s, 1 )
272 CALL clacpy(
'All', m, n, a, lda, copya, lda )
278 CALL ctzrzf( m, n, a, lda, tau, work, lwork, info )
282 result( 1 ) = cqrt12( m, m, a, lda, s, work,
287 result( 2 ) = crzt01( m, n, copya, a, lda, tau, work,
292 result( 3 ) = crzt02( m, n, a, lda, tau, work, lwork )
298 IF( result( k ).GE.thresh )
THEN
299 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
300 $
CALL alahd( nout, path )
301 WRITE( nout, fmt = 9999 )m, n, imode, k,
314 CALL alasum( path, nout, nfail, nrun, nerrs )
316 9999
FORMAT(
' M =', i5,
', N =', i5,
', type ', i2,
', test ', i2,
317 $
', ratio =', g12.5 )
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine cerrtz(PATH, NUNIT)
CERRTZ
subroutine cgeqr2(M, N, A, LDA, TAU, WORK, INFO)
CGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm...
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 clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine slaord(JOB, N, X, INCX)
SLAORD
subroutine cchktz(DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, RWORK, NOUT)
CCHKTZ
subroutine ctzrzf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
CTZRZF
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM