152 SUBROUTINE dchkq3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
153 $ thresh, a, copya, s, tau, work, iwork,
162 INTEGER nm, nn, nnb, nout
163 DOUBLE PRECISION thresh
167 INTEGER iwork( * ), mval( * ), nbval( * ), nval( * ),
169 DOUBLE PRECISION a( * ), copya( * ), s( * ),
170 $ tau( * ), work( * )
177 parameter( ntypes = 6 )
179 parameter( ntests = 3 )
180 DOUBLE PRECISION one, zero
181 parameter( one = 1.0d0, zero = 0.0d0 )
185 INTEGER i, ihigh, ilow, im, imode, in, inb, info,
186 $ istep, k, lda, lw, lwork, m, mnmin, mode, n,
187 $ nb, nerrs, nfail, nrun, nx
191 INTEGER iseed( 4 ), iseedy( 4 )
192 DOUBLE PRECISION result( ntests )
208 INTEGER infot, iounit
211 COMMON / infoc / infot, iounit, ok, lerr
212 COMMON / srnamc / srnamt
215 DATA iseedy / 1988, 1989, 1990, 1991 /
221 path( 1: 1 ) =
'Double precision'
227 iseed( i ) = iseedy( i )
245 lwork = max( 1, m*max( m, n )+4*mnmin+max( m, n ),
246 $ m*n + 2*mnmin + 4*n )
248 DO 70 imode = 1, ntypes
249 IF( .NOT.dotype( imode ) )
270 IF( imode.EQ.1 )
THEN
271 CALL
dlaset(
'Full', m, n, zero, zero, copya, lda )
276 CALL
dlatms( m, n,
'Uniform', iseed,
'Nonsymm', s,
277 $ mode, one / eps, one, m, n,
'No packing',
278 $ copya, lda, work, info )
279 IF( imode.GE.4 )
THEN
280 IF( imode.EQ.4 )
THEN
283 ihigh = max( 1, n / 2 )
284 ELSE IF( imode.EQ.5 )
THEN
285 ilow = max( 1, n / 2 )
288 ELSE IF( imode.EQ.6 )
THEN
293 DO 40 i = ilow, ihigh, istep
297 CALL
dlaord(
'Decreasing', mnmin, s, 1 )
312 CALL
dlacpy(
'All', m, n, copya, lda, a, lda )
313 CALL
icopy( n, iwork( 1 ), 1, iwork( n+1 ), 1 )
317 lw = max( 1, 2*n+nb*( n+1 ) )
322 CALL
dgeqp3( m, n, a, lda, iwork( n+1 ), tau, work,
327 result( 1 ) =
dqrt12( m, n, a, lda, s, work,
332 result( 2 ) =
dqpt01( m, n, mnmin, copya, a, lda, tau,
333 $ iwork( n+1 ), work, lwork )
337 result( 3 ) =
dqrt11( m, mnmin, a, lda, tau, work,
344 IF( result( k ).GE.thresh )
THEN
345 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
346 $ CALL
alahd( nout, path )
347 WRITE( nout, fmt = 9999 )
'DGEQP3', m, n, nb,
348 $ imode, k, result( k )
361 CALL
alasum( path, nout, nfail, nrun, nerrs )
363 9999
FORMAT( 1
x, a,
' M =', i5,
', N =', i5,
', NB =', i4,
', type ',
364 $ i2,
', test ', i2,
', ratio =', g12.5 )
DOUBLE PRECISION function dqpt01(M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
DQPT01
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine dchkq3(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, THRESH, A, COPYA, S, TAU, WORK, IWORK, NOUT)
DCHKQ3
subroutine dlaord(JOB, N, X, INCX)
DLAORD
subroutine icopy(N, SX, INCX, SY, INCY)
ICOPY
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
DOUBLE PRECISION function dqrt12(M, N, A, LDA, S, WORK, LWORK)
DQRT12
DOUBLE PRECISION function dqrt11(M, K, A, LDA, TAU, WORK, LWORK)
DQRT11
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine dgeqp3(M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO)
DGEQP3