193 SUBROUTINE cchklq( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
194 $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC,
195 $ B, X, XACT, TAU, WORK, RWORK, NOUT )
203 INTEGER NM, NMAX, NN, NNB, NOUT, NRHS
208 INTEGER MVAL( * ), NBVAL( * ), NVAL( * ),
211 COMPLEX A( * ), AC( * ), AF( * ), AL( * ), AQ( * ),
212 $ b( * ), tau( * ), work( * ), x( * ), xact( * )
219 PARAMETER ( NTESTS = 7 )
221 parameter( ntypes = 8 )
223 parameter( zero = 0.0e0 )
228 INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA,
229 $ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
234 INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 )
235 REAL RESULT( NTESTS )
251 COMMON / infoc / infot, nunit, ok, lerr
252 COMMON / srnamc / srnamt
255 DATA iseedy / 1988, 1989, 1990, 1991 /
261 path( 1: 1 ) =
'Complex precision'
267 iseed( i ) = iseedy( i )
273 $
CALL cerrlq( path, nout )
278 lwork = nmax*max( nmax, nrhs )
290 DO 50 imat = 1, ntypes
294 IF( .NOT.dotype( imat ) )
300 CALL clatb4( path, imat, m, n,
TYPE, kl, ku, anorm, mode,
304 CALL clatms( m, n, dist, iseed,
TYPE, rwork, mode,
305 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
311 CALL alaerh( path,
'CLATMS', info, 0,
' ', m, n, -1,
312 $ -1, -1, imat, nfail, nerrs, nout )
323 kval( 4 ) = minmn / 2
324 IF( minmn.EQ.0 )
THEN
326 ELSE IF( minmn.EQ.1 )
THEN
328 ELSE IF( minmn.LE.3 )
THEN
354 CALL clqt01( m, n, a, af, aq, al, lda, tau,
355 $ work, lwork, rwork, result( 1 ) )
356 ELSE IF( m.LE.n )
THEN
361 CALL clqt02( m, n, k, a, af, aq, al, lda, tau,
362 $ work, lwork, rwork, result( 1 ) )
369 CALL clqt03( m, n, k, af, ac, al, aq, lda, tau,
370 $ work, lwork, rwork, result( 3 ) )
377 IF( k.EQ.m .AND. inb.EQ.1 )
THEN
383 CALL clarhs( path,
'New',
'Full',
384 $
'No transpose', m, n, 0, 0,
385 $ nrhs, a, lda, xact, lda, b, lda,
388 CALL clacpy(
'Full', m, nrhs, b, lda, x,
391 CALL cgelqs( m, n, nrhs, af, lda, tau, x,
392 $ lda, work, lwork, info )
397 $
CALL alaerh( path,
'CGELQS', info, 0,
' ',
398 $ m, n, nrhs, -1, nb, imat,
399 $ nfail, nerrs, nout )
401 CALL cget02(
'No transpose', m, n, nrhs, a,
402 $ lda, x, lda, b, lda, rwork,
412 IF( result( i ).GE.thresh )
THEN
413 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
414 $
CALL alahd( nout, path )
415 WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
416 $ imat, i, result( i )
429 CALL alasum( path, nout, nfail, nrun, nerrs )
431 9999
FORMAT(
' M=', i5,
', N=', i5,
', K=', i5,
', NB=', i4,
', NX=',
432 $ i5,
', type ', i2,
', test(', i2,
')=', g12.5 )
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine cget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CGET02
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine cgelqs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
CGELQS
subroutine cchklq(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, B, X, XACT, TAU, WORK, RWORK, NOUT)
CCHKLQ
subroutine clqt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CLQT02
subroutine clqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CLQT03
subroutine clqt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CLQT01
subroutine cerrlq(PATH, NUNIT)
CERRLQ
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.