LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cckgqr.f
Go to the documentation of this file.
1*> \brief \b CCKGQR
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 CCKGQR( 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* REAL THRESH
18* ..
19* .. Array Arguments ..
20* INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
21* REAL RWORK( * )
22* COMPLEX 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*> CCKGQR tests
34*> CGGQRF: GQR factorization for N-by-M matrix A and N-by-P matrix B,
35*> CGGRQF: 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 REAL
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 array, dimension (NMAX*NMAX)
115*> \endverbatim
116*>
117*> \param[out] AF
118*> \verbatim
119*> AF is COMPLEX array, dimension (NMAX*NMAX)
120*> \endverbatim
121*>
122*> \param[out] AQ
123*> \verbatim
124*> AQ is COMPLEX array, dimension (NMAX*NMAX)
125*> \endverbatim
126*>
127*> \param[out] AR
128*> \verbatim
129*> AR is COMPLEX array, dimension (NMAX*NMAX)
130*> \endverbatim
131*>
132*> \param[out] TAUA
133*> \verbatim
134*> TAUA is COMPLEX array, dimension (NMAX)
135*> \endverbatim
136*>
137*> \param[out] B
138*> \verbatim
139*> B is COMPLEX array, dimension (NMAX*NMAX)
140*> \endverbatim
141*>
142*> \param[out] BF
143*> \verbatim
144*> BF is COMPLEX array, dimension (NMAX*NMAX)
145*> \endverbatim
146*>
147*> \param[out] BZ
148*> \verbatim
149*> BZ is COMPLEX array, dimension (NMAX*NMAX)
150*> \endverbatim
151*>
152*> \param[out] BT
153*> \verbatim
154*> BT is COMPLEX array, dimension (NMAX*NMAX)
155*> \endverbatim
156*>
157*> \param[out] BWK
158*> \verbatim
159*> BWK is COMPLEX array, dimension (NMAX*NMAX)
160*> \endverbatim
161*>
162*> \param[out] TAUB
163*> \verbatim
164*> TAUB is COMPLEX array, dimension (NMAX)
165*> \endverbatim
166*>
167*> \param[out] WORK
168*> \verbatim
169*> WORK is COMPLEX array, dimension (NMAX*NMAX)
170*> \endverbatim
171*>
172*> \param[out] RWORK
173*> \verbatim
174*> RWORK is REAL 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 CLATMS 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 complex_eig
206*
207* =====================================================================
208 SUBROUTINE cckgqr( 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 REAL THRESH
219* ..
220* .. Array Arguments ..
221 INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
222 REAL RWORK( * )
223 COMPLEX 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 REAL ANORM, BNORM, CNDNMA, CNDNMB
244* ..
245* .. Local Arrays ..
246 LOGICAL DOTYPE( NTYPES )
247 REAL RESULT( NTESTS )
248* ..
249* .. External Subroutines ..
250 EXTERNAL alahdg, alareq, alasum, cgqrts, cgrqts, clatms,
251 $ slatb9
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 CGGRQF
293*
294* Set up parameters with SLATB9 and generate test
295* matrices A and B with CLATMS.
296*
297 CALL slatb9( 'GRQ', imat, m, p, n, TYPE, kla, kua,
298 $ klb, kub, anorm, bnorm, modea, modeb,
299 $ cndnma, cndnmb, dista, distb )
300*
301 CALL clatms( 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 clatms( 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 cgrqts( 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 CGGQRF
342*
343* Set up parameters with SLATB9 and generate test
344* matrices A and B with CLATMS.
345*
346 CALL slatb9( 'GQR', imat, m, p, n, TYPE, kla, kua,
347 $ klb, kub, anorm, bnorm, modea, modeb,
348 $ cndnma, cndnmb, dista, distb )
349*
350 CALL clatms( 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 clatms( 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 cgqrts( 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( ' CLATMS in CCKGQR: 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 CCKGQR
407*
408 END
subroutine alareq(path, nmats, dotype, ntypes, nin, nout)
ALAREQ
Definition alareq.f:90
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
Definition alasum.f:73
subroutine alahdg(iounit, path)
ALAHDG
Definition alahdg.f:62
subroutine cckgqr(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)
CCKGQR
Definition cckgqr.f:211
subroutine cgqrts(n, m, p, a, af, q, r, lda, taua, b, bf, z, t, bwk, ldb, taub, work, lwork, rwork, result)
CGQRTS
Definition cgqrts.f:176
subroutine cgrqts(m, p, n, a, af, q, r, lda, taua, b, bf, z, t, bwk, ldb, taub, work, lwork, rwork, result)
CGRQTS
Definition cgrqts.f:176
subroutine clatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
CLATMS
Definition clatms.f:332
subroutine slatb9(path, imat, m, p, n, type, kla, kua, klb, kub, anorm, bnorm, modea, modeb, cndnma, cndnmb, dista, distb)
SLATB9
Definition slatb9.f:170