132 SUBROUTINE schktz( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
133 $ copya, s, tau, work, nout )
147 INTEGER MVAL( * ), NVAL( * )
148 REAL A( * ), COPYA( * ), S( * ),
149 $ tau( * ), work( * )
156 parameter( ntypes = 3 )
158 parameter( ntests = 6 )
160 parameter( one = 1.0e0, zero = 0.0e0 )
164 INTEGER I, IM, IMODE, IN, INFO, K, LDA, LWORK, M,
165 $ mnmin, mode, n, nerrs, nfail, nrun
169 INTEGER ISEED( 4 ), ISEEDY( 4 )
170 REAL RESULT( ntests )
173 REAL SLAMCH, SQRT12, SRZT01, SRZT02, STZT01, STZT02
174 EXTERNAL slamch, sqrt12, srzt01, srzt02, stzt01, stzt02
186 INTEGER INFOT, IOUNIT
189 COMMON / infoc / infot, iounit, ok, lerr
190 COMMON / srnamc / srnamt
193 DATA iseedy / 1988, 1989, 1990, 1991 /
199 path( 1: 1 ) =
'Single precision'
205 iseed( i ) = iseedy( i )
207 eps = slamch(
'Epsilon' )
212 $ CALL
serrtz( path, nout )
228 lwork = max( 1, n*n+4*m+n, m*n+2*mnmin+4*n )
231 DO 50 imode = 1, ntypes
232 IF( .NOT.dotype( imode ) )
248 CALL
slaset(
'Full', m, n, zero, zero, a, lda )
253 CALL
slatms( m, n,
'Uniform', iseed,
254 $
'Nonsymmetric', s, imode,
255 $ one / eps, one, m, n,
'No packing', a,
257 CALL
sgeqr2( m, n, a, lda, work, work( mnmin+1 ),
259 CALL
slaset(
'Lower', m-1, n, zero, zero, a( 2 ),
261 CALL
slaord(
'Decreasing', mnmin, s, 1 )
266 CALL
slacpy(
'All', m, n, a, lda, copya, lda )
272 CALL
stzrqf( m, n, a, lda, tau, info )
276 result( 1 ) = sqrt12( m, m, a, lda, s, work,
281 result( 2 ) = stzt01( m, n, copya, a, lda, tau, work,
286 result( 3 ) = stzt02( m, n, a, lda, tau, work, lwork )
294 CALL
slaset(
'Full', m, n, zero, zero, a, lda )
299 CALL
slatms( m, n,
'Uniform', iseed,
300 $
'Nonsymmetric', s, imode,
301 $ one / eps, one, m, n,
'No packing', a,
303 CALL
sgeqr2( m, n, a, lda, work, work( mnmin+1 ),
305 CALL
slaset(
'Lower', m-1, n, zero, zero, a( 2 ),
307 CALL
slaord(
'Decreasing', mnmin, s, 1 )
312 CALL
slacpy(
'All', m, n, a, lda, copya, lda )
318 CALL
stzrzf( m, n, a, lda, tau, work, lwork, info )
322 result( 4 ) = sqrt12( m, m, a, lda, s, work,
327 result( 5 ) = srzt01( m, n, copya, a, lda, tau, work,
332 result( 6 ) = srzt02( m, n, a, lda, tau, work, lwork )
338 IF( result( k ).GE.thresh )
THEN
339 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
340 $ CALL
alahd( nout, path )
341 WRITE( nout, fmt = 9999 )m, n, imode, k,
354 CALL
alasum( path, nout, nfail, nrun, nerrs )
356 9999
FORMAT(
' M =', i5,
', N =', i5,
', type ', i2,
', test ', i2,
357 $
', 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 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 serrtz(PATH, NUNIT)
SERRTZ
subroutine stzrqf(M, N, A, LDA, TAU, INFO)
STZRQF
subroutine slaord(JOB, N, X, INCX)
SLAORD
subroutine schktz(DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, NOUT)
SCHKTZ
subroutine stzrzf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
STZRZF
subroutine sgeqr2(M, N, A, LDA, TAU, WORK, INFO)
SGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm...