132 SUBROUTINE dchktz( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
133 $ copya, s, tau, work, nout )
143 DOUBLE PRECISION thresh
147 INTEGER mval( * ), nval( * )
148 DOUBLE PRECISION a( * ), copya( * ), s( * ),
149 $ tau( * ), work( * )
156 parameter( ntypes = 3 )
158 parameter( ntests = 6 )
159 DOUBLE PRECISION one, zero
160 parameter( one = 1.0d0, zero = 0.0d0 )
164 INTEGER i, im, imode, in, info, k, lda, lwork, m,
165 $ mnmin, mode, n, nerrs, nfail, nrun
169 INTEGER iseed( 4 ), iseedy( 4 )
170 DOUBLE PRECISION result( ntests )
186 INTEGER infot, iounit
189 COMMON / infoc / infot, iounit, ok, lerr
190 COMMON / srnamc / srnamt
193 DATA iseedy / 1988, 1989, 1990, 1991 /
199 path( 1: 1 ) =
'Double precision'
205 iseed( i ) = iseedy( i )
212 $ CALL
derrtz( path, nout )
228 lwork = max( 1, n*n+4*m+n, m*n+2*mnmin+4*n )
231 DO 50 imode = 1, ntypes
232 IF( .NOT.dotype( imode ) )
248 CALL
dlaset(
'Full', m, n, zero, zero, a, lda )
253 CALL
dlatms( m, n,
'Uniform', iseed,
254 $
'Nonsymmetric', s, imode,
255 $ one / eps, one, m, n,
'No packing', a,
257 CALL
dgeqr2( m, n, a, lda, work, work( mnmin+1 ),
259 CALL
dlaset(
'Lower', m-1, n, zero, zero, a( 2 ),
261 CALL
dlaord(
'Decreasing', mnmin, s, 1 )
266 CALL
dlacpy(
'All', m, n, a, lda, copya, lda )
272 CALL
dtzrqf( m, n, a, lda, tau, info )
276 result( 1 ) =
dqrt12( m, m, a, lda, s, work,
281 result( 2 ) =
dtzt01( m, n, copya, a, lda, tau, work,
286 result( 3 ) =
dtzt02( m, n, a, lda, tau, work, lwork )
294 CALL
dlaset(
'Full', m, n, zero, zero, a, lda )
299 CALL
dlatms( m, n,
'Uniform', iseed,
300 $
'Nonsymmetric', s, imode,
301 $ one / eps, one, m, n,
'No packing', a,
303 CALL
dgeqr2( m, n, a, lda, work, work( mnmin+1 ),
305 CALL
dlaset(
'Lower', m-1, n, zero, zero, a( 2 ),
307 CALL
dlaord(
'Decreasing', mnmin, s, 1 )
312 CALL
dlacpy(
'All', m, n, a, lda, copya, lda )
318 CALL
dtzrzf( m, n, a, lda, tau, work, lwork, info )
322 result( 4 ) =
dqrt12( m, m, a, lda, s, work,
327 result( 5 ) =
drzt01( m, n, copya, a, lda, tau, work,
332 result( 6 ) =
drzt02( m, n, a, lda, tau, work, lwork )
338 IF( result( k ).GE.thresh )
THEN
339 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
340 $ CALL
alahd( nout, path )
341 WRITE( nout, fmt = 9999 )m, n, imode, k,
354 CALL
alasum( path, nout, nfail, nrun, nerrs )
356 9999
FORMAT(
' M =', i5,
', N =', i5,
', type ', i2,
', test ', i2,
357 $
', ratio =', g12.5 )
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine dtzrzf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DTZRZF
subroutine dlaord(JOB, N, X, INCX)
DLAORD
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
DOUBLE PRECISION function dtzt01(M, N, A, AF, LDA, TAU, WORK, LWORK)
DTZT01
subroutine dchktz(DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, NOUT)
DCHKTZ
DOUBLE PRECISION function dqrt12(M, N, A, LDA, S, WORK, LWORK)
DQRT12
subroutine derrtz(PATH, NUNIT)
DERRTZ
subroutine dgeqr2(M, N, A, LDA, TAU, WORK, INFO)
DGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm...
DOUBLE PRECISION function drzt02(M, N, AF, LDA, TAU, WORK, LWORK)
DRZT02
DOUBLE PRECISION function dtzt02(M, N, AF, LDA, TAU, WORK, LWORK)
DTZT02
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine dtzrqf(M, N, A, LDA, TAU, INFO)
DTZRQF
DOUBLE PRECISION function drzt01(M, N, A, AF, LDA, TAU, WORK, LWORK)
DRZT01