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 dqrt01p(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQRT01P
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 derrqr(PATH, NUNIT)
DERRQR
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 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 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 dqrt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQRT03
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
LOGICAL function dgennd(M, N, A, LDA)
DGENND
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dqrt02(M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQRT02
subroutine dget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DGET02
subroutine dqrt01(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQRT01