1 SUBROUTINE dchkqr( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
2 $ ibval, nrhs, thresh, tsterr, nmax, a, af, aq,
3 $ ar, ac, b, x, xact, tau, work, rwork, iwork,
14 INTEGER nm, nmax, nn, nnb, nout, nrhs
15 DOUBLE PRECISION thresh
19 INTEGER ibval( * ), iwork( * ), mval( * ), nbval( * ),
20 $ nval( * ), nxval( * )
21 DOUBLE PRECISION a( * ), ac( * ), af( * ), aq( * ), ar( * ),
22 $ b( * ), rwork( * ), tau( * ), work( * ),
112 parameter( ntests = 7 )
114 parameter( ntypes = 8 )
115 DOUBLE PRECISION zero
116 parameter( zero = 0.0d0 )
121 INTEGER i, ib, ik, im, imat, in, inb, info, k, kl, ku,
122 $ lda, lwork, m, minmn, mode, n, nb, nerrs,
123 $ nfail, nk, nrun, nt, nx, irh, rhblk
124 DOUBLE PRECISION anorm, cndnum
127 INTEGER iseed( 4 ), iseedy( 4 ), kval( 4 )
128 DOUBLE PRECISION result( ntests )
149 common / infoc / infot, nunit, ok, lerr
150 common / srnamc / srnamt
153 DATA iseedy / 1988, 1989, 1990, 1991 /
160 path( 1: 1 ) =
'Double precision'
166 iseed( i ) = iseedy( i )
172 $ CALL
derrqr( path, nout )
177 lwork = nmax*
max( nmax, nrhs )
192 DO 50 imat = 1, ntypes
196 IF( .NOT.dotype( imat ) )
202 CALL
dlatb4( path, imat, m, n, type, kl, ku, anorm, mode,
206 CALL
dlatms( m, n, dist, iseed, type, rwork, mode,
207 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
213 CALL
alaerh( path,
'DLATMS', info, 0,
' ', m, n, -1,
214 $ -1, -1, imat, nfail, nerrs, nout )
225 kval( 4 ) = minmn / 2
226 IF( minmn.EQ.0 )
THEN
228 ELSE IF( minmn.EQ.1 )
THEN
230 ELSE IF( minmn.LE.3 )
THEN
241 $ plasma_flat_householder, info )
244 $ plasma_tree_householder, info )
262 IF ( (
max(m, n) / 10) .GT. nb )
THEN
266 CALL
plasma_set( plasma_inner_block_size, ib, info)
281 CALL
dqrt01( m, n, a, af, aq, ar, lda, ht,
282 $ work, lwork, rwork, result( 1 ) )
286 ELSE IF( m.GE.n )
THEN
291 CALL
dqrt02( m, n, k, a, af, aq, ar, lda, ht,
292 $ work, lwork, rwork, result( 1 ) )
299 CALL
dqrt03( m, n, k, af, ac, ar, aq, lda, ht,
300 $ work, lwork, rwork, result( 3 ) )
307 IF( k.EQ.n .AND. inb.EQ.1 )
THEN
313 CALL
dlarhs( path,
'New',
'Full',
314 $
'No transpose', m, n, 0, 0,
315 $ nrhs, a, lda, xact, lda, b, lda,
318 CALL dlacpy(
'Full', m, nrhs, b, lda, x,
327 $ CALL
alaerh( path,
'DGEQRS', info, 0,
' ',
328 $ m, n, nrhs, -1, nb, imat,
329 $ nfail, nerrs, nout )
331 CALL
dget02(
'No transpose', m, n, nrhs, a,
332 $ lda, x, lda, b, lda, rwork,
342 IF( result( i ).GE.thresh )
THEN
343 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
344 $ CALL
alahd( nout, path )
345 WRITE( nout, fmt = 9999 )m, n, k, nb, ib, nx,
346 $ imat, i, result( i )
354 CALL plasma_dealloc_handle( ht, info )
364 CALL
alasum( path, nout, nfail, nrun, nerrs )
366 9999
format(
' M=', i5,
', N=', i5,
', K=', i5,
', NB=', i4,
', IB=',
367 $ i4,
', NX=', i5,
', type ', i2,
', test(', i2,
')=', g12.5 )