195 SUBROUTINE schklq( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
196 $ nrhs, thresh, tsterr, nmax, a, af, aq, al, ac,
197 $ b, x, xact, tau, work, rwork, nout )
206 INTEGER NM, NMAX, NN, NNB, NOUT, NRHS
211 INTEGER MVAL( * ), NBVAL( * ), NVAL( * ),
213 REAL A( * ), AC( * ), AF( * ), AL( * ), AQ( * ),
214 $ b( * ), rwork( * ), tau( * ), work( * ),
222 parameter( ntests = 7 )
224 parameter( ntypes = 8 )
226 parameter( zero = 0.0e0 )
231 INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA,
232 $ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
237 INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 )
238 REAL RESULT( ntests )
254 COMMON / infoc / infot, nunit, ok, lerr
255 COMMON / srnamc / srnamt
258 DATA iseedy / 1988, 1989, 1990, 1991 /
264 path( 1: 1 ) =
'Single precision'
270 iseed( i ) = iseedy( i )
276 $ CALL
serrlq( path, nout )
281 lwork = nmax*max( nmax, nrhs )
293 DO 50 imat = 1, ntypes
297 IF( .NOT.dotype( imat ) )
303 CALL
slatb4( path, imat, m, n,
TYPE, KL, KU, ANORM, MODE,
307 CALL
slatms( m, n, dist, iseed,
TYPE, RWORK, MODE,
308 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
314 CALL
alaerh( path,
'SLATMS', info, 0,
' ', m, n, -1,
315 $ -1, -1, imat, nfail, nerrs, nout )
326 kval( 4 ) = minmn / 2
327 IF( minmn.EQ.0 )
THEN
329 ELSE IF( minmn.EQ.1 )
THEN
331 ELSE IF( minmn.LE.3 )
THEN
357 CALL
slqt01( m, n, a, af, aq, al, lda, tau,
358 $ work, lwork, rwork, result( 1 ) )
359 ELSE IF( m.LE.n )
THEN
364 CALL
slqt02( m, n, k, a, af, aq, al, lda, tau,
365 $ work, lwork, rwork, result( 1 ) )
372 CALL
slqt03( m, n, k, af, ac, al, aq, lda, tau,
373 $ work, lwork, rwork, result( 3 ) )
380 IF( k.EQ.m .AND. inb.EQ.1 )
THEN
386 CALL
slarhs( path,
'New',
'Full',
387 $
'No transpose', m, n, 0, 0,
388 $ nrhs, a, lda, xact, lda, b, lda,
391 CALL
slacpy(
'Full', m, nrhs, b, lda, x,
394 CALL
sgelqs( m, n, nrhs, af, lda, tau, x,
395 $ lda, work, lwork, info )
400 $ CALL
alaerh( path,
'SGELQS', info, 0,
' ',
401 $ m, n, nrhs, -1, nb, imat,
402 $ nfail, nerrs, nout )
404 CALL
sget02(
'No transpose', m, n, nrhs, a,
405 $ lda, x, lda, b, lda, rwork,
415 IF( result( i ).GE.thresh )
THEN
416 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
417 $ CALL
alahd( nout, path )
418 WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
419 $ imat, i, result( i )
432 CALL
alasum( path, nout, nfail, nrun, nerrs )
434 9999
FORMAT(
' M=', i5,
', N=', i5,
', K=', i5,
', NB=', i4,
', NX=',
435 $ i5,
', type ', i2,
', test(', i2,
')=', g12.5 )
subroutine slqt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SLQT01
subroutine schklq(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, B, X, XACT, TAU, WORK, RWORK, NOUT)
SCHKLQ
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 slqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SLQT03
subroutine slqt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SLQT02
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 sgelqs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
SGELQS
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 serrlq(PATH, NUNIT)
SERRLQ
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4