143 SUBROUTINE cchkqp( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
144 $ copya, s, tau, work, rwork, iwork,
159 INTEGER IWORK( * ), MVAL( * ), NVAL( * )
160 REAL S( * ), RWORK( * )
161 COMPLEX A( * ), COPYA( * ), TAU( * ), WORK( * )
168 parameter( ntypes = 6 )
170 parameter( ntests = 3 )
172 parameter( one = 1.0e0, zero = 0.0e0 )
176 INTEGER I, IHIGH, ILOW, IM, IMODE, IN, INFO, ISTEP, K,
177 $ lda, lwork, m, mnmin, mode, n, nerrs, nfail,
182 INTEGER ISEED( 4 ), ISEEDY( 4 )
183 REAL RESULT( ntests )
186 REAL CQPT01, CQRT11, CQRT12, SLAMCH
187 EXTERNAL cqpt01, cqrt11, cqrt12, slamch
194 INTRINSIC cmplx, max, min
199 INTEGER INFOT, IOUNIT
202 COMMON / infoc / infot, iounit, ok, lerr
203 COMMON / srnamc / srnamt
206 DATA iseedy / 1988, 1989, 1990, 1991 /
212 path( 1: 1 ) =
'Complex precision'
218 iseed( i ) = iseedy( i )
220 eps = slamch(
'Epsilon' )
225 $
CALL cerrqp( path, nout )
241 lwork = max( 1, m*max( m, n )+4*mnmin+max( m, n ) )
243 DO 60 imode = 1, ntypes
244 IF( .NOT.dotype( imode ) )
265 IF( imode.EQ.1 )
THEN
266 CALL claset(
'Full', m, n, cmplx( zero ),
267 $ cmplx( zero ), copya, lda )
272 CALL clatms( m, n,
'Uniform', iseed,
'Nonsymm', s,
273 $ mode, one / eps, one, m, n,
'No packing',
274 $ copya, lda, work, info )
275 IF( imode.GE.4 )
THEN
276 IF( imode.EQ.4 )
THEN
279 ihigh = max( 1, n / 2 )
280 ELSE IF( imode.EQ.5 )
THEN
281 ilow = max( 1, n / 2 )
284 ELSE IF( imode.EQ.6 )
THEN
289 DO 40 i = ilow, ihigh, istep
293 CALL slaord(
'Decreasing', mnmin, s, 1 )
298 CALL clacpy(
'All', m, n, copya, lda, a, lda )
303 CALL cgeqpf( m, n, a, lda, iwork, tau, work, rwork,
308 result( 1 ) = cqrt12( m, n, a, lda, s, work, lwork,
313 result( 2 ) = cqpt01( m, n, mnmin, copya, a, lda, tau,
314 $ iwork, work, lwork )
318 result( 3 ) = cqrt11( m, mnmin, a, lda, tau, work,
325 IF( result( k ).GE.thresh )
THEN
326 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
327 $
CALL alahd( nout, path )
328 WRITE( nout, fmt = 9999 )m, n, imode, k,
340 CALL alasum( path, nout, nfail, nrun, nerrs )
342 9999
FORMAT(
' M =', i5,
', N =', i5,
', type ', i2,
', test ', i2,
343 $
', ratio =', g12.5 )
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine slaord(JOB, N, X, INCX)
SLAORD
subroutine cerrqp(PATH, NUNIT)
CERRQP
subroutine cgeqpf(M, N, A, LDA, JPVT, TAU, WORK, RWORK, INFO)
CGEQPF
subroutine cchkqp(DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, RWORK, IWORK, NOUT)
CCHKQP