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 )
195 REAL SLAMCH, SQPT01, SQRT11, SQRT12
196 EXTERNAL slamch, sqpt01, sqrt11, sqrt12
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 )
229 eps = slamch(
'Epsilon' )
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 alahd(IOUNIT, PATH)
ALAHD
subroutine icopy(N, SX, INCX, SY, INCY)
ICOPY
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
subroutine schkq3(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, THRESH, A, COPYA, S, TAU, WORK, IWORK, NOUT)
SCHKQ3
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 sgeqp3(M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO)
SGEQP3
subroutine slaord(JOB, N, X, INCX)
SLAORD
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM