 LAPACK  3.10.1 LAPACK: Linear Algebra PACKage

## ◆ 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.```

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, dgeqrs, 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 DGEQRS 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  srnamt = 'DGEQRS'
410  CALL dgeqrs( m, n, nrhs, af, lda, tau, x,
411  \$ lda, work, lwork, info )
412 *
413 * Check error code from DGEQRS.
414 *
415  IF( info.NE.0 )
416  \$ CALL alaerh( path, 'DGEQRS', info, 0, ' ',
417  \$ m, n, nrhs, -1, nb, imat,
418  \$ nfail, nerrs, nout )
419 *
420  CALL dget02( 'No transpose', m, n, nrhs, a,
421  \$ lda, x, lda, b, lda, rwork,
422  \$ result( 7 ) )
423  nt = nt + 1
424  END IF
425  END IF
426 *
427 * Print information about the tests that did not
428 * pass the threshold.
429 *
430  DO 20 i = 1, ntests
431  IF( result( i ).GE.thresh ) THEN
432  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
433  \$ CALL alahd( nout, path )
434  WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
435  \$ imat, i, result( i )
436  nfail = nfail + 1
437  END IF
438  20 CONTINUE
439  nrun = nrun + ntests
440  30 CONTINUE
441  40 CONTINUE
442  50 CONTINUE
443  60 CONTINUE
444  70 CONTINUE
445 *
446 * Print a summary of the results.
447 *
448  CALL alasum( path, nout, nfail, nrun, nerrs )
449 *
450  9999 FORMAT( ' M=', i5, ', N=', i5, ', K=', i5, ', NB=', i4, ', NX=',
451  \$ i5, ', type ', i2, ', test(', i2, ')=', g12.5 )
452  RETURN
453 *
454 * End of DCHKQR
455 *
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
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:73
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:81
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:147
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 dget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DGET02
Definition: dget02.f:135
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
logical function dgennd(M, N, A, LDA)
DGENND
Definition: dgennd.f:68
subroutine dgeqrs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
DGEQRS
Definition: dgeqrs.f:121
subroutine dqrt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQRT03
Definition: dqrt03.f:136
subroutine dqrt02(M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQRT02
Definition: dqrt02.f:135
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
Definition: dlatb4.f:120
subroutine derrqr(PATH, NUNIT)
DERRQR
Definition: derrqr.f:55
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:321
Here is the call graph for this function:
Here is the caller graph for this function: