210 SUBROUTINE cckgqr( NM, MVAL, NP, PVAL, NN, NVAL, NMATS, ISEED,
211 $ thresh, nmax, a, af, aq, ar, taua, b, bf, bz,
212 $ bt, bwk, taub, work, rwork, nin, nout, info )
220 INTEGER INFO, NIN, NM, NMATS, NMAX, NN, NOUT, NP
224 INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
226 COMPLEX A( * ), AF( * ), AQ( * ), AR( * ), B( * ),
227 $ bf( * ), bt( * ), bwk( * ), bz( * ), taua( * ),
228 $ taub( * ), work( * )
235 parameter( ntests = 7 )
237 parameter( ntypes = 8 )
241 CHARACTER DISTA, DISTB, TYPE
243 INTEGER I, IINFO, IM, IMAT, IN, IP, KLA, KLB, KUA, KUB,
244 $ lda, ldb, lwork, m, modea, modeb, n, nfail,
246 REAL ANORM, BNORM, CNDNMA, CNDNMB
249 LOGICAL DOTYPE( ntypes )
250 REAL RESULT( ntests )
268 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
288 DO 30 imat = 1, ntypes
292 IF( .NOT.dotype( imat ) )
300 CALL
slatb9(
'GRQ', imat, m, p, n,
TYPE, KLA, KUA,
301 $ klb, kub, anorm, bnorm, modea, modeb,
302 $ cndnma, cndnmb, dista, distb )
304 CALL
clatms( 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
313 CALL
clatms( p, n, distb, iseed,
TYPE, RWORK, MODEB,
314 $ cndnmb, bnorm, klb, kub,
'No packing', b,
316 IF( iinfo.NE.0 )
THEN
317 WRITE( nout, fmt = 9999 )iinfo
324 CALL
cgrqts( m, p, n, a, af, aq, ar, lda, taua, b, bf,
325 $ bz, bt, bwk, ldb, taub, work, lwork,
332 IF( result( i ).GE.thresh )
THEN
333 IF( nfail.EQ.0 .AND. firstt )
THEN
335 CALL
alahdg( nout,
'GRQ' )
337 WRITE( nout, fmt = 9998 )m, p, n, imat, i,
349 CALL
slatb9(
'GQR', imat, m, p, n,
TYPE, KLA, KUA,
350 $ klb, kub, anorm, bnorm, modea, modeb,
351 $ cndnma, cndnmb, dista, distb )
353 CALL
clatms( n, m, dista, iseed,
TYPE, RWORK, MODEA,
354 $ cndnma, anorm, kla, kua,
'No packing', a,
356 IF( iinfo.NE.0 )
THEN
357 WRITE( nout, fmt = 9999 )iinfo
362 CALL
clatms( n, p, distb, iseed,
TYPE, RWORK, MODEA,
363 $ cndnma, bnorm, klb, kub,
'No packing', b,
365 IF( iinfo.NE.0 )
THEN
366 WRITE( nout, fmt = 9999 )iinfo
373 CALL
cgqrts( n, m, p, a, af, aq, ar, lda, taua, b, bf,
374 $ bz, bt, bwk, ldb, taub, work, lwork,
381 IF( result( i ).GE.thresh )
THEN
382 IF( nfail.EQ.0 .AND. firstt )
THEN
386 WRITE( nout, fmt = 9997 )n, m, p, imat, i,
400 CALL
alasum( path, nout, nfail, nrun, 0 )
402 9999
FORMAT(
' CLATMS in CCKGQR: INFO = ', i5 )
403 9998
FORMAT(
' M=', i4,
' P=', i4,
', N=', i4,
', type ', i2,
404 $
', test ', i2,
', ratio=', g13.6 )
405 9997
FORMAT(
' N=', i4,
' M=', i4,
', P=', i4,
', type ', i2,
406 $
', test ', i2,
', ratio=', g13.6 )
subroutine cckgqr(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)
CCKGQR
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine alahdg(IOUNIT, PATH)
ALAHDG
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine cgrqts(M, P, N, A, AF, Q, R, LDA, TAUA, B, BF, Z, T, BWK, LDB, TAUB, WORK, LWORK, RWORK, RESULT)
CGRQTS
subroutine slatb9(PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB, ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB, DISTA, DISTB)
SLATB9
subroutine alareq(PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT)
ALAREQ
subroutine cgqrts(N, M, P, A, AF, Q, R, LDA, TAUA, B, BF, Z, T, BWK, LDB, TAUB, WORK, LWORK, RWORK, RESULT)
CGQRTS