195 SUBROUTINE cchkql( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
196 $ nrhs, thresh, tsterr, nmax, a, af, aq, al, ac,
197 $
b, x, xact, tau, work, rwork, nout )
206 INTEGER nm, nmax, nn, nnb, nout, nrhs
211 INTEGER mval( * ), nbval( * ), nval( * ),
214 COMPLEX a( * ), ac( * ), af( * ), al( * ), aq( * ),
215 $
b( * ), tau( * ), work( * ), x( * ), xact( * )
222 parameter( ntests = 7 )
224 parameter( ntypes = 8 )
226 parameter( zero = 0.0e0 )
231 INTEGER i, ik, im, imat, in, inb, info, k, kl, ku, lda,
232 $ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
237 INTEGER iseed( 4 ), iseedy( 4 ), kval( 4 )
238 REAL result( ntests )
254 COMMON / infoc / infot, nunit, ok, lerr
255 COMMON / srnamc / srnamt
258 DATA iseedy / 1988, 1989, 1990, 1991 /
264 path( 1: 1 ) =
'Complex precision'
270 iseed( i ) = iseedy( i )
276 $ CALL
cerrql( path, nout )
281 lwork = nmax*max( nmax, nrhs )
293 DO 50 imat = 1, ntypes
297 IF( .NOT.dotype( imat ) )
303 CALL
clatb4( path, imat, m, n, type, kl, ku, anorm, mode,
307 CALL
clatms( m, n, dist, iseed, type, rwork, mode,
308 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
314 CALL
alaerh( path,
'CLATMS', info, 0,
' ', m, n, -1,
315 $ -1, -1, imat, nfail, nerrs, nout )
326 kval( 4 ) = minmn / 2
327 IF( minmn.EQ.0 )
THEN
329 ELSE IF( minmn.EQ.1 )
THEN
331 ELSE IF( minmn.LE.3 )
THEN
357 CALL
cqlt01( m, n, a, af, aq, al, lda, tau,
358 $ work, lwork, rwork, result( 1 ) )
359 ELSE IF( m.GE.n )
THEN
364 CALL
cqlt02( m, n, k, a, af, aq, al, lda, tau,
365 $ work, lwork, rwork, result( 1 ) )
372 CALL
cqlt03( m, n, k, af, ac, al, aq, lda, tau,
373 $ work, lwork, rwork, result( 3 ) )
380 IF( k.EQ.n .AND. inb.EQ.1 )
THEN
386 CALL
clarhs( path,
'New',
'Full',
387 $
'No transpose', m, n, 0, 0,
388 $ nrhs, a, lda, xact, lda,
b, lda,
391 CALL
clacpy(
'Full', m, nrhs,
b, lda, x,
394 CALL
cgeqls( m, n, nrhs, af, lda, tau, x,
395 $ lda, work, lwork, info )
400 $ CALL
alaerh( path,
'CGEQLS', info, 0,
' ',
401 $ m, n, nrhs, -1, nb, imat,
402 $ nfail, nerrs, nout )
404 CALL
cget02(
'No transpose', m, n, nrhs, a,
405 $ lda, x( m-n+1 ), lda,
b, lda,
406 $ rwork, result( 7 ) )
415 IF( result( i ).GE.thresh )
THEN
416 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
417 $ CALL
alahd( nout, path )
418 WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
419 $ imat, i, result( i )
432 CALL
alasum( path, nout, nfail, nrun, nerrs )
434 9999
FORMAT(
' M=', i5,
', N=', i5,
', K=', i5,
', NB=', i4,
', NX=',
435 $ i5,
', type ', i2,
', test(', i2,
')=', g12.5 )
subroutine cerrql(PATH, NUNIT)
CERRQL
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine cchkql(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, B, X, XACT, TAU, WORK, RWORK, NOUT)
CCHKQL
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine cqlt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQLT02
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine cqlt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQLT01
subroutine cqlt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQLT03
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 clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine cgeqls(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
CGEQLS
subroutine cget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CGET02