LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
zckgqr.f
Go to the documentation of this file.
1 *> \brief \b ZCKGQR
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 ZCKGQR( NM, MVAL, NP, PVAL, NN, NVAL, NMATS, ISEED,
12 * THRESH, NMAX, A, AF, AQ, AR, TAUA, B, BF, BZ,
13 * BT, BWK, TAUB, WORK, RWORK, NIN, NOUT, INFO )
14 *
15 * .. Scalar Arguments ..
16 * INTEGER INFO, NIN, NM, NMATS, NMAX, NN, NOUT, NP
17 * DOUBLE PRECISION THRESH
18 * ..
19 * .. Array Arguments ..
20 * INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
21 * DOUBLE PRECISION RWORK( * )
22 * COMPLEX*16 A( * ), AF( * ), AQ( * ), AR( * ), B( * ),
23 * $ BF( * ), BT( * ), BWK( * ), BZ( * ), TAUA( * ),
24 * $ TAUB( * ), WORK( * )
25 * ..
26 *
27 *
28 *> \par Purpose:
29 * =============
30 *>
31 *> \verbatim
32 *>
33 *> ZCKGQR tests
34 *> ZGGQRF: GQR factorization for N-by-M matrix A and N-by-P matrix B,
35 *> ZGGRQF: GRQ factorization for M-by-N matrix A and P-by-N matrix B.
36 *> \endverbatim
37 *
38 * Arguments:
39 * ==========
40 *
41 *> \param[in] NM
42 *> \verbatim
43 *> NM is INTEGER
44 *> The number of values of M contained in the vector MVAL.
45 *> \endverbatim
46 *>
47 *> \param[in] MVAL
48 *> \verbatim
49 *> MVAL is INTEGER array, dimension (NM)
50 *> The values of the matrix row(column) dimension M.
51 *> \endverbatim
52 *>
53 *> \param[in] NP
54 *> \verbatim
55 *> NP is INTEGER
56 *> The number of values of P contained in the vector PVAL.
57 *> \endverbatim
58 *>
59 *> \param[in] PVAL
60 *> \verbatim
61 *> PVAL is INTEGER array, dimension (NP)
62 *> The values of the matrix row(column) dimension P.
63 *> \endverbatim
64 *>
65 *> \param[in] NN
66 *> \verbatim
67 *> NN is INTEGER
68 *> The number of values of N contained in the vector NVAL.
69 *> \endverbatim
70 *>
71 *> \param[in] NVAL
72 *> \verbatim
73 *> NVAL is INTEGER array, dimension (NN)
74 *> The values of the matrix column(row) dimension N.
75 *> \endverbatim
76 *>
77 *> \param[in] NMATS
78 *> \verbatim
79 *> NMATS is INTEGER
80 *> The number of matrix types to be tested for each combination
81 *> of matrix dimensions. If NMATS >= NTYPES (the maximum
82 *> number of matrix types), then all the different types are
83 *> generated for testing. If NMATS < NTYPES, another input line
84 *> is read to get the numbers of the matrix types to be used.
85 *> \endverbatim
86 *>
87 *> \param[in,out] ISEED
88 *> \verbatim
89 *> ISEED is INTEGER array, dimension (4)
90 *> On entry, the seed of the random number generator. The array
91 *> elements should be between 0 and 4095, otherwise they will be
92 *> reduced mod 4096, and ISEED(4) must be odd.
93 *> On exit, the next seed in the random number sequence after
94 *> all the test matrices have been generated.
95 *> \endverbatim
96 *>
97 *> \param[in] THRESH
98 *> \verbatim
99 *> THRESH is DOUBLE PRECISION
100 *> The threshold value for the test ratios. A result is
101 *> included in the output file if RESULT >= THRESH. To have
102 *> every test ratio printed, use THRESH = 0.
103 *> \endverbatim
104 *>
105 *> \param[in] NMAX
106 *> \verbatim
107 *> NMAX is INTEGER
108 *> The maximum value permitted for M or N, used in dimensioning
109 *> the work arrays.
110 *> \endverbatim
111 *>
112 *> \param[out] A
113 *> \verbatim
114 *> A is COMPLEX*16 array, dimension (NMAX*NMAX)
115 *> \endverbatim
116 *>
117 *> \param[out] AF
118 *> \verbatim
119 *> AF is COMPLEX*16 array, dimension (NMAX*NMAX)
120 *> \endverbatim
121 *>
122 *> \param[out] AQ
123 *> \verbatim
124 *> AQ is COMPLEX*16 array, dimension (NMAX*NMAX)
125 *> \endverbatim
126 *>
127 *> \param[out] AR
128 *> \verbatim
129 *> AR is COMPLEX*16 array, dimension (NMAX*NMAX)
130 *> \endverbatim
131 *>
132 *> \param[out] TAUA
133 *> \verbatim
134 *> TAUA is COMPLEX*16 array, dimension (NMAX)
135 *> \endverbatim
136 *>
137 *> \param[out] B
138 *> \verbatim
139 *> B is COMPLEX*16 array, dimension (NMAX*NMAX)
140 *> \endverbatim
141 *>
142 *> \param[out] BF
143 *> \verbatim
144 *> BF is COMPLEX*16 array, dimension (NMAX*NMAX)
145 *> \endverbatim
146 *>
147 *> \param[out] BZ
148 *> \verbatim
149 *> BZ is COMPLEX*16 array, dimension (NMAX*NMAX)
150 *> \endverbatim
151 *>
152 *> \param[out] BT
153 *> \verbatim
154 *> BT is COMPLEX*16 array, dimension (NMAX*NMAX)
155 *> \endverbatim
156 *>
157 *> \param[out] BWK
158 *> \verbatim
159 *> BWK is COMPLEX*16 array, dimension (NMAX*NMAX)
160 *> \endverbatim
161 *>
162 *> \param[out] TAUB
163 *> \verbatim
164 *> TAUB is COMPLEX*16 array, dimension (NMAX)
165 *> \endverbatim
166 *>
167 *> \param[out] WORK
168 *> \verbatim
169 *> WORK is COMPLEX*16 array, dimension (NMAX*NMAX)
170 *> \endverbatim
171 *>
172 *> \param[out] RWORK
173 *> \verbatim
174 *> RWORK is DOUBLE PRECISION array, dimension (NMAX)
175 *> \endverbatim
176 *>
177 *> \param[in] NIN
178 *> \verbatim
179 *> NIN is INTEGER
180 *> The unit number for input.
181 *> \endverbatim
182 *>
183 *> \param[in] NOUT
184 *> \verbatim
185 *> NOUT is INTEGER
186 *> The unit number for output.
187 *> \endverbatim
188 *>
189 *> \param[out] INFO
190 *> \verbatim
191 *> INFO is INTEGER
192 *> = 0 : successful exit
193 *> > 0 : If ZLATMS returns an error code, the absolute value
194 *> of it is returned.
195 *> \endverbatim
196 *
197 * Authors:
198 * ========
199 *
200 *> \author Univ. of Tennessee
201 *> \author Univ. of California Berkeley
202 *> \author Univ. of Colorado Denver
203 *> \author NAG Ltd.
204 *
205 *> \date November 2011
206 *
207 *> \ingroup complex16_eig
208 *
209 * =====================================================================
210  SUBROUTINE zckgqr( NM, MVAL, NP, PVAL, NN, NVAL, NMATS, ISEED,
211  $ thresh, nmax, a, af, aq, ar, taua, b, bf, bz,
212  $ bt, bwk, taub, work, rwork, nin, nout, info )
213 *
214 * -- LAPACK test routine (version 3.4.0) --
215 * -- LAPACK is a software package provided by Univ. of Tennessee, --
216 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
217 * November 2011
218 *
219 * .. Scalar Arguments ..
220  INTEGER INFO, NIN, NM, NMATS, NMAX, NN, NOUT, NP
221  DOUBLE PRECISION THRESH
222 * ..
223 * .. Array Arguments ..
224  INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
225  DOUBLE PRECISION RWORK( * )
226  COMPLEX*16 A( * ), AF( * ), AQ( * ), AR( * ), B( * ),
227  $ bf( * ), bt( * ), bwk( * ), bz( * ), taua( * ),
228  $ taub( * ), work( * )
229 * ..
230 *
231 * =====================================================================
232 *
233 * .. Parameters ..
234  INTEGER NTESTS
235  parameter ( ntests = 7 )
236  INTEGER NTYPES
237  parameter ( ntypes = 8 )
238 * ..
239 * .. Local Scalars ..
240  LOGICAL FIRSTT
241  CHARACTER DISTA, DISTB, TYPE
242  CHARACTER*3 PATH
243  INTEGER I, IINFO, IM, IMAT, IN, IP, KLA, KLB, KUA, KUB,
244  $ lda, ldb, lwork, m, modea, modeb, n, nfail,
245  $ nrun, nt, p
246  DOUBLE PRECISION ANORM, BNORM, CNDNMA, CNDNMB
247 * ..
248 * .. Local Arrays ..
249  LOGICAL DOTYPE( ntypes )
250  DOUBLE PRECISION RESULT( ntests )
251 * ..
252 * .. External Subroutines ..
253  EXTERNAL alahdg, alareq, alasum, dlatb9, zgqrts, zgrqts,
254  $ zlatms
255 * ..
256 * .. Intrinsic Functions ..
257  INTRINSIC abs
258 * ..
259 * .. Executable Statements ..
260 *
261 * Initialize constants.
262 *
263  path( 1: 3 ) = 'GQR'
264  info = 0
265  nrun = 0
266  nfail = 0
267  firstt = .true.
268  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
269  lda = nmax
270  ldb = nmax
271  lwork = nmax*nmax
272 *
273 * Do for each value of M in MVAL.
274 *
275  DO 60 im = 1, nm
276  m = mval( im )
277 *
278 * Do for each value of P in PVAL.
279 *
280  DO 50 ip = 1, np
281  p = pval( ip )
282 *
283 * Do for each value of N in NVAL.
284 *
285  DO 40 in = 1, nn
286  n = nval( in )
287 *
288  DO 30 imat = 1, ntypes
289 *
290 * Do the tests only if DOTYPE( IMAT ) is true.
291 *
292  IF( .NOT.dotype( imat ) )
293  $ GO TO 30
294 *
295 * Test ZGGRQF
296 *
297 * Set up parameters with DLATB9 and generate test
298 * matrices A and B with ZLATMS.
299 *
300  CALL dlatb9( 'GRQ', imat, m, p, n, TYPE, KLA, KUA,
301  $ klb, kub, anorm, bnorm, modea, modeb,
302  $ cndnma, cndnmb, dista, distb )
303 *
304  CALL zlatms( m, n, dista, iseed, TYPE, RWORK, MODEA,
305  $ cndnma, anorm, kla, kua, 'No packing', a,
306  $ lda, work, iinfo )
307  IF( iinfo.NE.0 ) THEN
308  WRITE( nout, fmt = 9999 )iinfo
309  info = abs( iinfo )
310  GO TO 30
311  END IF
312 *
313  CALL zlatms( p, n, distb, iseed, TYPE, RWORK, MODEB,
314  $ cndnmb, bnorm, klb, kub, 'No packing', b,
315  $ ldb, work, iinfo )
316  IF( iinfo.NE.0 ) THEN
317  WRITE( nout, fmt = 9999 )iinfo
318  info = abs( iinfo )
319  GO TO 30
320  END IF
321 *
322  nt = 4
323 *
324  CALL zgrqts( m, p, n, a, af, aq, ar, lda, taua, b, bf,
325  $ bz, bt, bwk, ldb, taub, work, lwork,
326  $ rwork, result )
327 *
328 * Print information about the tests that did not
329 * pass the threshold.
330 *
331  DO 10 i = 1, nt
332  IF( result( i ).GE.thresh ) THEN
333  IF( nfail.EQ.0 .AND. firstt ) THEN
334  firstt = .false.
335  CALL alahdg( nout, 'GRQ' )
336  END IF
337  WRITE( nout, fmt = 9998 )m, p, n, imat, i,
338  $ result( i )
339  nfail = nfail + 1
340  END IF
341  10 CONTINUE
342  nrun = nrun + nt
343 *
344 * Test ZGGQRF
345 *
346 * Set up parameters with DLATB9 and generate test
347 * matrices A and B with ZLATMS.
348 *
349  CALL dlatb9( 'GQR', imat, m, p, n, TYPE, KLA, KUA,
350  $ klb, kub, anorm, bnorm, modea, modeb,
351  $ cndnma, cndnmb, dista, distb )
352 *
353  CALL zlatms( n, m, dista, iseed, TYPE, RWORK, MODEA,
354  $ cndnma, anorm, kla, kua, 'No packing', a,
355  $ lda, work, iinfo )
356  IF( iinfo.NE.0 ) THEN
357  WRITE( nout, fmt = 9999 )iinfo
358  info = abs( iinfo )
359  GO TO 30
360  END IF
361 *
362  CALL zlatms( n, p, distb, iseed, TYPE, RWORK, MODEA,
363  $ cndnma, bnorm, klb, kub, 'No packing', b,
364  $ ldb, work, iinfo )
365  IF( iinfo.NE.0 ) THEN
366  WRITE( nout, fmt = 9999 )iinfo
367  info = abs( iinfo )
368  GO TO 30
369  END IF
370 *
371  nt = 4
372 *
373  CALL zgqrts( n, m, p, a, af, aq, ar, lda, taua, b, bf,
374  $ bz, bt, bwk, ldb, taub, work, lwork,
375  $ rwork, result )
376 *
377 * Print information about the tests that did not
378 * pass the threshold.
379 *
380  DO 20 i = 1, nt
381  IF( result( i ).GE.thresh ) THEN
382  IF( nfail.EQ.0 .AND. firstt ) THEN
383  firstt = .false.
384  CALL alahdg( nout, path )
385  END IF
386  WRITE( nout, fmt = 9997 )n, m, p, imat, i,
387  $ result( i )
388  nfail = nfail + 1
389  END IF
390  20 CONTINUE
391  nrun = nrun + nt
392 *
393  30 CONTINUE
394  40 CONTINUE
395  50 CONTINUE
396  60 CONTINUE
397 *
398 * Print a summary of the results.
399 *
400  CALL alasum( path, nout, nfail, nrun, 0 )
401 *
402  9999 FORMAT( ' ZLATMS in ZCKGQR: INFO = ', i5 )
403  9998 FORMAT( ' M=', i4, ' P=', i4, ', N=', i4, ', type ', i2,
404  $ ', test ', i2, ', ratio=', g13.6 )
405  9997 FORMAT( ' N=', i4, ' M=', i4, ', P=', i4, ', type ', i2,
406  $ ', test ', i2, ', ratio=', g13.6 )
407  RETURN
408 *
409 * End of ZCKGQR
410 *
411  END
zgqrts
subroutine zgqrts(N, M, P, A, AF, Q, R, LDA, TAUA, B, BF, Z, T, BWK, LDB, TAUB, WORK, LWORK, RWORK, RESULT)
ZGQRTS
Definition: zgqrts.f:178
zgrqts
subroutine zgrqts(M, P, N, A, AF, Q, R, LDA, TAUA, B, BF, Z, T, BWK, LDB, TAUB, WORK, LWORK, RWORK, RESULT)
ZGRQTS
Definition: zgrqts.f:178
alareq
subroutine alareq(PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT)
ALAREQ
Definition: alareq.f:92
dlatb9
subroutine dlatb9(PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB, ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB, DISTA, DISTB)
DLATB9
Definition: dlatb9.f:172
zlatms
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
zckgqr
subroutine zckgqr(NM, MVAL, NP, PVAL, NN, NVAL, NMATS, ISEED, THRESH, NMAX, A, AF, AQ, AR, TAUA, B, BF, BZ, BT, BWK, TAUB, WORK, RWORK, NIN, NOUT, INFO)
ZCKGQR
Definition: zckgqr.f:213
alahdg
subroutine alahdg(IOUNIT, PATH)
ALAHDG
Definition: alahdg.f:64
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75