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 )
179 DOUBLE PRECISION DLAMCH, DQPT01, DQRT11, DQRT12
180 EXTERNAL dlamch, dqpt01, dqrt11, dqrt12
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 )
213 eps = dlamch(
'Epsilon' )
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
subroutine dlaord(JOB, N, X, INCX)
DLAORD
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine dgeqpf(M, N, A, LDA, JPVT, TAU, WORK, INFO)
DGEQPF
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