193 SUBROUTINE dchkql( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
194 $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC,
195 $ B, X, XACT, TAU, WORK, RWORK, NOUT )
203 INTEGER NM, NMAX, NN, NNB, NOUT, NRHS
204 DOUBLE PRECISION THRESH
208 INTEGER MVAL( * ), NBVAL( * ), NVAL( * ),
210 DOUBLE PRECISION A( * ), AC( * ), AF( * ), AL( * ), AQ( * ),
211 $ B( * ), RWORK( * ), TAU( * ), WORK( * ),
219 PARAMETER ( NTESTS = 7 )
221 parameter( ntypes = 8 )
222 DOUBLE PRECISION ZERO
223 parameter( zero = 0.0d0 )
228 INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA,
229 $ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
231 DOUBLE PRECISION ANORM, CNDNUM
234 INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 )
235 DOUBLE PRECISION RESULT( NTESTS )
251 COMMON / infoc / infot, nunit, ok, lerr
252 COMMON / srnamc / srnamt
255 DATA iseedy / 1988, 1989, 1990, 1991 /
261 path( 1: 1 ) =
'Double precision'
267 iseed( i ) = iseedy( i )
273 $
CALL derrql( path, nout )
278 lwork = nmax*max( nmax, nrhs )
290 DO 50 imat = 1, ntypes
294 IF( .NOT.dotype( imat ) )
300 CALL dlatb4( path, imat, m, n,
TYPE, kl, ku, anorm, mode,
304 CALL dlatms( m, n, dist, iseed,
TYPE, rwork, mode,
305 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
311 CALL alaerh( path,
'DLATMS', info, 0,
' ', m, n, -1,
312 $ -1, -1, imat, nfail, nerrs, nout )
323 kval( 4 ) = minmn / 2
324 IF( minmn.EQ.0 )
THEN
326 ELSE IF( minmn.EQ.1 )
THEN
328 ELSE IF( minmn.LE.3 )
THEN
354 CALL dqlt01( m, n, a, af, aq, al, lda, tau,
355 $ work, lwork, rwork, result( 1 ) )
356 ELSE IF( m.GE.n )
THEN
361 CALL dqlt02( m, n, k, a, af, aq, al, lda, tau,
362 $ work, lwork, rwork, result( 1 ) )
369 CALL dqlt03( m, n, k, af, ac, al, aq, lda, tau,
370 $ work, lwork, rwork, result( 3 ) )
377 IF( k.EQ.n .AND. inb.EQ.1 )
THEN
383 CALL dlarhs( path,
'New',
'Full',
384 $
'No transpose', m, n, 0, 0,
385 $ nrhs, a, lda, xact, lda, b, lda,
388 CALL dlacpy(
'Full', m, nrhs, b, lda, x,
391 CALL dgeqls( m, n, nrhs, af, lda, tau, x,
392 $ lda, work, lwork, info )
397 $
CALL alaerh( path,
'DGEQLS', info, 0,
' ',
398 $ m, n, nrhs, -1, nb, imat,
399 $ nfail, nerrs, nout )
401 CALL dget02(
'No transpose', m, n, nrhs, a,
402 $ lda, x( m-n+1 ), lda, b, lda,
403 $ rwork, result( 7 ) )
412 IF( result( i ).GE.thresh )
THEN
413 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
414 $
CALL alahd( nout, path )
415 WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
416 $ imat, i, result( i )
429 CALL alasum( path, nout, nfail, nrun, nerrs )
431 9999
FORMAT(
' M=', i5,
', N=', i5,
', K=', i5,
', NB=', i4,
', NX=',
432 $ i5,
', type ', i2,
', test(', i2,
')=', g12.5 )
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
subroutine dget02(trans, m, n, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
DGET02
subroutine dlarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
DLARHS
subroutine xlaenv(ispec, nvalue)
XLAENV
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
subroutine alahd(iounit, path)
ALAHD
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, nout)
DCHKQL
subroutine derrql(path, nunit)
DERRQL
subroutine dgeqls(m, n, nrhs, a, lda, tau, b, ldb, work, lwork, info)
DGEQLS
subroutine dlatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
DLATB4
subroutine dlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
DLATMS
subroutine dqlt01(m, n, a, af, q, l, lda, tau, work, lwork, rwork, result)
DQLT01
subroutine dqlt02(m, n, k, a, af, q, l, lda, tau, work, lwork, rwork, result)
DQLT02
subroutine dqlt03(m, n, k, af, c, cc, q, lda, tau, work, lwork, rwork, result)
DQLT03
subroutine dlacpy(uplo, m, n, a, lda, b, ldb)
DLACPY copies all or part of one two-dimensional array to another.