200 SUBROUTINE dchkql( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
201 $ nrhs, thresh, tsterr, nmax, a, af, aq, al, 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( * ), AL( * ), AQ( * ),
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 derrql( 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 dqlt01( m, n, a, af, aq, al, lda, tau,
363 $ work, lwork, rwork, result( 1 ) )
364 ELSE IF( m.GE.n )
THEN
369 CALL dqlt02( m, n, k, a, af, aq, al, lda, tau,
370 $ work, lwork, rwork, result( 1 ) )
377 CALL dqlt03( m, n, k, af, ac, al, aq, lda, tau,
378 $ work, lwork, rwork, result( 3 ) )
385 IF( k.EQ.n .AND. inb.EQ.1 )
THEN
391 CALL dlarhs( path,
'New',
'Full',
392 $
'No transpose', m, n, 0, 0,
393 $ nrhs, a, lda, xact, lda, b, lda,
396 CALL dlacpy(
'Full', m, nrhs, b, lda, x,
399 CALL dgeqls( m, n, nrhs, af, lda, tau, x,
400 $ lda, work, lwork, info )
405 $
CALL alaerh( path,
'DGEQLS', info, 0,
' ',
406 $ m, n, nrhs, -1, nb, imat,
407 $ nfail, nerrs, nout )
409 CALL dget02(
'No transpose', m, n, nrhs, a,
410 $ lda, x( m-n+1 ), lda, b, lda,
411 $ rwork, result( 7 ) )
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 alahd(IOUNIT, PATH)
ALAHD
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine dqlt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQLT02
subroutine dchkql(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT)
DCHKQL
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
subroutine dgeqls(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
DGEQLS
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine dqlt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQLT01
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 derrql(PATH, NUNIT)
DERRQL
subroutine dget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DGET02
subroutine dqlt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQLT03