137 SUBROUTINE dchkqp( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
138 $ copya, s, tau, work, iwork, nout )
148 DOUBLE PRECISION thresh
152 INTEGER iwork( * ), mval( * ), nval( * )
153 DOUBLE PRECISION a( * ), copya( * ), s( * ),
154 $ tau( * ), work( * )
161 parameter( ntypes = 6 )
163 parameter( ntests = 3 )
164 DOUBLE PRECISION one, zero
165 parameter( one = 1.0d0, zero = 0.0d0 )
169 INTEGER i, ihigh, ilow, im, imode, in, info, istep, k,
170 $ lda, lwork, m, mnmin, mode, n, nerrs, nfail,
175 INTEGER iseed( 4 ), iseedy( 4 )
176 DOUBLE PRECISION result( ntests )
192 INTEGER infot, iounit
195 COMMON / infoc / infot, iounit, ok, lerr
196 COMMON / srnamc / srnamt
199 DATA iseedy / 1988, 1989, 1990, 1991 /
205 path( 1: 1 ) =
'Double precision'
211 iseed( i ) = iseedy( i )
218 $ CALL
derrqp( path, nout )
234 lwork = max( 1, m*max( m, n ) + 4*mnmin + max( m, n ),
235 $ m*n + 2*mnmin + 4*n )
237 DO 60 imode = 1, ntypes
238 IF( .NOT.dotype( imode ) )
259 IF( imode.EQ.1 )
THEN
260 CALL
dlaset(
'Full', m, n, zero, zero, copya, lda )
265 CALL
dlatms( m, n,
'Uniform', iseed,
'Nonsymm', s,
266 $ mode, one / eps, one, m, n,
'No packing',
267 $ copya, lda, work, info )
268 IF( imode.GE.4 )
THEN
269 IF( imode.EQ.4 )
THEN
272 ihigh = max( 1, n / 2 )
273 ELSE IF( imode.EQ.5 )
THEN
274 ilow = max( 1, n / 2 )
277 ELSE IF( imode.EQ.6 )
THEN
282 DO 40 i = ilow, ihigh, istep
286 CALL
dlaord(
'Decreasing', mnmin, s, 1 )
291 CALL
dlacpy(
'All', m, n, copya, lda, a, lda )
296 CALL
dgeqpf( m, n, a, lda, iwork, tau, work, info )
300 result( 1 ) =
dqrt12( m, n, a, lda, s, work, lwork )
304 result( 2 ) =
dqpt01( m, n, mnmin, copya, a, lda, tau,
305 $ iwork, work, lwork )
309 result( 3 ) =
dqrt11( m, mnmin, a, lda, tau, work,
316 IF( result( k ).GE.thresh )
THEN
317 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
318 $ CALL
alahd( nout, path )
319 WRITE( nout, fmt = 9999 )m, n, imode, k,
331 CALL
alasum( path, nout, nfail, nrun, nerrs )
333 9999
FORMAT(
' M =', i5,
', N =', i5,
', type ', i2,
', test ', i2,
334 $
', ratio =', g12.5 )
subroutine derrqp(PATH, NUNIT)
DERRQP
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
double precision function dqpt01(M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
DQPT01
double precision function dqrt12(M, N, A, LDA, S, WORK, LWORK)
DQRT12
subroutine dlaord(JOB, N, X, INCX)
DLAORD
double precision function dqrt11(M, K, A, LDA, TAU, WORK, LWORK)
DQRT11
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine dgeqpf(M, N, A, LDA, JPVT, TAU, WORK, INFO)
DGEQPF
double precision function dlamch(CMACH)
DLAMCH
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
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 dchkqp(DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, IWORK, NOUT)
DCHKQP