200 SUBROUTINE dchkrq( 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 = 7 )
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 )
259 COMMON / infoc / infot, nunit, ok, lerr
260 COMMON / srnamc / srnamt
263 DATA iseedy / 1988, 1989, 1990, 1991 /
269 path( 1: 1 ) =
'Double precision'
275 iseed( i ) = iseedy( i )
281 $ CALL
derrrq( path, nout )
286 lwork = nmax*max( nmax, nrhs )
298 DO 50 imat = 1, ntypes
302 IF( .NOT.dotype( imat ) )
308 CALL
dlatb4( path, imat, m, n, type, kl, ku, anorm, mode,
312 CALL
dlatms( m, n, dist, iseed, type, rwork, mode,
313 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
319 CALL
alaerh( path,
'DLATMS', info, 0,
' ', m, n, -1,
320 $ -1, -1, imat, nfail, nerrs, nout )
331 kval( 4 ) = minmn / 2
332 IF( minmn.EQ.0 )
THEN
334 ELSE IF( minmn.EQ.1 )
THEN
336 ELSE IF( minmn.LE.3 )
THEN
362 CALL
drqt01( m, n, a, af, aq, ar, lda, tau,
363 $ work, lwork, rwork, result( 1 ) )
364 ELSE IF( m.LE.n )
THEN
369 CALL
drqt02( m, n, k, a, af, aq, ar, lda, tau,
370 $ work, lwork, rwork, result( 1 ) )
378 CALL
drqt03( m, n, k, af, ac, ar, aq, lda, tau,
379 $ work, lwork, rwork, result( 3 ) )
386 IF( k.EQ.m .AND. inb.EQ.1 )
THEN
392 CALL
dlarhs( path,
'New',
'Full',
393 $
'No transpose', m, n, 0, 0,
394 $ nrhs, a, lda, xact, lda,
b, lda,
397 CALL
dlacpy(
'Full', m, nrhs,
b, lda,
400 CALL
dgerqs( m, n, nrhs, af, lda, tau,
x,
401 $ lda, work, lwork, info )
406 $ CALL
alaerh( path,
'DGERQS', info, 0,
' ',
407 $ m, n, nrhs, -1, nb, imat,
408 $ nfail, nerrs, nout )
410 CALL
dget02(
'No transpose', m, n, nrhs, a,
411 $ lda,
x, lda,
b, lda, rwork,
421 IF( result( i ).GE.thresh )
THEN
422 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
423 $ CALL
alahd( nout, path )
424 WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
425 $ imat, i, result( i )
438 CALL
alasum( path, nout, nfail, nrun, nerrs )
440 9999
FORMAT(
' M=', i5,
', N=', i5,
', K=', i5,
', NB=', i4,
', NX=',
441 $ i5,
', type ', i2,
', test(', i2,
')=', 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 drqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DRQT03
subroutine dgerqs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
DGERQS
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
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 dchkrq(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)
DCHKRQ
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine derrrq(PATH, NUNIT)
DERRRQ
subroutine drqt01(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DRQT01
subroutine dget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DGET02
subroutine drqt02(M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DRQT02