LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ dchkqr()

subroutine dchkqr ( logical, dimension( * )  dotype,
integer  nm,
integer, dimension( * )  mval,
integer  nn,
integer, dimension( * )  nval,
integer  nnb,
integer, dimension( * )  nbval,
integer, dimension( * )  nxval,
integer  nrhs,
double precision  thresh,
logical  tsterr,
integer  nmax,
double precision, dimension( * )  a,
double precision, dimension( * )  af,
double precision, dimension( * )  aq,
double precision, dimension( * )  ar,
double precision, dimension( * )  ac,
double precision, dimension( * )  b,
double precision, dimension( * )  x,
double precision, dimension( * )  xact,
double precision, dimension( * )  tau,
double precision, dimension( * )  work,
double precision, dimension( * )  rwork,
integer, dimension( * )  iwork,
integer  nout 
)

DCHKQR

Purpose:
 DCHKQR tests DGEQRF, DORGQR and DORMQR.
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NM
          NM is INTEGER
          The number of values of M contained in the vector MVAL.
[in]MVAL
          MVAL is INTEGER array, dimension (NM)
          The values of the matrix row dimension M.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix column dimension N.
[in]NNB
          NNB is INTEGER
          The number of values of NB and NX contained in the
          vectors NBVAL and NXVAL.  The blocking parameters are used
          in pairs (NB,NX).
[in]NBVAL
          NBVAL is INTEGER array, dimension (NNB)
          The values of the blocksize NB.
[in]NXVAL
          NXVAL is INTEGER array, dimension (NNB)
          The values of the crossover point NX.
[in]NRHS
          NRHS is INTEGER
          The number of right hand side vectors to be generated for
          each linear system.
[in]THRESH
          THRESH is DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[in]NMAX
          NMAX is INTEGER
          The maximum value permitted for M or N, used in dimensioning
          the work arrays.
[out]A
          A is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AF
          AF is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AQ
          AQ is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AR
          AR is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AC
          AC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]B
          B is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]X
          X is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]XACT
          XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]TAU
          TAU is DOUBLE PRECISION array, dimension (NMAX)
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension (NMAX)
[out]IWORK
          IWORK is INTEGER array, dimension (NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 198 of file dchkqr.f.

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,
248 $ dlacpy, dlarhs, dlatb4, dlatms, dqrt01,
249 $ dqrt01p, dqrt02, dqrt03, xlaenv
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*
alasum
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
Definition alasum.f:73
dget02
subroutine dget02(trans, m, n, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
DGET02
Definition dget02.f:135
dlarhs
subroutine dlarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
DLARHS
Definition dlarhs.f:205
xlaenv
subroutine xlaenv(ispec, nvalue)
XLAENV
Definition xlaenv.f:81
alaerh
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
Definition alaerh.f:147
alahd
subroutine alahd(iounit, path)
ALAHD
Definition alahd.f:107
derrqr
subroutine derrqr(path, nunit)
DERRQR
Definition derrqr.f:55
dgennd
logical function dgennd(m, n, a, lda)
DGENND
Definition dgennd.f:68
dlatb4
subroutine dlatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
DLATB4
Definition dlatb4.f:120
dlatms
subroutine dlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
DLATMS
Definition dlatms.f:321
dqrt01
subroutine dqrt01(m, n, a, af, q, r, lda, tau, work, lwork, rwork, result)
DQRT01
Definition dqrt01.f:126
dqrt01p
subroutine dqrt01p(m, n, a, af, q, r, lda, tau, work, lwork, rwork, result)
DQRT01P
Definition dqrt01p.f:126
dqrt02
subroutine dqrt02(m, n, k, a, af, q, r, lda, tau, work, lwork, rwork, result)
DQRT02
Definition dqrt02.f:135
dqrt03
subroutine dqrt03(m, n, k, af, c, cc, q, lda, tau, work, lwork, rwork, result)
DQRT03
Definition dqrt03.f:136
dgels
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
dlacpy
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
Here is the call graph for this function:
Here is the caller graph for this function: