 LAPACK  3.8.0 LAPACK: Linear Algebra PACKage

## ◆ zchkq3()

 subroutine zchkq3 ( logical, dimension( * ) DOTYPE, integer NM, integer, dimension( * ) MVAL, integer NN, integer, dimension( * ) NVAL, integer NNB, integer, dimension( * ) NBVAL, integer, dimension( * ) NXVAL, double precision THRESH, complex*16, dimension( * ) A, complex*16, dimension( * ) COPYA, double precision, dimension( * ) S, complex*16, dimension( * ) TAU, complex*16, dimension( * ) WORK, double precision, dimension( * ) RWORK, integer, dimension( * ) IWORK, integer NOUT )

ZCHKQ3

Purpose:
` ZCHKQ3 tests ZGEQP3.`
Parameters
 [in] DOTYPE ``` DOTYPE is LOGICAL array, dimension (NTYPES) The matrix types to be used for testing. Matrices of type j (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.``` [in] NM ``` NM is INTEGER The number of values of M contained in the vector MVAL.``` [in] MVAL ``` MVAL is INTEGER array, dimension (NM) The values of the matrix row dimension M.``` [in] NN ``` NN is INTEGER The number of values of N contained in the vector NVAL.``` [in] NVAL ``` NVAL is INTEGER array, dimension (NN) The values of the matrix column dimension N.``` [in] NNB ``` NNB is INTEGER The number of values of NB and NX contained in the vectors NBVAL and NXVAL. The blocking parameters are used in pairs (NB,NX).``` [in] NBVAL ``` NBVAL is INTEGER array, dimension (NNB) The values of the blocksize NB.``` [in] NXVAL ``` NXVAL is INTEGER array, dimension (NNB) The values of the crossover point NX.``` [in] THRESH ``` THRESH is DOUBLE PRECISION The threshold value for the test ratios. A result is included in the output file if RESULT >= THRESH. To have every test ratio printed, use THRESH = 0.``` [out] A ``` A is COMPLEX*16 array, dimension (MMAX*NMAX) where MMAX is the maximum value of M in MVAL and NMAX is the maximum value of N in NVAL.``` [out] COPYA ` COPYA is COMPLEX*16 array, dimension (MMAX*NMAX)` [out] S ``` S is DOUBLE PRECISION array, dimension (min(MMAX,NMAX))``` [out] TAU ` TAU is COMPLEX*16 array, dimension (MMAX)` [out] WORK ``` WORK is COMPLEX*16 array, dimension (max(M*max(M,N) + 4*min(M,N) + max(M,N)))``` [out] RWORK ` RWORK is DOUBLE PRECISION array, dimension (4*NMAX)` [out] IWORK ` IWORK is INTEGER array, dimension (2*NMAX)` [in] NOUT ``` NOUT is INTEGER The unit number for output.```
Date
December 2016

Definition at line 160 of file zchkq3.f.

