OpenRadioss 2025.1.11
OpenRadioss project
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.NE. IF( IINFO0 ) 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.NE. IF( IINFO0 ) 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.GE. IF( RESULT( I )THRESH ) THEN
330.EQ..AND. IF( NFAIL0 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.NE. IF( IINFO0 ) 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.NE. IF( IINFO0 ) 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.GE. IF( RESULT( I )THRESH ) THEN
379.EQ..AND. IF( NFAIL0 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
alahdg
subroutine alahdg(iounit, path)
ALAHDG
Definition alahdg.f:62
alasum
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
Definition alasum.f:73
alareq
subroutine alareq(path, nmats, dotype, ntypes, nin, nout)
ALAREQ
Definition alareq.f:90
cgqrts
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
cgrqts
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
cckgqr
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
clatms
subroutine clatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
CLATMS
Definition clatms.f:332
slatb9
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