200 SUBROUTINE schkqr( 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 = 9 )
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 )
263 COMMON / infoc / infot, nunit, ok, lerr
264 COMMON / srnamc / srnamt
267 DATA iseedy / 1988, 1989, 1990, 1991 /
273 path( 1: 1 ) =
'Single precision'
279 iseed( i ) = iseedy( i )
285 $ CALL
serrqr( path, nout )
290 lwork = nmax*max( nmax, nrhs )
302 DO 50 imat = 1, ntypes
306 IF( .NOT.dotype( imat ) )
312 CALL
slatb4( path, imat, m, n, type, kl, ku, anorm, mode,
316 CALL
slatms( m, n, dist, iseed, type, rwork, mode,
317 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
323 CALL
alaerh( path,
'SLATMS', 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
sqrt01( m, n, a, af, aq, ar, lda, tau,
367 $ work, lwork, rwork, result( 1 ) )
371 CALL
sqrt01p( m, n, a, af, aq, ar, lda, tau,
372 $ work, lwork, rwork, result( 8 ) )
374 IF( .NOT.
sgennd( m, n, af, lda ) )
375 $ result( 9 ) = 2*thresh
377 ELSE IF( m.GE.n )
THEN
382 CALL
sqrt02( m, n, k, a, af, aq, ar, lda, tau,
383 $ work, lwork, rwork, result( 1 ) )
390 CALL
sqrt03( m, n, k, af, ac, ar, aq, lda, tau,
391 $ work, lwork, rwork, result( 3 ) )
398 IF( k.EQ.n .AND. inb.EQ.1 )
THEN
404 CALL
slarhs( path,
'New',
'Full',
405 $
'No transpose', m, n, 0, 0,
406 $ nrhs, a, lda, xact, lda,
b, lda,
409 CALL
slacpy(
'Full', m, nrhs,
b, lda,
x,
412 CALL
sgeqrs( m, n, nrhs, af, lda, tau,
x,
413 $ lda, work, lwork, info )
418 $ CALL
alaerh( path,
'SGEQRS', info, 0,
' ',
419 $ m, n, nrhs, -1, nb, imat,
420 $ nfail, nerrs, nout )
422 CALL
sget02(
'No transpose', m, n, nrhs, a,
423 $ lda,
x, lda,
b, lda, rwork,
433 IF( result( i ).GE.thresh )
THEN
434 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
435 $ CALL
alahd( nout, path )
436 WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
437 $ imat, i, result( i )
450 CALL
alasum( path, nout, nfail, nrun, nerrs )
452 9999
FORMAT(
' M=', i5,
', N=', i5,
', K=', i5,
', NB=', i4,
', NX=',
453 $ i5,
', type ', i2,
', test(', i2,
')=', g12.5 )
subroutine sqrt01(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SQRT01
subroutine alahd(IOUNIT, PATH)
ALAHD
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 sqrt02(M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SQRT02
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 serrqr(PATH, NUNIT)
SERRQR
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine schkqr(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)
SCHKQR
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 sqrt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SQRT03
subroutine sgeqrs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
SGEQRS
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine sqrt01p(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SQRT01P
LOGICAL function sgennd(M, N, A, LDA)
SGENND
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4