198 SUBROUTINE cchkqr( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
199 $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AR, AC,
200 $ B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT )
208 INTEGER NM, NMAX, NN, NNB, NOUT, NRHS
213 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
216 COMPLEX A( * ), AC( * ), AF( * ), AQ( * ), AR( * ),
217 $ b( * ), tau( * ), work( * ), x( * ), xact( * )
224 PARAMETER ( NTESTS = 9 )
226 parameter( ntypes = 8 )
228 parameter( zero = 0.0e0 )
233 INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA,
234 $ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
239 INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 )
240 REAL RESULT( NTESTS )
260 COMMON / infoc / infot, nunit, ok, lerr
261 COMMON / srnamc / srnamt
264 DATA iseedy / 1988, 1989, 1990, 1991 /
270 path( 1: 1 ) =
'Complex precision'
276 iseed( i ) = iseedy( i )
282 $
CALL cerrqr( path, nout )
287 lwork = nmax*max( nmax, nrhs )
299 DO 50 imat = 1, ntypes
303 IF( .NOT.dotype( imat ) )
309 CALL clatb4( path, imat, m, n,
TYPE, kl, ku, anorm, mode,
313 CALL clatms( m, n, dist, iseed,
TYPE, rwork, mode,
314 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
320 CALL alaerh( path,
'CLATMS', info, 0,
' ', m, n, -1,
321 $ -1, -1, imat, nfail, nerrs, nout )
332 kval( 4 ) = minmn / 2
333 IF( minmn.EQ.0 )
THEN
335 ELSE IF( minmn.EQ.1 )
THEN
337 ELSE IF( minmn.LE.3 )
THEN
363 CALL cqrt01( m, n, a, af, aq, ar, lda, tau,
364 $ work, lwork, rwork, result( 1 ) )
368 CALL cqrt01p( m, n, a, af, aq, ar, lda, tau,
369 $ work, lwork, rwork, result( 8 ) )
371 IF( .NOT. cgennd( m, n, af, lda ) )
372 $ result( 9 ) = 2*thresh
374 ELSE IF( m.GE.n )
THEN
379 CALL cqrt02( m, n, k, a, af, aq, ar, lda, tau,
380 $ work, lwork, rwork, result( 1 ) )
387 CALL cqrt03( m, n, k, af, ac, ar, aq, lda, tau,
388 $ work, lwork, rwork, result( 3 ) )
395 IF( k.EQ.n .AND. inb.EQ.1 )
THEN
401 CALL clarhs( path,
'New',
'Full',
402 $
'No transpose', m, n, 0, 0,
403 $ nrhs, a, lda, xact, lda, b, lda,
406 CALL clacpy(
'Full', m, nrhs, b, lda, x,
412 CALL clacpy(
'Full', m, n, a, lda, af, lda )
415 CALL cgels(
'No transpose', m, n, nrhs, af,
416 $ lda, x, lda, work, lwork, info )
421 $
CALL alaerh( path,
'CGELS', info, 0,
'N',
422 $ m, n, nrhs, -1, nb, imat,
423 $ nfail, nerrs, nout )
425 CALL cget02(
'No transpose', m, n, nrhs, a,
426 $ lda, x, lda, b, lda, rwork,
436 IF( result( i ).GE.thresh )
THEN
437 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
438 $
CALL alahd( nout, path )
439 WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
440 $ imat, i, result( i )
453 CALL alasum( path, nout, nfail, nrun, nerrs )
455 9999
FORMAT(
' M=', i5,
', N=', i5,
', K=', i5,
', NB=', i4,
', NX=',
456 $ i5,
', type ', i2,
', test(', i2,
')=', g12.5 )
subroutine cchkqr(dotype, nm, mval, nn, nval, nnb, nbval, nxval, nrhs, thresh, tsterr, nmax, a, af, aq, ar, ac, b, x, xact, tau, work, rwork, iwork, nout)
CCHKQR