195 SUBROUTINE dchklq( 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
207 DOUBLE PRECISION THRESH
211 INTEGER MVAL( * ), NBVAL( * ), NVAL( * ),
213 DOUBLE PRECISION A( * ), AC( * ), AF( * ), AL( * ), AQ( * ),
214 $ b( * ), rwork( * ), tau( * ), work( * ),
222 parameter( ntests = 7 )
224 parameter( ntypes = 8 )
225 DOUBLE PRECISION ZERO
226 parameter( zero = 0.0d0 )
231 INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA,
232 $ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
234 DOUBLE PRECISION ANORM, CNDNUM
237 INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 )
238 DOUBLE PRECISION RESULT( ntests )
254 COMMON / infoc / infot, nunit, ok, lerr
255 COMMON / srnamc / srnamt
258 DATA iseedy / 1988, 1989, 1990, 1991 /
264 path( 1: 1 ) =
'Double precision'
270 iseed( i ) = iseedy( i )
276 $ CALL
derrlq( path, nout )
281 lwork = nmax*max( nmax, nrhs )
293 DO 50 imat = 1, ntypes
297 IF( .NOT.dotype( imat ) )
303 CALL
dlatb4( path, imat, m, n,
TYPE, KL, KU, ANORM, MODE,
307 CALL
dlatms( m, n, dist, iseed,
TYPE, RWORK, MODE,
308 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
314 CALL
alaerh( path,
'DLATMS', 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
dlqt01( m, n, a, af, aq, al, lda, tau,
358 $ work, lwork, rwork, result( 1 ) )
359 ELSE IF( m.LE.n )
THEN
364 CALL
dlqt02( m, n, k, a, af, aq, al, lda, tau,
365 $ work, lwork, rwork, result( 1 ) )
375 CALL
dlqt03( m, n, k, af, ac, al, aq, lda, tau,
376 $ work, lwork, rwork, result( 3 ) )
383 IF( k.EQ.m .AND. inb.EQ.1 )
THEN
389 CALL
dlarhs( path,
'New',
'Full',
390 $
'No transpose', m, n, 0, 0,
391 $ nrhs, a, lda, xact, lda, b, lda,
394 CALL
dlacpy(
'Full', m, nrhs, b, lda, x,
397 CALL
dgelqs( m, n, nrhs, af, lda, tau, x,
398 $ lda, work, lwork, info )
403 $ CALL
alaerh( path,
'DGELQS', info, 0,
' ',
404 $ m, n, nrhs, -1, nb, imat,
405 $ nfail, nerrs, nout )
407 CALL
dget02(
'No transpose', m, n, nrhs, a,
408 $ lda, x, lda, b, lda, rwork,
425 IF( result( i ).GE.thresh )
THEN
426 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
427 $ CALL
alahd( nout, path )
428 WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
429 $ imat, i, result( i )
442 CALL
alasum( path, nout, nfail, nrun, nerrs )
444 9999
FORMAT(
' M=', i5,
', N=', i5,
', K=', i5,
', NB=', i4,
', NX=',
445 $ 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 dlqt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DLQT01
subroutine derrlq(PATH, NUNIT)
DERRLQ
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 dchklq(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, B, X, XACT, TAU, WORK, RWORK, NOUT)
DCHKLQ
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine dlqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DLQT03
subroutine dgelqs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
DGELQS
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 dget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DGET02
subroutine dlqt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DLQT02