1*> \brief \b CCHKQ3
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE CCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
12*                          THRESH, A, COPYA, S, TAU, WORK, RWORK,
13*                          IWORK, NOUT )
14*
15*       .. Scalar Arguments ..
16*       INTEGER            NM, NN, NNB, NOUT
17*       REAL               THRESH
18*       ..
19*       .. Array Arguments ..
20*       LOGICAL            DOTYPE( * )
21*       INTEGER            IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
22*      $                   NXVAL( * )
23*       REAL               S( * ), RWORK( * )
24*       COMPLEX            A( * ), COPYA( * ), TAU( * ), WORK( * )
25*       ..
26*
27*
28*> \par Purpose:
29*  =============
30*>
31*> \verbatim
32*>
33*> CCHKQ3 tests CGEQP3.
34*> \endverbatim
35*
36*  Arguments:
37*  ==========
38*
39*> \param[in] DOTYPE
40*> \verbatim
41*>          DOTYPE is LOGICAL array, dimension (NTYPES)
42*>          The matrix types to be used for testing.  Matrices of type j
43*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
44*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
45*> \endverbatim
46*>
47*> \param[in] NM
48*> \verbatim
49*>          NM is INTEGER
50*>          The number of values of M contained in the vector MVAL.
51*> \endverbatim
52*>
53*> \param[in] MVAL
54*> \verbatim
55*>          MVAL is INTEGER array, dimension (NM)
56*>          The values of the matrix row dimension M.
57*> \endverbatim
58*>
59*> \param[in] NN
60*> \verbatim
61*>          NN is INTEGER
62*>          The number of values of N contained in the vector NVAL.
63*> \endverbatim
64*>
65*> \param[in] NVAL
66*> \verbatim
67*>          NVAL is INTEGER array, dimension (NN)
68*>          The values of the matrix column dimension N.
69*> \endverbatim
70*>
71*> \param[in] NNB
72*> \verbatim
73*>          NNB is INTEGER
74*>          The number of values of NB and NX contained in the
75*>          vectors NBVAL and NXVAL.  The blocking parameters are used
76*>          in pairs (NB,NX).
77*> \endverbatim
78*>
79*> \param[in] NBVAL
80*> \verbatim
81*>          NBVAL is INTEGER array, dimension (NNB)
82*>          The values of the blocksize NB.
83*> \endverbatim
84*>
85*> \param[in] NXVAL
86*> \verbatim
87*>          NXVAL is INTEGER array, dimension (NNB)
88*>          The values of the crossover point NX.
89*> \endverbatim
90*>
91*> \param[in] THRESH
92*> \verbatim
93*>          THRESH is REAL
94*>          The threshold value for the test ratios.  A result is
95*>          included in the output file if RESULT >= THRESH.  To have
96*>          every test ratio printed, use THRESH = 0.
97*> \endverbatim
98*>
99*> \param[out] A
100*> \verbatim
101*>          A is COMPLEX array, dimension (MMAX*NMAX)
102*>          where MMAX is the maximum value of M in MVAL and NMAX is the
103*>          maximum value of N in NVAL.
104*> \endverbatim
105*>
106*> \param[out] COPYA
107*> \verbatim
108*>          COPYA is COMPLEX array, dimension (MMAX*NMAX)
109*> \endverbatim
110*>
111*> \param[out] S
112*> \verbatim
113*>          S is REAL array, dimension
114*>                      (min(MMAX,NMAX))
115*> \endverbatim
116*>
117*> \param[out] TAU
118*> \verbatim
119*>          TAU is COMPLEX array, dimension (MMAX)
120*> \endverbatim
121*>
122*> \param[out] WORK
123*> \verbatim
124*>          WORK is COMPLEX array, dimension
125*>                      (max(M*max(M,N) + 4*min(M,N) + max(M,N)))
126*> \endverbatim
127*>
128*> \param[out] RWORK
129*> \verbatim
130*>          RWORK is REAL array, dimension (4*NMAX)
131*> \endverbatim
132*>
133*> \param[out] IWORK
134*> \verbatim
135*>          IWORK is INTEGER array, dimension (2*NMAX)
136*> \endverbatim
137*>
138*> \param[in] NOUT
139*> \verbatim
140*>          NOUT is INTEGER
141*>          The unit number for output.
142*> \endverbatim
143*
144*  Authors:
145*  ========
146*
147*> \author Univ. of Tennessee
148*> \author Univ. of California Berkeley
149*> \author Univ. of Colorado Denver
150*> \author NAG Ltd.
151*
152*> \date November 2011
153*
154*> \ingroup complex_lin
155*
156*  =====================================================================
157      SUBROUTINE CCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
158     $                   THRESH, A, COPYA, S, TAU, WORK, RWORK,
159     $                   IWORK, NOUT )
160*
161*  -- LAPACK test routine (version 3.4.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*     November 2011
165*
166*     .. Scalar Arguments ..
167      INTEGER            NM, NN, NNB, NOUT
168      REAL               THRESH
169*     ..
170*     .. Array Arguments ..
171      LOGICAL            DOTYPE( * )
172      INTEGER            IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
173     $                   NXVAL( * )
174      REAL               S( * ), RWORK( * )
175      COMPLEX            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      REAL               ONE, ZERO
186      COMPLEX            CZERO
187      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0,
188     $                   CZERO = ( 0.0E+0, 0.0E+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      REAL               EPS
196*     ..
197*     .. Local Arrays ..
198      INTEGER            ISEED( 4 ), ISEEDY( 4 )
199      REAL               RESULT( NTESTS )
200*     ..
201*     .. External Functions ..
202      REAL               CQPT01, CQRT11, CQRT12, SLAMCH
203      EXTERNAL           CQPT01, CQRT11, CQRT12, SLAMCH
204*     ..
205*     .. External Subroutines ..
206      EXTERNAL           ALAHD, ALASUM, CGEQP3, CLACPY, CLASET, CLATMS,
207     $                   ICOPY, SLAORD, XLAENV
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 ) = 'Complex 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 = SLAMCH( '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 CLASET( 'Full', M, N, CZERO, CZERO, COPYA, LDA )
278                  DO 30 I = 1, MNMIN
279                     S( I ) = ZERO
280   30             CONTINUE
281               ELSE
282                  CALL CLATMS( 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 SLAORD( '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 CLACPY( '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 = 'CGEQP3'
326                  CALL CGEQP3( 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 ) = CQRT12( M, N, A, LDA, S, WORK,
332     $                          LWORK, RWORK )
333*
334*                 Compute norm( A*P - Q*R )
335*
336                  RESULT( 2 ) = CQPT01( M, N, MNMIN, COPYA, A, LDA, TAU,
337     $                          IWORK( N+1 ), WORK, LWORK )
338*
339*                 Compute Q'*Q
340*
341                  RESULT( 3 ) = CQRT11( 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 )'CGEQP3', 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 CCHKQ3
371*
372      END
373