LAPACK  3.10.0 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 *> \ingroup complex16_eig
206 *
207 * =====================================================================
208  SUBROUTINE zckgqr( NM, MVAL, NP, PVAL, NN, NVAL, NMATS, ISEED,
209  \$ THRESH, NMAX, A, AF, AQ, AR, TAUA, B, BF, BZ,
210  \$ BT, BWK, TAUB, WORK, RWORK, NIN, NOUT, INFO )
211 *
212 * -- LAPACK test routine --
213 * -- LAPACK is a software package provided by Univ. of Tennessee, --
214 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
215 *
216 * .. Scalar Arguments ..
217  INTEGER INFO, NIN, NM, NMATS, NMAX, NN, NOUT, NP
218  DOUBLE PRECISION THRESH
219 * ..
220 * .. Array Arguments ..
221  INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
222  DOUBLE PRECISION RWORK( * )
223  COMPLEX*16 A( * ), AF( * ), AQ( * ), AR( * ), B( * ),
224  \$ bf( * ), bt( * ), bwk( * ), bz( * ), taua( * ),
225  \$ taub( * ), work( * )
226 * ..
227 *
228 * =====================================================================
229 *
230 * .. Parameters ..
231  INTEGER NTESTS
232  PARAMETER ( NTESTS = 7 )
233  INTEGER NTYPES
234  parameter( ntypes = 8 )
235 * ..
236 * .. Local Scalars ..
237  LOGICAL FIRSTT
238  CHARACTER DISTA, DISTB, TYPE
239  CHARACTER*3 PATH
240  INTEGER I, IINFO, IM, IMAT, IN, IP, KLA, KLB, KUA, KUB,
241  \$ lda, ldb, lwork, m, modea, modeb, n, nfail,
242  \$ nrun, nt, p
243  DOUBLE PRECISION ANORM, BNORM, CNDNMA, CNDNMB
244 * ..
245 * .. Local Arrays ..
246  LOGICAL DOTYPE( NTYPES )
247  DOUBLE PRECISION RESULT( NTESTS )
248 * ..
249 * .. External Subroutines ..
250  EXTERNAL alahdg, alareq, alasum, dlatb9, zgqrts, zgrqts,
251  \$ zlatms
252 * ..
253 * .. Intrinsic Functions ..
254  INTRINSIC abs
255 * ..
256 * .. Executable Statements ..
257 *
258 * Initialize constants.
259 *
260  path( 1: 3 ) = 'GQR'
261  info = 0
262  nrun = 0
263  nfail = 0
264  firstt = .true.
265  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
266  lda = nmax
267  ldb = nmax
268  lwork = nmax*nmax
269 *
270 * Do for each value of M in MVAL.
271 *
272  DO 60 im = 1, nm
273  m = mval( im )
274 *
275 * Do for each value of P in PVAL.
276 *
277  DO 50 ip = 1, np
278  p = pval( ip )
279 *
280 * Do for each value of N in NVAL.
281 *
282  DO 40 in = 1, nn
283  n = nval( in )
284 *
285  DO 30 imat = 1, ntypes
286 *
287 * Do the tests only if DOTYPE( IMAT ) is true.
288 *
289  IF( .NOT.dotype( imat ) )
290  \$ GO TO 30
291 *
292 * Test ZGGRQF
293 *
294 * Set up parameters with DLATB9 and generate test
295 * matrices A and B with ZLATMS.
296 *
297  CALL dlatb9( 'GRQ', imat, m, p, n, TYPE, kla, kua,
298  \$ klb, kub, anorm, bnorm, modea, modeb,
299  \$ cndnma, cndnmb, dista, distb )
300 *
301  CALL zlatms( m, n, dista, iseed, TYPE, rwork, modea,
302  \$ cndnma, anorm, kla, kua, 'No packing', a,
303  \$ lda, work, iinfo )
304  IF( iinfo.NE.0 ) THEN
305  WRITE( nout, fmt = 9999 )iinfo
306  info = abs( iinfo )
307  GO TO 30
308  END IF
309 *
310  CALL zlatms( p, n, distb, iseed, TYPE, rwork, modeb,
311  \$ cndnmb, bnorm, klb, kub, 'No packing', b,
312  \$ ldb, work, iinfo )
313  IF( iinfo.NE.0 ) THEN
314  WRITE( nout, fmt = 9999 )iinfo
315  info = abs( iinfo )
316  GO TO 30
317  END IF
318 *
319  nt = 4
320 *
321  CALL zgrqts( m, p, n, a, af, aq, ar, lda, taua, b, bf,
322  \$ bz, bt, bwk, ldb, taub, work, lwork,
323  \$ rwork, result )
324 *
325 * Print information about the tests that did not
326 * pass the threshold.
327 *
328  DO 10 i = 1, nt
329  IF( result( i ).GE.thresh ) THEN
330  IF( nfail.EQ.0 .AND. firstt ) THEN
331  firstt = .false.
332  CALL alahdg( nout, 'GRQ' )
333  END IF
334  WRITE( nout, fmt = 9998 )m, p, n, imat, i,
335  \$ result( i )
336  nfail = nfail + 1
337  END IF
338  10 CONTINUE
339  nrun = nrun + nt
340 *
341 * Test ZGGQRF
342 *
343 * Set up parameters with DLATB9 and generate test
344 * matrices A and B with ZLATMS.
345 *
346  CALL dlatb9( 'GQR', imat, m, p, n, TYPE, kla, kua,
347  \$ klb, kub, anorm, bnorm, modea, modeb,
348  \$ cndnma, cndnmb, dista, distb )
349 *
350  CALL zlatms( n, m, dista, iseed, TYPE, rwork, modea,
351  \$ cndnma, anorm, kla, kua, 'No packing', a,
352  \$ lda, work, iinfo )
353  IF( iinfo.NE.0 ) THEN
354  WRITE( nout, fmt = 9999 )iinfo
355  info = abs( iinfo )
356  GO TO 30
357  END IF
358 *
359  CALL zlatms( n, p, distb, iseed, TYPE, rwork, modea,
360  \$ cndnma, bnorm, klb, kub, 'No packing', b,
361  \$ ldb, work, iinfo )
362  IF( iinfo.NE.0 ) THEN
363  WRITE( nout, fmt = 9999 )iinfo
364  info = abs( iinfo )
365  GO TO 30
366  END IF
367 *
368  nt = 4
369 *
370  CALL zgqrts( n, m, p, a, af, aq, ar, lda, taua, b, bf,
371  \$ bz, bt, bwk, ldb, taub, work, lwork,
372  \$ rwork, result )
373 *
374 * Print information about the tests that did not
375 * pass the threshold.
376 *
377  DO 20 i = 1, nt
378  IF( result( i ).GE.thresh ) THEN
379  IF( nfail.EQ.0 .AND. firstt ) THEN
380  firstt = .false.
381  CALL alahdg( nout, path )
382  END IF
383  WRITE( nout, fmt = 9997 )n, m, p, imat, i,
384  \$ result( i )
385  nfail = nfail + 1
386  END IF
387  20 CONTINUE
388  nrun = nrun + nt
389 *
390  30 CONTINUE
391  40 CONTINUE
392  50 CONTINUE
393  60 CONTINUE
394 *
395 * Print a summary of the results.
396 *
397  CALL alasum( path, nout, nfail, nrun, 0 )
398 *
399  9999 FORMAT( ' ZLATMS in ZCKGQR: INFO = ', i5 )
400  9998 FORMAT( ' M=', i4, ' P=', i4, ', N=', i4, ', type ', i2,
401  \$ ', test ', i2, ', ratio=', g13.6 )
402  9997 FORMAT( ' N=', i4, ' M=', i4, ', P=', i4, ', type ', i2,
403  \$ ', test ', i2, ', ratio=', g13.6 )
404  RETURN
405 *
406 * End of ZCKGQR
407 *
408  END
subroutine alareq(PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT)
ALAREQ
Definition: alareq.f:90
subroutine alahdg(IOUNIT, PATH)
ALAHDG
Definition: alahdg.f:62
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:73
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:176
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:176
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:211
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:332
subroutine dlatb9(PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB, ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB, DISTA, DISTB)
DLATB9
Definition: dlatb9.f:170