193 SUBROUTINE dchklq( 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 derrlq( 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 dlqt01( m, n, a, af, aq, al, lda, tau,
355 $ work, lwork, rwork, result( 1 ) )
356 ELSE IF( m.LE.n )
THEN
361 CALL dlqt02( m, n, k, a, af, aq, al, lda, tau,
362 $ work, lwork, rwork, result( 1 ) )
372 CALL dlqt03( 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 dlarhs( path,
'New',
'Full',
387 $
'No transpose', m, n, 0, 0,
388 $ nrhs, a, lda, xact, lda, b, lda,
391 CALL dlacpy(
'Full', m, nrhs, b, lda, x,
394 CALL dgelqs( m, n, nrhs, af, lda, tau, x,
395 $ lda, work, lwork, info )
400 $
CALL alaerh( path,
'DGELQS', info, 0,
' ',
401 $ m, n, nrhs, -1, nb, imat,
402 $ nfail, nerrs, nout )
404 CALL dget02(
'No transpose', m, n, nrhs, a,
405 $ lda, x, lda, b, lda, rwork,
422 IF( result( i ).GE.thresh )
THEN
423 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
424 $
CALL alahd( nout, path )
425 WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
426 $ imat, i, result( i )
439 CALL alasum( path, nout, nfail, nrun, nerrs )
441 9999
FORMAT(
' M=', i5,
', N=', i5,
', K=', i5,
', NB=', i4,
', NX=',
442 $ i5,
', type ', i2,
', test(', i2,
')=', g12.5 )
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine alahd(IOUNIT, PATH)
ALAHD
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 dget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DGET02
subroutine dlqt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DLQT01
subroutine derrlq(PATH, NUNIT)
DERRLQ
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 dlqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DLQT03
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
subroutine dlqt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DLQT02
subroutine dgelqs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
DGELQS
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS