152 SUBROUTINE schkq3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
153 $ thresh, a, copya, s, tau, work, iwork,
162 INTEGER nm, nn, nnb, nout
167 INTEGER iwork( * ), mval( * ), nbval( * ), nval( * ),
169 REAL a( * ), copya( * ), s( * ),
170 $ tau( * ), work( * )
177 parameter( ntypes = 6 )
179 parameter( ntests = 3 )
181 parameter( one = 1.0e0, zero = 0.0e0 )
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 REAL 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 ) =
'Single 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
slaset(
'Full', m, n, zero, zero, copya, lda )
276 CALL
slatms( 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
slaord(
'Decreasing', mnmin, s, 1 )
312 CALL
slacpy(
'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
sgeqp3( m, n, a, lda, iwork( n+1 ), tau, work,
327 result( 1 ) =
sqrt12( m, n, a, lda, s, work,
332 result( 2 ) =
sqpt01( m, n, mnmin, copya, a, lda, tau,
333 $ iwork( n+1 ), work, lwork )
337 result( 3 ) =
sqrt11( 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 )
'SGEQP3', m, n, nb,
348 $ imode, k, result( k )
361 CALL
alasum( path, nout, nfail, nrun, nerrs )
363 9999
FORMAT( 1x, a,
' M =', i5,
', N =', i5,
', NB =', i4,
', type ',
364 $ i2,
', test ', i2,
', 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 sgeqp3(M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO)
SGEQP3
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 icopy(N, SX, INCX, SY, INCY)
ICOPY
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine schkq3(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, THRESH, A, COPYA, S, TAU, WORK, IWORK, NOUT)
SCHKQ3
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 xlaenv(ISPEC, NVALUE)
XLAENV
real function sqrt11(M, K, A, LDA, TAU, WORK, LWORK)
SQRT11