1 SUBROUTINE zchklq( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
2 $ ibval, nrhs, thresh, tsterr, nmax, a, af, aq,
3 $ al, ac, b, x, xact, tau, work, rwork, iwork,
14 INTEGER nm, nmax, nn, nnb, nout, nrhs
15 DOUBLE PRECISION thresh
19 INTEGER iwork( * ), mval( * ), nbval( * ), nval( * ),
20 $ nxval( * ), ibval( * )
21 DOUBLE PRECISION rwork( * )
22 COMPLEX*16 a( * ), ac( * ), af( * ), al( * ), aq( * ),
23 $ b( * ), tau( * ), work( * ), x( * ), xact( * )
109 parameter( ntests = 7 )
111 parameter( ntypes = 8 )
112 DOUBLE PRECISION zero
113 parameter( zero = 0.0d0 )
118 INTEGER i, ik, im, imat, in, inb, info, k, kl, ku, lda,
119 $ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
120 $ nrun, nt, nx, ib, irh, rhblk
121 DOUBLE PRECISION anorm, cndnum
124 INTEGER iseed( 4 ), iseedy( 4 ), kval( 4 )
125 DOUBLE PRECISION result( ntests )
146 common / infoc / infot, nunit, ok, lerr
147 common / srnamc / srnamt
150 DATA iseedy / 1988, 1989, 1990, 1991 /
157 path( 1: 1 ) =
'Zomplex precision'
163 iseed( i ) = iseedy( i )
169 $ CALL
zerrlq( path, nout )
174 lwork = nmax*
max( nmax, nrhs )
188 DO 50 imat = 1, ntypes
192 IF( .NOT.dotype( imat ) )
198 CALL
zlatb4( path, imat, m, n, type, kl, ku, anorm, mode,
202 CALL
zlatms( m, n, dist, iseed, type, rwork, mode,
203 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
209 CALL
alaerh( path,
'ZLATMS', info, 0,
' ', m, n, -1,
210 $ -1, -1, imat, nfail, nerrs, nout )
221 kval( 4 ) = minmn / 2
222 IF( minmn.EQ.0 )
THEN
224 ELSE IF( minmn.EQ.1 )
THEN
226 ELSE IF( minmn.LE.3 )
THEN
237 $ plasma_flat_householder, info )
240 $ plasma_tree_householder, info )
258 IF ( (
max(m, n) / 10) .GT. nb )
THEN
262 CALL
plasma_set( plasma_inner_block_size, ib, info)
277 CALL
zlqt01( m, n, a, af, aq, al, lda, ht,
278 $ work, lwork, rwork, result( 1 ) )
282 ELSE IF( m.LE.n )
THEN
287 CALL
zlqt02( m, n, k, a, af, aq, al, lda, ht,
288 $ work, lwork, rwork, result( 1 ) )
298 CALL
zlqt03( m, n, k, af, ac, al, aq, lda, ht,
299 $ work, lwork, rwork, result( 3 ) )
306 IF( k.EQ.m .AND. inb.EQ.1 )
THEN
312 CALL
zlarhs( path,
'New',
'Full',
313 $
'No transpose', m, n, 0, 0,
314 $ nrhs, a, lda, xact, lda, b, lda,
317 CALL zlacpy(
'Full', m, nrhs, b, lda, x,
326 $ CALL
alaerh( path,
'ZGELQS', info, 0,
' ',
327 $ m, n, nrhs, -1, nb, imat,
328 $ nfail, nerrs, nout )
330 CALL
zget02(
'No transpose', m, n, nrhs, a,
331 $ lda, x, lda, b, lda, rwork,
348 IF( result( i ).GE.thresh )
THEN
349 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
350 $ CALL
alahd( nout, path )
351 WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
352 $ imat, i, result( i )
360 CALL plasma_dealloc_handle( ht, info )
370 CALL
alasum( path, nout, nfail, nrun, nerrs )
372 9999
format(
' M=', i5,
', N=', i5,
', K=', i5,
', NB=', i4,
', NX=',
373 $ i5,
', type ', i2,
', test(', i2,
')=', g12.5 )