209 SUBROUTINE dckgqr( NM, MVAL, NP, PVAL, NN, NVAL, NMATS, ISEED,
210 $ thresh, nmax, a, af, aq, ar, taua, b, bf, bz,
211 $ bt, bwk, taub, work, rwork, nin, nout, info )
219 INTEGER INFO, NIN, NM, NMATS, NMAX, NN, NOUT, NP
220 DOUBLE PRECISION THRESH
223 INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
224 DOUBLE PRECISION A( * ), AF( * ), AQ( * ), AR( * ), B( * ),
225 $ bf( * ), bt( * ), bwk( * ), bz( * ),
226 $ rwork( * ), taua( * ), taub( * ), work( * )
233 parameter( ntests = 7 )
235 parameter( ntypes = 8 )
239 CHARACTER DISTA, DISTB, TYPE
241 INTEGER I, IINFO, IM, IMAT, IN, IP, KLA, KLB, KUA, KUB,
242 $ lda, ldb, lwork, m, modea, modeb, n, nfail,
244 DOUBLE PRECISION ANORM, BNORM, CNDNMA, CNDNMB
247 LOGICAL DOTYPE( ntypes )
248 DOUBLE PRECISION RESULT( ntests )
266 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
286 DO 30 imat = 1, ntypes
290 IF( .NOT.dotype( imat ) )
298 CALL
dlatb9(
'GRQ', imat, m, p, n,
TYPE, KLA, KUA,
299 $ klb, kub, anorm, bnorm, modea, modeb,
300 $ cndnma, cndnmb, dista, distb )
304 CALL
dlatms( m, n, dista, iseed,
TYPE, RWORK, MODEA,
305 $ cndnma, anorm, kla, kua,
'No packing', a,
307 IF( iinfo.NE.0 )
THEN
308 WRITE( nout, fmt = 9999 )iinfo
315 CALL
dlatms( p, n, distb, iseed,
TYPE, RWORK, MODEB,
316 $ cndnmb, bnorm, klb, kub,
'No packing', b,
318 IF( iinfo.NE.0 )
THEN
319 WRITE( nout, fmt = 9999 )iinfo
326 CALL
dgrqts( m, p, n, a, af, aq, ar, lda, taua, b, bf,
327 $ bz, bt, bwk, ldb, taub, work, lwork,
334 IF( result( i ).GE.thresh )
THEN
335 IF( nfail.EQ.0 .AND. firstt )
THEN
337 CALL
alahdg( nout,
'GRQ' )
339 WRITE( nout, fmt = 9998 )m, p, n, imat, i,
351 CALL
dlatb9(
'GQR', imat, m, p, n,
TYPE, KLA, KUA,
352 $ klb, kub, anorm, bnorm, modea, modeb,
353 $ cndnma, cndnmb, dista, distb )
357 CALL
dlatms( n, m, dista, iseed,
TYPE, RWORK, MODEA,
358 $ cndnma, anorm, kla, kua,
'No packing', a,
360 IF( iinfo.NE.0 )
THEN
361 WRITE( nout, fmt = 9999 )iinfo
368 CALL
dlatms( n, p, distb, iseed,
TYPE, RWORK, MODEA,
369 $ cndnma, bnorm, klb, kub,
'No packing', b,
371 IF( iinfo.NE.0 )
THEN
372 WRITE( nout, fmt = 9999 )iinfo
379 CALL
dgqrts( n, m, p, a, af, aq, ar, lda, taua, b, bf,
380 $ bz, bt, bwk, ldb, taub, work, lwork,
387 IF( result( i ).GE.thresh )
THEN
388 IF( nfail.EQ.0 .AND. firstt )
THEN
392 WRITE( nout, fmt = 9997 )n, m, p, imat, i,
406 CALL
alasum( path, nout, nfail, nrun, 0 )
408 9999
FORMAT(
' DLATMS in DCKGQR: INFO = ', i5 )
409 9998
FORMAT(
' M=', i4,
' P=', i4,
', N=', i4,
', type ', i2,
410 $
', test ', i2,
', ratio=', g13.6 )
411 9997
FORMAT(
' N=', i4,
' M=', i4,
', P=', i4,
', type ', i2,
412 $
', test ', i2,
', ratio=', g13.6 )
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine alahdg(IOUNIT, PATH)
ALAHDG
subroutine dgqrts(N, M, P, A, AF, Q, R, LDA, TAUA, B, BF, Z, T, BWK, LDB, TAUB, WORK, LWORK, RWORK, RESULT)
DGQRTS
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine dckgqr(NM, MVAL, NP, PVAL, NN, NVAL, NMATS, ISEED, THRESH, NMAX, A, AF, AQ, AR, TAUA, B, BF, BZ, BT, BWK, TAUB, WORK, RWORK, NIN, NOUT, INFO)
DCKGQR
subroutine alareq(PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT)
ALAREQ
subroutine dlatb9(PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB, ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB, DISTA, DISTB)
DLATB9
subroutine dgrqts(M, P, N, A, AF, Q, R, LDA, TAUA, B, BF, Z, T, BWK, LDB, TAUB, WORK, LWORK, RWORK, RESULT)
DGRQTS