157 SUBROUTINE zchkq3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
158 $ thresh, a, copya, s, tau, work, rwork,
167 INTEGER nm, nn, nnb, nout
168 DOUBLE PRECISION thresh
172 INTEGER iwork( * ), mval( * ), nbval( * ), nval( * ),
174 DOUBLE PRECISION s( * ), rwork( * )
175 COMPLEX*16 a( * ), copya( * ), tau( * ), work( * )
182 parameter( ntypes = 6 )
184 parameter( ntests = 3 )
185 DOUBLE PRECISION one, zero
187 parameter( one = 1.0d+0, zero = 0.0d+0,
188 $ czero = ( 0.0d+0, 0.0d+0 ) )
192 INTEGER i, ihigh, ilow, im, imode, in, inb, info,
193 $ istep, k, lda, lw, lwork, m, mnmin, mode, n,
194 $ nb, nerrs, nfail, nrun, nx
198 INTEGER iseed( 4 ), iseedy( 4 )
199 DOUBLE PRECISION result( ntests )
215 INTEGER infot, iounit
218 COMMON / infoc / infot, iounit, ok, lerr
219 COMMON / srnamc / srnamt
222 DATA iseedy / 1988, 1989, 1990, 1991 /
228 path( 1: 1 ) =
'Zomplex precision'
234 iseed( i ) = iseedy( i )
252 lwork = max( 1, m*max( m, n )+4*mnmin+max( m, n ) )
254 DO 70 imode = 1, ntypes
255 IF( .NOT.dotype( imode ) )
276 IF( imode.EQ.1 )
THEN
277 CALL
zlaset(
'Full', m, n, czero, czero, copya, lda )
282 CALL
zlatms( m, n,
'Uniform', iseed,
'Nonsymm', s,
283 $ mode, one / eps, one, m, n,
'No packing',
284 $ copya, lda, work, info )
285 IF( imode.GE.4 )
THEN
286 IF( imode.EQ.4 )
THEN
289 ihigh = max( 1, n / 2 )
290 ELSE IF( imode.EQ.5 )
THEN
291 ilow = max( 1, n / 2 )
294 ELSE IF( imode.EQ.6 )
THEN
299 DO 40 i = ilow, ihigh, istep
303 CALL
dlaord(
'Decreasing', mnmin, s, 1 )
318 CALL
zlacpy(
'All', m, n, copya, lda, a, lda )
319 CALL
icopy( n, iwork( 1 ), 1, iwork( n+1 ), 1 )
326 CALL
zgeqp3( m, n, a, lda, iwork( n+1 ), tau, work,
331 result( 1 ) =
zqrt12( m, n, a, lda, s, work,
336 result( 2 ) =
zqpt01( m, n, mnmin, copya, a, lda, tau,
337 $ iwork( n+1 ), work, lwork )
341 result( 3 ) =
zqrt11( m, mnmin, a, lda, tau, work,
348 IF( result( k ).GE.thresh )
THEN
349 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
350 $ CALL
alahd( nout, path )
351 WRITE( nout, fmt = 9999 )
'ZGEQP3', m, n, nb,
352 $ imode, k, result( k )
365 CALL
alasum( path, nout, nfail, nrun, nerrs )
367 9999
FORMAT( 1
x, a,
' M =', i5,
', N =', i5,
', NB =', i4,
', type ',
368 $ i2,
', test ', i2,
', 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 zchkq3(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, THRESH, A, COPYA, S, TAU, WORK, RWORK, IWORK, NOUT)
ZCHKQ3
subroutine zgeqp3(M, N, A, LDA, JPVT, TAU, WORK, LWORK, RWORK, INFO)
ZGEQP3
subroutine dlaord(JOB, N, X, INCX)
DLAORD
DOUBLE PRECISION function zqpt01(M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
ZQPT01
subroutine icopy(N, SX, INCX, SY, INCY)
ICOPY
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
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
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