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 = 6 )
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, CTZT01, CTZT02, SLAMCH
179 EXTERNAL cqrt12, crzt01, crzt02, ctzt01, ctzt02, 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
ctzrqf( m, n, a, lda, tau, info )
282 result( 1 ) = cqrt12( m, m, a, lda, s, work,
287 result( 2 ) = ctzt01( m, n, copya, a, lda, tau, work,
292 result( 3 ) = ctzt02( m, n, a, lda, tau, work, lwork )
300 CALL
claset(
'Full', m, n, cmplx( zero ),
301 $ cmplx( zero ), a, lda )
306 CALL
clatms( m, n,
'Uniform', iseed,
307 $
'Nonsymmetric', s, imode,
308 $ one / eps, one, m, n,
'No packing', a,
310 CALL
cgeqr2( m, n, a, lda, work, work( mnmin+1 ),
312 CALL
claset(
'Lower', m-1, n, cmplx( zero ),
313 $ cmplx( zero ), a( 2 ), lda )
314 CALL
slaord(
'Decreasing', mnmin, s, 1 )
319 CALL
clacpy(
'All', m, n, a, lda, copya, lda )
325 CALL
ctzrzf( m, n, a, lda, tau, work, lwork, info )
329 result( 4 ) = cqrt12( m, m, a, lda, s, work,
334 result( 5 ) = crzt01( m, n, copya, a, lda, tau, work,
339 result( 6 ) = crzt02( m, n, a, lda, tau, work, lwork )
345 IF( result( k ).GE.thresh )
THEN
346 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
347 $ CALL
alahd( nout, path )
348 WRITE( nout, fmt = 9999 )m, n, imode, k,
361 CALL
alasum( path, nout, nfail, nrun, nerrs )
363 9999
FORMAT(
' M =', i5,
', N =', i5,
', type ', i2,
', test ', i2,
364 $
', ratio =', g12.5 )
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 alahd(IOUNIT, PATH)
ALAHD
subroutine cerrtz(PATH, NUNIT)
CERRTZ
subroutine ctzrqf(M, N, A, LDA, TAU, INFO)
CTZRQF
subroutine cgeqr2(M, N, A, LDA, TAU, WORK, INFO)
CGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm...
subroutine cchktz(DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, RWORK, NOUT)
CCHKTZ
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
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 ctzrzf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
CTZRZF