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 )
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 )
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
DOUBLE PRECISION function zrzt02(M, N, AF, LDA, TAU, WORK, LWORK)
ZRZT02
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
DOUBLE PRECISION function zrzt01(M, N, A, AF, LDA, TAU, WORK, LWORK)
ZRZT01
DOUBLE PRECISION function ztzt02(M, N, AF, LDA, TAU, WORK, LWORK)
ZTZT02
subroutine ztzrzf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
ZTZRZF
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
DOUBLE PRECISION function zqrt12(M, N, A, LDA, S, WORK, LWORK, RWORK)
ZQRT12
DOUBLE PRECISION function ztzt01(M, N, A, AF, LDA, TAU, WORK, LWORK)
ZTZT01