200 SUBROUTINE schkrq( 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
216 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
218 REAL A( * ), AC( * ), AF( * ), AQ( * ), AR( * ),
219 $ b( * ), rwork( * ), tau( * ), work( * ),
227 parameter( ntests = 7 )
229 parameter( ntypes = 8 )
231 parameter( zero = 0.0e0 )
236 INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA,
237 $ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
242 INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 )
243 REAL RESULT( ntests )
259 COMMON / infoc / infot, nunit, ok, lerr
260 COMMON / srnamc / srnamt
263 DATA iseedy / 1988, 1989, 1990, 1991 /
269 path( 1: 1 ) =
'Single precision'
275 iseed( i ) = iseedy( i )
281 $ CALL
serrrq( path, nout )
286 lwork = nmax*max( nmax, nrhs )
298 DO 50 imat = 1, ntypes
302 IF( .NOT.dotype( imat ) )
308 CALL
slatb4( path, imat, m, n,
TYPE, KL, KU, ANORM, MODE,
312 CALL
slatms( m, n, dist, iseed,
TYPE, RWORK, MODE,
313 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
319 CALL
alaerh( path,
'SLATMS', 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
srqt01( m, n, a, af, aq, ar, lda, tau,
363 $ work, lwork, rwork, result( 1 ) )
364 ELSE IF( m.LE.n )
THEN
369 CALL
srqt02( m, n, k, a, af, aq, ar, lda, tau,
370 $ work, lwork, rwork, result( 1 ) )
377 CALL
srqt03( m, n, k, af, ac, ar, aq, lda, tau,
378 $ work, lwork, rwork, result( 3 ) )
385 IF( k.EQ.m .AND. inb.EQ.1 )
THEN
391 CALL
slarhs( path,
'New',
'Full',
392 $
'No transpose', m, n, 0, 0,
393 $ nrhs, a, lda, xact, lda, b, lda,
396 CALL
slacpy(
'Full', m, nrhs, b, lda,
399 CALL
sgerqs( m, n, nrhs, af, lda, tau, x,
400 $ lda, work, lwork, info )
405 $ CALL
alaerh( path,
'SGERQS', info, 0,
' ',
406 $ m, n, nrhs, -1, nb, imat,
407 $ nfail, nerrs, nout )
409 CALL
sget02(
'No transpose', m, n, nrhs, a,
410 $ lda, x, lda, b, lda, rwork,
420 IF( result( i ).GE.thresh )
THEN
421 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
422 $ CALL
alahd( nout, path )
423 WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
424 $ imat, i, result( i )
437 CALL
alasum( path, nout, nfail, nrun, nerrs )
439 9999
FORMAT(
' M=', i5,
', N=', i5,
', K=', i5,
', NB=', i4,
', NX=',
440 $ i5,
', type ', i2,
', test(', i2,
')=', g12.5 )
subroutine sgerqs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
SGERQS
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine srqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SRQT03
subroutine srqt01(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SRQT01
subroutine sget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
SGET02
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
subroutine serrrq(PATH, NUNIT)
SERRRQ
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine srqt02(M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SRQT02
subroutine schkrq(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)
SCHKRQ
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4