200 SUBROUTINE cchkqr( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
201 $ nrhs, thresh, tsterr, nmax, a, af, aq, ar, ac,
202 $
b, x, xact, tau, work, rwork, iwork, nout )
211 INTEGER nm, nmax, nn, nnb, nout, nrhs
216 INTEGER iwork( * ), mval( * ), nbval( * ), nval( * ),
219 COMPLEX a( * ), ac( * ), af( * ), aq( * ), ar( * ),
220 $
b( * ), tau( * ), work( * ), x( * ), xact( * )
227 parameter( ntests = 9 )
229 parameter( ntypes = 8 )
231 parameter( zero = 0.0e0 )
236 INTEGER i, ik, im, imat, in, inb, info, k, kl, ku, lda,
237 $ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
242 INTEGER iseed( 4 ), iseedy( 4 ), kval( 4 )
243 REAL result( ntests )
263 COMMON / infoc / infot, nunit, ok, lerr
264 COMMON / srnamc / srnamt
267 DATA iseedy / 1988, 1989, 1990, 1991 /
273 path( 1: 1 ) =
'Complex precision'
279 iseed( i ) = iseedy( i )
285 $ CALL
cerrqr( path, nout )
290 lwork = nmax*max( nmax, nrhs )
302 DO 50 imat = 1, ntypes
306 IF( .NOT.dotype( imat ) )
312 CALL
clatb4( path, imat, m, n, type, kl, ku, anorm, mode,
316 CALL
clatms( m, n, dist, iseed, type, rwork, mode,
317 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
323 CALL
alaerh( path,
'CLATMS', info, 0,
' ', m, n, -1,
324 $ -1, -1, imat, nfail, nerrs, nout )
335 kval( 4 ) = minmn / 2
336 IF( minmn.EQ.0 )
THEN
338 ELSE IF( minmn.EQ.1 )
THEN
340 ELSE IF( minmn.LE.3 )
THEN
366 CALL
cqrt01( m, n, a, af, aq, ar, lda, tau,
367 $ work, lwork, rwork, result( 1 ) )
371 CALL
cqrt01p( m, n, a, af, aq, ar, lda, tau,
372 $ work, lwork, rwork, result( 8 ) )
374 IF( .NOT.
cgennd( m, n, af, lda ) )
375 $ result( 9 ) = 2*thresh
377 ELSE IF( m.GE.n )
THEN
382 CALL
cqrt02( m, n, k, a, af, aq, ar, lda, tau,
383 $ work, lwork, rwork, result( 1 ) )
390 CALL
cqrt03( m, n, k, af, ac, ar, aq, lda, tau,
391 $ work, lwork, rwork, result( 3 ) )
398 IF( k.EQ.n .AND. inb.EQ.1 )
THEN
404 CALL
clarhs( path,
'New',
'Full',
405 $
'No transpose', m, n, 0, 0,
406 $ nrhs, a, lda, xact, lda,
b, lda,
409 CALL
clacpy(
'Full', m, nrhs,
b, lda, x,
412 CALL
cgeqrs( m, n, nrhs, af, lda, tau, x,
413 $ lda, work, lwork, info )
418 $ CALL
alaerh( path,
'CGEQRS', info, 0,
' ',
419 $ m, n, nrhs, -1, nb, imat,
420 $ nfail, nerrs, nout )
422 CALL
cget02(
'No transpose', m, n, nrhs, a,
423 $ lda, x, lda,
b, lda, rwork,
433 IF( result( i ).GE.thresh )
THEN
434 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
435 $ CALL
alahd( nout, path )
436 WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
437 $ imat, i, result( i )
450 CALL
alasum( path, nout, nfail, nrun, nerrs )
452 9999
FORMAT(
' M=', i5,
', N=', i5,
', K=', i5,
', NB=', i4,
', NX=',
453 $ i5,
', type ', i2,
', test(', i2,
')=', g12.5 )
logical function cgennd(M, N, A, LDA)
CGENND
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine cqrt02(M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQRT02
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
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine cgeqrs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
CGEQRS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine cqrt01p(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQRT01P
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine cerrqr(PATH, NUNIT)
CERRQR
subroutine cqrt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQRT03
subroutine cget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CGET02
subroutine cqrt01(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQRT01