LAPACK  3.10.0
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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

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: