137 SUBROUTINE schkqp( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
138 $ copya, s, tau, work, iwork, nout )
152 INTEGER iwork( * ), mval( * ), nval( * )
153 REAL a( * ), copya( * ), s( * ),
154 $ tau( * ), work( * )
161 parameter( ntypes = 6 )
163 parameter( ntests = 3 )
165 parameter( one = 1.0e0, zero = 0.0e0 )
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 REAL 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 ) =
'Single precision'
211 iseed( i ) = iseedy( i )
218 $ CALL
serrqp( 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
slaset(
'Full', m, n, zero, zero, copya, lda )
265 CALL
slatms( 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
slaord(
'Decreasing', mnmin, s, 1 )
291 CALL
slacpy(
'All', m, n, copya, lda, a, lda )
296 CALL
sgeqpf( m, n, a, lda, iwork, tau, work, info )
300 result( 1 ) =
sqrt12( m, n, a, lda, s, work, lwork )
304 result( 2 ) =
sqpt01( m, n, mnmin, copya, a, lda, tau,
305 $ iwork, work, lwork )
309 result( 3 ) =
sqrt11( 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 slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine alahd(IOUNIT, PATH)
ALAHD
real function sqpt01(M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
SQPT01
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
real function sqrt12(M, N, A, LDA, S, WORK, LWORK)
SQRT12
subroutine serrqp(PATH, NUNIT)
SERRQP
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
real function slamch(CMACH)
SLAMCH
subroutine slaord(JOB, N, X, INCX)
SLAORD
subroutine sgeqpf(M, N, A, LDA, JPVT, TAU, WORK, INFO)
SGEQPF
real function sqrt11(M, K, A, LDA, TAU, WORK, LWORK)
SQRT11
subroutine schkqp(DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, IWORK, NOUT)
SCHKQP