143 SUBROUTINE zchkqp( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
144 $ copya, s, tau, work, rwork, iwork,
155 DOUBLE PRECISION thresh
159 INTEGER iwork( * ), mval( * ), nval( * )
160 DOUBLE PRECISION s( * ), rwork( * )
161 COMPLEX*16 a( * ), copya( * ), tau( * ), work( * )
168 parameter( ntypes = 6 )
170 parameter( ntests = 3 )
171 DOUBLE PRECISION one, zero
172 parameter( one = 1.0d0, zero = 0.0d0 )
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 DOUBLE PRECISION result( ntests )
194 INTRINSIC dcmplx, 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 ) =
'Zomplex precision'
218 iseed( i ) = iseedy( i )
225 $ CALL
zerrqp( 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
zlaset(
'Full', m, n, dcmplx( zero ),
267 $ dcmplx( zero ), copya, lda )
272 CALL
zlatms( 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
dlaord(
'Decreasing', mnmin, s, 1 )
298 CALL
zlacpy(
'All', m, n, copya, lda, a, lda )
303 CALL
zgeqpf( m, n, a, lda, iwork, tau, work, rwork,
308 result( 1 ) =
zqrt12( m, n, a, lda, s, work, lwork,
313 result( 2 ) =
zqpt01( m, n, mnmin, copya, a, lda, tau,
314 $ iwork, work, lwork )
318 result( 3 ) =
zqrt11( 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 alahd(IOUNIT, PATH)
ALAHD
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zerrqp(PATH, NUNIT)
ZERRQP
subroutine dlaord(JOB, N, X, INCX)
DLAORD
DOUBLE PRECISION function zqpt01(M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
ZQPT01
subroutine zgeqpf(M, N, A, LDA, JPVT, TAU, WORK, RWORK, INFO)
ZGEQPF
subroutine zchkqp(DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, RWORK, IWORK, NOUT)
ZCHKQP
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
DOUBLE PRECISION function zqrt12(M, N, A, LDA, S, WORK, LWORK, RWORK)
ZQRT12
DOUBLE PRECISION function zqrt11(M, K, A, LDA, TAU, WORK, LWORK)
ZQRT11