210 SUBROUTINE zckgqr( 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
221 DOUBLE PRECISION thresh
224 INTEGER iseed( 4 ), mval( * ), nval( * ), pval( * )
225 DOUBLE PRECISION rwork( * )
226 COMPLEX*16 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 DOUBLE PRECISION anorm, bnorm, cndnma, cndnmb
249 LOGICAL dotype( ntypes )
250 DOUBLE PRECISION result( ntests )
268 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
288 DO 30 imat = 1, ntypes
292 IF( .NOT.dotype( imat ) )
300 CALL
dlatb9(
'GRQ', imat, m, p, n, type, kla, kua,
301 $ klb, kub, anorm, bnorm, modea, modeb,
302 $ cndnma, cndnmb, dista, distb )
304 CALL
zlatms( 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
zlatms( 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
zgrqts( 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
dlatb9(
'GQR', imat, m, p, n, type, kla, kua,
350 $ klb, kub, anorm, bnorm, modea, modeb,
351 $ cndnma, cndnmb, dista, distb )
353 CALL
zlatms( 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
zlatms( 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
zgqrts( 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(
' ZLATMS in ZCKGQR: 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 )