 LAPACK  3.10.1 LAPACK: Linear Algebra PACKage

## ◆ cchkq3()

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

CCHKQ3

Purpose:
` CCHKQ3 tests CGEQP3.`
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 REAL 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 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 array, dimension (MMAX*NMAX)` [out] S ``` S is REAL array, dimension (min(MMAX,NMAX))``` [out] TAU ` TAU is COMPLEX array, dimension (MMAX)` [out] WORK ``` WORK is COMPLEX array, dimension (max(M*max(M,N) + 4*min(M,N) + max(M,N)))``` [out] RWORK ` RWORK is REAL array, dimension (4*NMAX)` [out] IWORK ` IWORK is INTEGER array, dimension (2*NMAX)` [in] NOUT ``` NOUT is INTEGER The unit number for output.```

Definition at line 155 of file cchkq3.f.

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