160 *
161 * -- LAPACK test routine (version 3.7.0) --
162 * -- LAPACK is a software package provided by Univ. of Tennessee, --
163 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
164 * December 2016
165 *
166 * .. Scalar Arguments ..
167  INTEGER nm, nn, nnb, nout
168  DOUBLE PRECISION thresh
169 * ..
170 * .. Array Arguments ..
171  LOGICAL dotype( * )
172  INTEGER iwork( * ), mval( * ), nbval( * ), nval( * ),
173  \$ nxval( * )
174  DOUBLE PRECISION s( * ), rwork( * )
175  COMPLEX*16 a( * ), copya( * ), tau( * ), work( * )
176 * ..
177 *
178 * =====================================================================
179 *
180 * .. Parameters ..
181  INTEGER ntypes
182  parameter( ntypes = 6 )
183  INTEGER ntests
184  parameter( ntests = 3 )
185  DOUBLE PRECISION one, zero
186  COMPLEX*16 czero
187  parameter( one = 1.0d+0, zero = 0.0d+0,
188  \$ czero = ( 0.0d+0, 0.0d+0 ) )
189 * ..
190 * .. Local Scalars ..
191  CHARACTER*3 path
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
195  DOUBLE PRECISION eps
196 * ..
197 * .. Local Arrays ..
198  INTEGER iseed( 4 ), iseedy( 4 )
199  DOUBLE PRECISION result( ntests )
200 * ..
201 * .. External Functions ..
202  DOUBLE PRECISION dlamch, zqpt01, zqrt11, zqrt12
203  EXTERNAL dlamch, zqpt01, zqrt11, zqrt12
204 * ..
205 * .. External Subroutines ..
206  EXTERNAL alahd, alasum, dlaord, icopy, xlaenv, zgeqp3,
207  \$ zlacpy, zlaset, zlatms
208 * ..
209 * .. Intrinsic Functions ..
210  INTRINSIC max, min
211 * ..
212 * .. Scalars in Common ..
213  LOGICAL lerr, ok
214  CHARACTER*32 srnamt
215  INTEGER infot, iounit
216 * ..
217 * .. Common blocks ..
218  COMMON / infoc / infot, iounit, ok, lerr
219  COMMON / srnamc / srnamt
220 * ..
221 * .. Data statements ..
222  DATA iseedy / 1988, 1989, 1990, 1991 /
223 * ..
224 * .. Executable Statements ..
225 *
226 * Initialize constants and the random number seed.
227 *
228  path( 1: 1 ) = 'Zomplex precision'
229  path( 2: 3 ) = 'Q3'
230  nrun = 0
231  nfail = 0
232  nerrs = 0
233  DO 10 i = 1, 4
234  iseed( i ) = iseedy( i )
235  10 CONTINUE
236  eps = dlamch( 'Epsilon' )
237  infot = 0
238 *
239  DO 90 im = 1, nm
240 *
241 * Do for each value of M in MVAL.
242 *
243  m = mval( im )
244  lda = max( 1, m )
245 *
246  DO 80 in = 1, nn
247 *
248 * Do for each value of N in NVAL.
249 *
250  n = nval( in )
251  mnmin = min( m, n )
252  lwork = max( 1, m*max( m, n )+4*mnmin+max( m, n ) )
253 *
254  DO 70 imode = 1, ntypes
255  IF( .NOT.dotype( imode ) )
256  \$ GO TO 70
257 *
258 * Do for each type of matrix
259 * 1: zero matrix
260 * 2: one small singular value
261 * 3: geometric distribution of singular values
262 * 4: first n/2 columns fixed
263 * 5: last n/2 columns fixed
264 * 6: every second column fixed
265 *
266  mode = imode
267  IF( imode.GT.3 )
268  \$ mode = 1
269 *
270 * Generate test matrix of size m by n using
271 * singular value distribution indicated by `mode'.
272 *
273  DO 20 i = 1, n
274  iwork( i ) = 0
275  20 CONTINUE
276  IF( imode.EQ.1 ) THEN
277  CALL zlaset( 'Full', m, n, czero, czero, copya, lda )
278  DO 30 i = 1, mnmin
279  s( i ) = zero
280  30 CONTINUE
281  ELSE
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
287  ilow = 1
288  istep = 1
289  ihigh = max( 1, n / 2 )
290  ELSE IF( imode.EQ.5 ) THEN
291  ilow = max( 1, n / 2 )
292  istep = 1
293  ihigh = n
294  ELSE IF( imode.EQ.6 ) THEN
295  ilow = 1
296  istep = 2
297  ihigh = n
298  END IF
299  DO 40 i = ilow, ihigh, istep
300  iwork( i ) = 1
301  40 CONTINUE
302  END IF
303  CALL dlaord( 'Decreasing', mnmin, s, 1 )
304  END IF
305 *
306  DO 60 inb = 1, nnb
307 *
308 * Do for each pair of values (NB,NX) in NBVAL and NXVAL.
309 *
310  nb = nbval( inb )
311  CALL xlaenv( 1, nb )
312  nx = nxval( inb )
313  CALL xlaenv( 3, nx )
314 *
315 * Save A and its singular values and a copy of
316 * vector IWORK.
317 *
318  CALL zlacpy( 'All', m, n, copya, lda, a, lda )
319  CALL icopy( n, iwork( 1 ), 1, iwork( n+1 ), 1 )
320 *
321 * Workspace needed.
322 *
323  lw = nb*( n+1 )
324 *
325  srnamt = 'ZGEQP3'
326  CALL zgeqp3( m, n, a, lda, iwork( n+1 ), tau, work,
327  \$ lw, rwork, info )
328 *
329 * Compute norm(svd(a) - svd(r))
330 *
331  result( 1 ) = zqrt12( m, n, a, lda, s, work,
332  \$ lwork, rwork )
333 *
334 * Compute norm( A*P - Q*R )
335 *
336  result( 2 ) = zqpt01( m, n, mnmin, copya, a, lda, tau,
337  \$ iwork( n+1 ), work, lwork )
338 *
339 * Compute Q'*Q
340 *
341  result( 3 ) = zqrt11( m, mnmin, a, lda, tau, work,
342  \$ lwork )
343 *
344 * Print information about the tests that did not pass
345 * the threshold.
346 *
347  DO 50 k = 1, ntests
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 )
353  nfail = nfail + 1
354  END IF
355  50 CONTINUE
356  nrun = nrun + ntests
357 *
358  60 CONTINUE
359  70 CONTINUE
360  80 CONTINUE
361  90 CONTINUE
362 *
363 * Print a summary of the results.
364 *
365  CALL alasum( path, nout, nfail, nrun, nerrs )
366 *
367  9999 FORMAT( 1x, a, ' M =', i5, ', N =', i5, ', NB =', i4, ', type ',
368  \$ i2, ', test ', i2, ', ratio =', g12.5 )
369 *
370 * End of ZCHKQ3
371 *
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine icopy(N, SX, INCX, SY, INCY)
ICOPY
Definition: icopy.f:77
subroutine zgeqp3(M, N, A, LDA, JPVT, TAU, WORK, LWORK, RWORK, INFO)
ZGEQP3
Definition: zgeqp3.f:161
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
double precision function zqrt12(M, N, A, LDA, S, WORK, LWORK, RWORK)
ZQRT12
Definition: zqrt12.f:99
double precision function zqpt01(M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
ZQPT01
Definition: zqpt01.f:122
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...
Definition: zlaset.f:108
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
double precision function zqrt11(M, K, A, LDA, TAU, WORK, LWORK)
ZQRT11
Definition: zqrt11.f:100
subroutine dlaord(JOB, N, X, INCX)
DLAORD
Definition: dlaord.f:75
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
Here is the call graph for this function:
Here is the caller graph for this function: