200 SUBROUTINE cchkrq( 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 = 7 )
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 )
259 COMMON / infoc / infot, nunit, ok, lerr
260 COMMON / srnamc / srnamt
263 DATA iseedy / 1988, 1989, 1990, 1991 /
269 path( 1: 1 ) =
'Complex precision'
275 iseed( i ) = iseedy( i )
281 $ CALL
cerrrq( path, nout )
286 lwork = nmax*max( nmax, nrhs )
298 DO 50 imat = 1, ntypes
302 IF( .NOT.dotype( imat ) )
308 CALL
clatb4( path, imat, m, n, type, kl, ku, anorm, mode,
312 CALL
clatms( m, n, dist, iseed, type, rwork, mode,
313 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
319 CALL
alaerh( path,
'CLATMS', info, 0,
' ', m, n, -1,
320 $ -1, -1, imat, nfail, nerrs, nout )
331 kval( 4 ) = minmn / 2
332 IF( minmn.EQ.0 )
THEN
334 ELSE IF( minmn.EQ.1 )
THEN
336 ELSE IF( minmn.LE.3 )
THEN
362 CALL
crqt01( m, n, a, af, aq, ar, lda, tau,
363 $ work, lwork, rwork, result( 1 ) )
364 ELSE IF( m.LE.n )
THEN
369 CALL
crqt02( m, n, k, a, af, aq, ar, lda, tau,
370 $ work, lwork, rwork, result( 1 ) )
377 CALL
crqt03( m, n, k, af, ac, ar, aq, lda, tau,
378 $ work, lwork, rwork, result( 3 ) )
385 IF( k.EQ.m .AND. inb.EQ.1 )
THEN
391 CALL
clarhs( path,
'New',
'Full',
392 $
'No transpose', m, n, 0, 0,
393 $ nrhs, a, lda, xact, lda,
b, lda,
396 CALL
clacpy(
'Full', m, nrhs,
b, lda,
399 CALL
cgerqs( m, n, nrhs, af, lda, tau,
x,
400 $ lda, work, lwork, info )
405 $ CALL
alaerh( path,
'CGERQS', info, 0,
' ',
406 $ m, n, nrhs, -1, nb, imat,
407 $ nfail, nerrs, nout )
409 CALL
cget02(
'No transpose', m, n, nrhs, a,
410 $ lda,
x, lda,
b, lda, rwork,
420 IF( result( i ).GE.thresh )
THEN
421 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
422 $ CALL
alahd( nout, path )
423 WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
424 $ imat, i, result( i )
437 CALL
alasum( path, nout, nfail, nrun, nerrs )
439 9999
FORMAT(
' M=', i5,
', N=', i5,
', K=', i5,
', NB=', i4,
', NX=',
440 $ i5,
', type ', i2,
', test(', i2,
')=', g12.5 )
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 cchkrq(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)
CCHKRQ
subroutine crqt01(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CRQT01
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine cerrrq(PATH, NUNIT)
CERRRQ
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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 crqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CRQT03
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine crqt02(M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CRQT02
subroutine cgerqs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
CGERQS
subroutine cget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CGET02