200 SUBROUTINE zchkrq( 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
212 DOUBLE PRECISION thresh
216 INTEGER iwork( * ), mval( * ), nbval( * ), nval( * ),
218 DOUBLE PRECISION rwork( * )
219 COMPLEX*16 a( * ), ac( * ), af( * ), aq( * ), ar( * ),
220 $
b( * ), tau( * ), work( * ), x( * ), xact( * )
227 parameter( ntests = 7 )
229 parameter( ntypes = 8 )
230 DOUBLE PRECISION zero
231 parameter( zero = 0.0d0 )
236 INTEGER i, ik, im, imat, in, inb, info, k, kl, ku, lda,
237 $ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
239 DOUBLE PRECISION anorm, cndnum
242 INTEGER iseed( 4 ), iseedy( 4 ), kval( 4 )
243 DOUBLE PRECISION result( ntests )
259 COMMON / infoc / infot, nunit, ok, lerr
260 COMMON / srnamc / srnamt
263 DATA iseedy / 1988, 1989, 1990, 1991 /
269 path( 1: 1 ) =
'Zomplex precision'
275 iseed( i ) = iseedy( i )
281 $ CALL
zerrrq( path, nout )
286 lwork = nmax*max( nmax, nrhs )
298 DO 50 imat = 1, ntypes
302 IF( .NOT.dotype( imat ) )
308 CALL
zlatb4( path, imat, m, n, type, kl, ku, anorm, mode,
312 CALL
zlatms( m, n, dist, iseed, type, rwork, mode,
313 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
319 CALL
alaerh( path,
'ZLATMS', 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
zrqt01( m, n, a, af, aq, ar, lda, tau,
363 $ work, lwork, rwork, result( 1 ) )
364 ELSE IF( m.LE.n )
THEN
369 CALL
zrqt02( m, n, k, a, af, aq, ar, lda, tau,
370 $ work, lwork, rwork, result( 1 ) )
377 CALL
zrqt03( 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
zlarhs( path,
'New',
'Full',
392 $
'No transpose', m, n, 0, 0,
393 $ nrhs, a, lda, xact, lda,
b, lda,
396 CALL
zlacpy(
'Full', m, nrhs,
b, lda,
399 CALL
zgerqs( m, n, nrhs, af, lda, tau, x,
400 $ lda, work, lwork, info )
405 $ CALL
alaerh( path,
'ZGERQS', info, 0,
' ',
406 $ m, n, nrhs, -1, nb, imat,
407 $ nfail, nerrs, nout )
409 CALL
zget02(
'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 zerrrq(PATH, NUNIT)
ZERRRQ
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zrqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZRQT03
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zrqt01(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZRQT01
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine zgerqs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
ZGERQS
subroutine zchkrq(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)
ZCHKRQ
subroutine zrqt02(M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZRQT02
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZGET02
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4