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 )
179 REAL SLAMCH, SQPT01, SQRT11, SQRT12
180 EXTERNAL slamch, sqpt01, sqrt11, sqrt12
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 )
213 eps = slamch(
'Epsilon' )
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
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
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.
subroutine slaord(JOB, N, X, INCX)
SLAORD
subroutine sgeqpf(M, N, A, LDA, JPVT, TAU, WORK, INFO)
SGEQPF
subroutine schkqp(DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, IWORK, NOUT)
SCHKQP