LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches
dchkqr.f
Go to the documentation of this file.
1*> \brief \b DCHKQR
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 DCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
12* NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AR, AC,
13* B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT )
14*
15* .. Scalar Arguments ..
16* LOGICAL TSTERR
17* INTEGER NM, NMAX, NN, NNB, NOUT, NRHS
18* DOUBLE PRECISION THRESH
19* ..
20* .. Array Arguments ..
21* LOGICAL DOTYPE( * )
22* INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
23* \$ NXVAL( * )
24* DOUBLE PRECISION A( * ), AC( * ), AF( * ), AQ( * ), AR( * ),
25* \$ B( * ), RWORK( * ), TAU( * ), WORK( * ),
26* \$ X( * ), XACT( * )
27* ..
28*
29*
30*> \par Purpose:
31* =============
32*>
33*> \verbatim
34*>
35*> DCHKQR tests DGEQRF, DORGQR and DORMQR.
36*> \endverbatim
37*
38* Arguments:
39* ==========
40*
41*> \param[in] DOTYPE
42*> \verbatim
43*> DOTYPE is LOGICAL array, dimension (NTYPES)
44*> The matrix types to be used for testing. Matrices of type j
45*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
46*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
47*> \endverbatim
48*>
49*> \param[in] NM
50*> \verbatim
51*> NM is INTEGER
52*> The number of values of M contained in the vector MVAL.
53*> \endverbatim
54*>
55*> \param[in] MVAL
56*> \verbatim
57*> MVAL is INTEGER array, dimension (NM)
58*> The values of the matrix row dimension M.
59*> \endverbatim
60*>
61*> \param[in] NN
62*> \verbatim
63*> NN is INTEGER
64*> The number of values of N contained in the vector NVAL.
65*> \endverbatim
66*>
67*> \param[in] NVAL
68*> \verbatim
69*> NVAL is INTEGER array, dimension (NN)
70*> The values of the matrix column dimension N.
71*> \endverbatim
72*>
73*> \param[in] NNB
74*> \verbatim
75*> NNB is INTEGER
76*> The number of values of NB and NX contained in the
77*> vectors NBVAL and NXVAL. The blocking parameters are used
78*> in pairs (NB,NX).
79*> \endverbatim
80*>
81*> \param[in] NBVAL
82*> \verbatim
83*> NBVAL is INTEGER array, dimension (NNB)
84*> The values of the blocksize NB.
85*> \endverbatim
86*>
87*> \param[in] NXVAL
88*> \verbatim
89*> NXVAL is INTEGER array, dimension (NNB)
90*> The values of the crossover point NX.
91*> \endverbatim
92*>
93*> \param[in] NRHS
94*> \verbatim
95*> NRHS is INTEGER
96*> The number of right hand side vectors to be generated for
97*> each linear system.
98*> \endverbatim
99*>
100*> \param[in] THRESH
101*> \verbatim
102*> THRESH is DOUBLE PRECISION
103*> The threshold value for the test ratios. A result is
104*> included in the output file if RESULT >= THRESH. To have
105*> every test ratio printed, use THRESH = 0.
106*> \endverbatim
107*>
108*> \param[in] TSTERR
109*> \verbatim
110*> TSTERR is LOGICAL
111*> Flag that indicates whether error exits are to be tested.
112*> \endverbatim
113*>
114*> \param[in] NMAX
115*> \verbatim
116*> NMAX is INTEGER
117*> The maximum value permitted for M or N, used in dimensioning
118*> the work arrays.
119*> \endverbatim
120*>
121*> \param[out] A
122*> \verbatim
123*> A is DOUBLE PRECISION array, dimension (NMAX*NMAX)
124*> \endverbatim
125*>
126*> \param[out] AF
127*> \verbatim
128*> AF is DOUBLE PRECISION array, dimension (NMAX*NMAX)
129*> \endverbatim
130*>
131*> \param[out] AQ
132*> \verbatim
133*> AQ is DOUBLE PRECISION array, dimension (NMAX*NMAX)
134*> \endverbatim
135*>
136*> \param[out] AR
137*> \verbatim
138*> AR is DOUBLE PRECISION array, dimension (NMAX*NMAX)
139*> \endverbatim
140*>
141*> \param[out] AC
142*> \verbatim
143*> AC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
144*> \endverbatim
145*>
146*> \param[out] B
147*> \verbatim
148*> B is DOUBLE PRECISION array, dimension (NMAX*NRHS)
149*> \endverbatim
150*>
151*> \param[out] X
152*> \verbatim
153*> X is DOUBLE PRECISION array, dimension (NMAX*NRHS)
154*> \endverbatim
155*>
156*> \param[out] XACT
157*> \verbatim
158*> XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS)
159*> \endverbatim
160*>
161*> \param[out] TAU
162*> \verbatim
163*> TAU is DOUBLE PRECISION array, dimension (NMAX)
164*> \endverbatim
165*>
166*> \param[out] WORK
167*> \verbatim
168*> WORK is DOUBLE PRECISION array, dimension (NMAX*NMAX)
169*> \endverbatim
170*>
171*> \param[out] RWORK
172*> \verbatim
173*> RWORK is DOUBLE PRECISION array, dimension (NMAX)
174*> \endverbatim
175*>
176*> \param[out] IWORK
177*> \verbatim
178*> IWORK is INTEGER array, dimension (NMAX)
179*> \endverbatim
180*>
181*> \param[in] NOUT
182*> \verbatim
183*> NOUT is INTEGER
184*> The unit number for output.
185*> \endverbatim
186*
187* Authors:
188* ========
189*
190*> \author Univ. of Tennessee
191*> \author Univ. of California Berkeley
192*> \author Univ. of Colorado Denver
193*> \author NAG Ltd.
194*
195*> \ingroup double_lin
196*
197* =====================================================================
198 SUBROUTINE dchkqr( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
199 \$ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AR, AC,
200 \$ B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT )
201*
202* -- LAPACK test routine --
203* -- LAPACK is a software package provided by Univ. of Tennessee, --
204* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
205*
206* .. Scalar Arguments ..
207 LOGICAL TSTERR
208 INTEGER NM, NMAX, NN, NNB, NOUT, NRHS
209 DOUBLE PRECISION THRESH
210* ..
211* .. Array Arguments ..
212 LOGICAL DOTYPE( * )
213 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
214 \$ nxval( * )
215 DOUBLE PRECISION A( * ), AC( * ), AF( * ), AQ( * ), AR( * ),
216 \$ B( * ), RWORK( * ), TAU( * ), WORK( * ),
217 \$ x( * ), xact( * )
218* ..
219*
220* =====================================================================
221*
222* .. Parameters ..
223 INTEGER NTESTS
224 PARAMETER ( NTESTS = 9 )
225 INTEGER NTYPES
226 parameter( ntypes = 8 )
227 DOUBLE PRECISION ZERO
228 parameter( zero = 0.0d0 )
229* ..
230* .. Local Scalars ..
231 CHARACTER DIST, TYPE
232 CHARACTER*3 PATH
233 INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA,
234 \$ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
235 \$ nrun, nt, nx
236 DOUBLE PRECISION ANORM, CNDNUM
237* ..
238* .. Local Arrays ..
239 INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 )
240 DOUBLE PRECISION RESULT( NTESTS )
241* ..
242* .. External Functions ..
243 LOGICAL DGENND
244 EXTERNAL DGENND
245* ..
246* .. External Subroutines ..
247 EXTERNAL alaerh, alahd, alasum, derrqr, dgels, dget02,
250* ..
251* .. Intrinsic Functions ..
252 INTRINSIC max, min
253* ..
254* .. Scalars in Common ..
255 LOGICAL LERR, OK
256 CHARACTER*32 SRNAMT
257 INTEGER INFOT, NUNIT
258* ..
259* .. Common blocks ..
260 COMMON / infoc / infot, nunit, ok, lerr
261 COMMON / srnamc / srnamt
262* ..
263* .. Data statements ..
264 DATA iseedy / 1988, 1989, 1990, 1991 /
265* ..
266* .. Executable Statements ..
267*
268* Initialize constants and the random number seed.
269*
270 path( 1: 1 ) = 'Double precision'
271 path( 2: 3 ) = 'QR'
272 nrun = 0
273 nfail = 0
274 nerrs = 0
275 DO 10 i = 1, 4
276 iseed( i ) = iseedy( i )
277 10 CONTINUE
278*
279* Test the error exits
280*
281 IF( tsterr )
282 \$ CALL derrqr( path, nout )
283 infot = 0
284 CALL xlaenv( 2, 2 )
285*
286 lda = nmax
287 lwork = nmax*max( nmax, nrhs )
288*
289* Do for each value of M in MVAL.
290*
291 DO 70 im = 1, nm
292 m = mval( im )
293*
294* Do for each value of N in NVAL.
295*
296 DO 60 in = 1, nn
297 n = nval( in )
298 minmn = min( m, n )
299 DO 50 imat = 1, ntypes
300*
301* Do the tests only if DOTYPE( IMAT ) is true.
302*
303 IF( .NOT.dotype( imat ) )
304 \$ GO TO 50
305*
306* Set up parameters with DLATB4 and generate a test matrix
307* with DLATMS.
308*
309 CALL dlatb4( path, imat, m, n, TYPE, kl, ku, anorm, mode,
310 \$ cndnum, dist )
311*
312 srnamt = 'DLATMS'
313 CALL dlatms( m, n, dist, iseed, TYPE, rwork, mode,
314 \$ cndnum, anorm, kl, ku, 'No packing', a, lda,
315 \$ work, info )
316*
317* Check error code from DLATMS.
318*
319 IF( info.NE.0 ) THEN
320 CALL alaerh( path, 'DLATMS', info, 0, ' ', m, n, -1,
321 \$ -1, -1, imat, nfail, nerrs, nout )
322 GO TO 50
323 END IF
324*
325* Set some values for K: the first value must be MINMN,
326* corresponding to the call of DQRT01; other values are
327* used in the calls of DQRT02, and must not exceed MINMN.
328*
329 kval( 1 ) = minmn
330 kval( 2 ) = 0
331 kval( 3 ) = 1
332 kval( 4 ) = minmn / 2
333 IF( minmn.EQ.0 ) THEN
334 nk = 1
335 ELSE IF( minmn.EQ.1 ) THEN
336 nk = 2
337 ELSE IF( minmn.LE.3 ) THEN
338 nk = 3
339 ELSE
340 nk = 4
341 END IF
342*
343* Do for each value of K in KVAL
344*
345 DO 40 ik = 1, nk
346 k = kval( ik )
347*
348* Do for each pair of values (NB,NX) in NBVAL and NXVAL.
349*
350 DO 30 inb = 1, nnb
351 nb = nbval( inb )
352 CALL xlaenv( 1, nb )
353 nx = nxval( inb )
354 CALL xlaenv( 3, nx )
355 DO i = 1, ntests
356 result( i ) = zero
357 END DO
358 nt = 2
359 IF( ik.EQ.1 ) THEN
360*
361* Test DGEQRF
362*
363 CALL dqrt01( m, n, a, af, aq, ar, lda, tau,
364 \$ work, lwork, rwork, result( 1 ) )
365
366*
367* Test DGEQRFP
368*
369 CALL dqrt01p( m, n, a, af, aq, ar, lda, tau,
370 \$ work, lwork, rwork, result( 8 ) )
371
372 IF( .NOT. dgennd( m, n, af, lda ) )
373 \$ result( 9 ) = 2*thresh
374 nt = nt + 1
375 ELSE IF( m.GE.n ) THEN
376*
377* Test DORGQR, using factorization
378* returned by DQRT01
379*
380 CALL dqrt02( m, n, k, a, af, aq, ar, lda, tau,
381 \$ work, lwork, rwork, result( 1 ) )
382 END IF
383 IF( m.GE.k ) THEN
384*
385* Test DORMQR, using factorization returned
386* by DQRT01
387*
388 CALL dqrt03( m, n, k, af, ac, ar, aq, lda, tau,
389 \$ work, lwork, rwork, result( 3 ) )
390 nt = nt + 4
391*
392* If M>=N and K=N, call DGELS to solve a system
393* with NRHS right hand sides and compute the
394* residual.
395*
396 IF( k.EQ.n .AND. inb.EQ.1 ) THEN
397*
398* Generate a solution and set the right
399* hand side.
400*
401 srnamt = 'DLARHS'
402 CALL dlarhs( path, 'New', 'Full',
403 \$ 'No transpose', m, n, 0, 0,
404 \$ nrhs, a, lda, xact, lda, b, lda,
405 \$ iseed, info )
406*
407 CALL dlacpy( 'Full', m, nrhs, b, lda, x,
408 \$ lda )
409*
410* Reset AF. DGELS overwrites the matrix with
411* its factorization.
412*
413 CALL dlacpy( 'Full', m, n, a, lda, af, lda )
414*
415 srnamt = 'DGELS'
416 CALL dgels( 'No transpose', m, n, nrhs, af,
417 \$ lda, x, lda, work, lwork, info )
418*
419* Check error code from DGELS.
420*
421 IF( info.NE.0 )
422 \$ CALL alaerh( path, 'DGELS', info, 0, 'N',
423 \$ m, n, nrhs, -1, nb, imat,
424 \$ nfail, nerrs, nout )
425*
426 CALL dget02( 'No transpose', m, n, nrhs, a,
427 \$ lda, x, lda, b, lda, rwork,
428 \$ result( 7 ) )
429 nt = nt + 1
430 END IF
431 END IF
432*
433* Print information about the tests that did not
434* pass the threshold.
435*
436 DO 20 i = 1, ntests
437 IF( result( i ).GE.thresh ) THEN
438 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
439 \$ CALL alahd( nout, path )
440 WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
441 \$ imat, i, result( i )
442 nfail = nfail + 1
443 END IF
444 20 CONTINUE
445 nrun = nrun + ntests
446 30 CONTINUE
447 40 CONTINUE
448 50 CONTINUE
449 60 CONTINUE
450 70 CONTINUE
451*
452* Print a summary of the results.
453*
454 CALL alasum( path, nout, nfail, nrun, nerrs )
455*
456 9999 FORMAT( ' M=', i5, ', N=', i5, ', K=', i5, ', NB=', i4, ', NX=',
457 \$ i5, ', type ', i2, ', test(', i2, ')=', g12.5 )
458 RETURN
459*
460* End of DCHKQR
461*
462 END
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
Definition alasum.f:73
subroutine dget02(trans, m, n, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
DGET02
Definition dget02.f:135
subroutine dlarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
DLARHS
Definition dlarhs.f:205
subroutine xlaenv(ispec, nvalue)
XLAENV
Definition xlaenv.f:81
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
Definition alaerh.f:147
subroutine alahd(iounit, path)
ALAHD
Definition alahd.f:107
subroutine dchkqr(dotype, nm, mval, nn, nval, nnb, nbval, nxval, nrhs, thresh, tsterr, nmax, a, af, aq, ar, ac, b, x, xact, tau, work, rwork, iwork, nout)
DCHKQR
Definition dchkqr.f:201
subroutine derrqr(path, nunit)
DERRQR
Definition derrqr.f:55
subroutine dlatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
DLATB4
Definition dlatb4.f:120
subroutine dlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
DLATMS
Definition dlatms.f:321
subroutine dqrt01(m, n, a, af, q, r, lda, tau, work, lwork, rwork, result)
DQRT01
Definition dqrt01.f:126
subroutine dqrt01p(m, n, a, af, q, r, lda, tau, work, lwork, rwork, result)
DQRT01P
Definition dqrt01p.f:126
subroutine dqrt02(m, n, k, a, af, q, r, lda, tau, work, lwork, rwork, result)
DQRT02
Definition dqrt02.f:135
subroutine dqrt03(m, n, k, af, c, cc, q, lda, tau, work, lwork, rwork, result)
DQRT03
Definition dqrt03.f:136
subroutine dgels(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
DGELS solves overdetermined or underdetermined systems for GE matrices
Definition dgels.f:183
subroutine dlacpy(uplo, m, n, a, lda, b, ldb)
DLACPY copies all or part of one two-dimensional array to another.
Definition dlacpy.f:103