200 SUBROUTINE dchkqr( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
201 $ nrhs, thresh, tsterr, nmax, a, af, aq, ar, ac,
202 $ b, x, xact, tau, work, rwork, iwork, nout )
211 INTEGER NM, NMAX, NN, NNB, NOUT, NRHS
212 DOUBLE PRECISION THRESH
216 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
218 DOUBLE PRECISION A( * ), AC( * ), AF( * ), AQ( * ), AR( * ),
219 $ b( * ), rwork( * ), tau( * ), work( * ),
227 parameter ( ntests = 9 )
229 parameter ( ntypes = 8 )
230 DOUBLE PRECISION ZERO
231 parameter ( zero = 0.0d0 )
236 INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA,
237 $ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
239 DOUBLE PRECISION ANORM, CNDNUM
242 INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 )
243 DOUBLE PRECISION RESULT( ntests )
263 COMMON / infoc / infot, nunit, ok, lerr
264 COMMON / srnamc / srnamt
267 DATA iseedy / 1988, 1989, 1990, 1991 /
273 path( 1: 1 ) =
'Double precision'
279 iseed( i ) = iseedy( i )
285 $
CALL derrqr( path, nout )
290 lwork = nmax*max( nmax, nrhs )
302 DO 50 imat = 1, ntypes
306 IF( .NOT.dotype( imat ) )
312 CALL dlatb4( path, imat, m, n,
TYPE, KL, KU, ANORM, MODE,
316 CALL dlatms( m, n, dist, iseed,
TYPE, RWORK, MODE,
317 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
323 CALL alaerh( path,
'DLATMS', info, 0,
' ', m, n, -1,
324 $ -1, -1, imat, nfail, nerrs, nout )
335 kval( 4 ) = minmn / 2
336 IF( minmn.EQ.0 )
THEN
338 ELSE IF( minmn.EQ.1 )
THEN
340 ELSE IF( minmn.LE.3 )
THEN
366 CALL dqrt01( m, n, a, af, aq, ar, lda, tau,
367 $ work, lwork, rwork, result( 1 ) )
372 CALL dqrt01p( m, n, a, af, aq, ar, lda, tau,
373 $ work, lwork, rwork, result( 8 ) )
375 IF( .NOT. dgennd( m, n, af, lda ) )
376 $ result( 9 ) = 2*thresh
378 ELSE IF( m.GE.n )
THEN
383 CALL dqrt02( m, n, k, a, af, aq, ar, lda, tau,
384 $ work, lwork, rwork, result( 1 ) )
391 CALL dqrt03( m, n, k, af, ac, ar, aq, lda, tau,
392 $ work, lwork, rwork, result( 3 ) )
399 IF( k.EQ.n .AND. inb.EQ.1 )
THEN
405 CALL dlarhs( path,
'New',
'Full',
406 $
'No transpose', m, n, 0, 0,
407 $ nrhs, a, lda, xact, lda, b, lda,
410 CALL dlacpy(
'Full', m, nrhs, b, lda, x,
413 CALL dgeqrs( m, n, nrhs, af, lda, tau, x,
414 $ lda, work, lwork, info )
419 $
CALL alaerh( path,
'DGEQRS', info, 0,
' ',
420 $ m, n, nrhs, -1, nb, imat,
421 $ nfail, nerrs, nout )
423 CALL dget02(
'No transpose', m, n, nrhs, a,
424 $ lda, x, lda, b, lda, rwork,
434 IF( result( i ).GE.thresh )
THEN
435 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
436 $
CALL alahd( nout, path )
437 WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
438 $ imat, i, result( i )
451 CALL alasum( path, nout, nfail, nrun, nerrs )
453 9999
FORMAT(
' M=', i5,
', N=', i5,
', K=', i5,
', NB=', i4,
', NX=',
454 $ i5,
', type ', i2,
', test(', i2,
')=', g12.5 )
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
subroutine dqrt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQRT03
subroutine dqrt01(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQRT01
subroutine derrqr(PATH, NUNIT)
DERRQR
subroutine dqrt01p(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQRT01P
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine dchkqr(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AR, AC, B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT)
DCHKQR
subroutine dget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DGET02
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
subroutine dgeqrs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
DGEQRS
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine dqrt02(M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQRT02
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM