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 alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine sget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
SGET02
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
subroutine sgeqrs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
SGEQRS
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
subroutine sqrt01(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SQRT01
subroutine serrqr(PATH, NUNIT)
SERRQR
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
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 sqrt01p(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SQRT01P
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 sqrt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SQRT03
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM