137 SUBROUTINE zchktz( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
138 $ copya, s, tau, work, rwork, nout )
148 DOUBLE PRECISION THRESH
152 INTEGER MVAL( * ), NVAL( * )
153 DOUBLE PRECISION S( * ), RWORK( * )
154 COMPLEX*16 A( * ), COPYA( * ), TAU( * ), WORK( * )
161 parameter( ntypes = 3 )
163 parameter( ntests = 6 )
164 DOUBLE PRECISION ONE, ZERO
165 parameter( one = 1.0d0, zero = 0.0d0 )
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 DOUBLE PRECISION RESULT( ntests )
178 DOUBLE PRECISION DLAMCH, ZQRT12, ZRZT01, ZRZT02, ZTZT01, ZTZT02
179 EXTERNAL dlamch, zqrt12, zrzt01, zrzt02, ztzt01, ztzt02
186 INTRINSIC dcmplx, 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 ) =
'Zomplex precision'
210 iseed( i ) = iseedy( i )
212 eps = dlamch(
'Epsilon' )
217 $
CALL zerrtz( path, nout )
233 lwork = max( 1, n*n+4*m+n )
236 DO 50 imode = 1, ntypes
237 IF( .NOT.dotype( imode ) )
253 CALL zlaset(
'Full', m, n, dcmplx( zero ),
254 $ dcmplx( zero ), a, lda )
259 CALL zlatms( m, n,
'Uniform', iseed,
260 $
'Nonsymmetric', s, imode,
261 $ one / eps, one, m, n,
'No packing', a,
263 CALL zgeqr2( m, n, a, lda, work, work( mnmin+1 ),
265 CALL zlaset(
'Lower', m-1, n, dcmplx( zero ),
266 $ dcmplx( zero ), a( 2 ), lda )
267 CALL dlaord(
'Decreasing', mnmin, s, 1 )
272 CALL zlacpy(
'All', m, n, a, lda, copya, lda )
278 CALL ztzrqf( m, n, a, lda, tau, info )
282 result( 1 ) = zqrt12( m, m, a, lda, s, work,
287 result( 2 ) = ztzt01( m, n, copya, a, lda, tau, work,
292 result( 3 ) = ztzt02( m, n, a, lda, tau, work, lwork )
300 CALL zlaset(
'Full', m, n, dcmplx( zero ),
301 $ dcmplx( zero ), a, lda )
306 CALL zlatms( m, n,
'Uniform', iseed,
307 $
'Nonsymmetric', s, imode,
308 $ one / eps, one, m, n,
'No packing', a,
310 CALL zgeqr2( m, n, a, lda, work, work( mnmin+1 ),
312 CALL zlaset(
'Lower', m-1, n, dcmplx( zero ),
313 $ dcmplx( zero ), a( 2 ), lda )
314 CALL dlaord(
'Decreasing', mnmin, s, 1 )
319 CALL zlacpy(
'All', m, n, a, lda, copya, lda )
325 CALL ztzrzf( m, n, a, lda, tau, work, lwork, info )
329 result( 4 ) = zqrt12( m, m, a, lda, s, work,
334 result( 5 ) = zrzt01( m, n, copya, a, lda, tau, work,
339 result( 6 ) = zrzt02( 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 zgeqr2(M, N, A, LDA, TAU, WORK, INFO)
ZGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm...
subroutine zchktz(DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, RWORK, NOUT)
ZCHKTZ
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zerrtz(PATH, NUNIT)
ZERRTZ
subroutine ztzrqf(M, N, A, LDA, TAU, INFO)
ZTZRQF
subroutine dlaord(JOB, N, X, INCX)
DLAORD
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 alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine ztzrzf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
ZTZRZF
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS