LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ zchkqr()

subroutine zchkqr ( 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,
complex*16, dimension( * )  A,
complex*16, dimension( * )  AF,
complex*16, dimension( * )  AQ,
complex*16, dimension( * )  AR,
complex*16, dimension( * )  AC,
complex*16, dimension( * )  B,
complex*16, dimension( * )  X,
complex*16, dimension( * )  XACT,
complex*16, dimension( * )  TAU,
complex*16, dimension( * )  WORK,
double precision, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

ZCHKQR

Purpose:
 ZCHKQR tests ZGEQRF, ZUNGQR and ZUNMQR.
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 COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AF
          AF is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AQ
          AQ is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AR
          AR is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AC
          AC is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX*16 array, dimension (NMAX*NRHS)
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NRHS)
[out]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
[out]TAU
          TAU is COMPLEX*16 array, dimension (NMAX)
[out]WORK
          WORK is COMPLEX*16 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 zchkqr.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 RWORK( * )
216  COMPLEX*16 A( * ), AC( * ), AF( * ), AQ( * ), AR( * ),
217  $ B( * ), TAU( * ), WORK( * ), 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 ZGENND
244  EXTERNAL zgennd
245 * ..
246 * .. External Subroutines ..
247  EXTERNAL alaerh, alahd, alasum, xlaenv, zerrqr, zgeqrs,
249  $ zqrt01p, zqrt02, zqrt03
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 ) = 'Zomplex 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 zerrqr( 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 ZLATB4 and generate a test matrix
307 * with ZLATMS.
308 *
309  CALL zlatb4( path, imat, m, n, TYPE, KL, KU, ANORM, MODE,
310  $ CNDNUM, DIST )
311 *
312  srnamt = 'ZLATMS'
313  CALL zlatms( 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 ZLATMS.
318 *
319  IF( info.NE.0 ) THEN
320  CALL alaerh( path, 'ZLATMS', 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 ZQRT01; other values are
327 * used in the calls of ZQRT02, 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 ZGEQRF
362 *
363  CALL zqrt01( m, n, a, af, aq, ar, lda, tau,
364  $ work, lwork, rwork, result( 1 ) )
365 *
366 * Test ZGEQRFP
367 *
368  CALL zqrt01p( m, n, a, af, aq, ar, lda, tau,
369  $ work, lwork, rwork, result( 8 ) )
370 
371  IF( .NOT. zgennd( m, n, af, lda ) )
372  $ result( 9 ) = 2*thresh
373  nt = nt + 1
374  ELSE IF( m.GE.n ) THEN
375 *
376 * Test ZUNGQR, using factorization
377 * returned by ZQRT01
378 *
379  CALL zqrt02( m, n, k, a, af, aq, ar, lda, tau,
380  $ work, lwork, rwork, result( 1 ) )
381  END IF
382  IF( m.GE.k ) THEN
383 *
384 * Test ZUNMQR, using factorization returned
385 * by ZQRT01
386 *
387  CALL zqrt03( m, n, k, af, ac, ar, aq, lda, tau,
388  $ work, lwork, rwork, result( 3 ) )
389  nt = nt + 4
390 *
391 * If M>=N and K=N, call ZGEQRS to solve a system
392 * with NRHS right hand sides and compute the
393 * residual.
394 *
395  IF( k.EQ.n .AND. inb.EQ.1 ) THEN
396 *
397 * Generate a solution and set the right
398 * hand side.
399 *
400  srnamt = 'ZLARHS'
401  CALL zlarhs( path, 'New', 'Full',
402  $ 'No transpose', m, n, 0, 0,
403  $ nrhs, a, lda, xact, lda, b, lda,
404  $ iseed, info )
405 *
406  CALL zlacpy( 'Full', m, nrhs, b, lda, x,
407  $ lda )
408  srnamt = 'ZGEQRS'
409  CALL zgeqrs( m, n, nrhs, af, lda, tau, x,
410  $ lda, work, lwork, info )
411 *
412 * Check error code from ZGEQRS.
413 *
414  IF( info.NE.0 )
415  $ CALL alaerh( path, 'ZGEQRS', info, 0, ' ',
416  $ m, n, nrhs, -1, nb, imat,
417  $ nfail, nerrs, nout )
418 *
419  CALL zget02( 'No transpose', m, n, nrhs, a,
420  $ lda, x, lda, b, lda, rwork,
421  $ result( 7 ) )
422  nt = nt + 1
423  END IF
424  END IF
425 *
426 * Print information about the tests that did not
427 * pass the threshold.
428 *
429  DO 20 i = 1, ntests
430  IF( result( i ).GE.thresh ) THEN
431  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
432  $ CALL alahd( nout, path )
433  WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
434  $ imat, i, result( i )
435  nfail = nfail + 1
436  END IF
437  20 CONTINUE
438  nrun = nrun + ntests
439  30 CONTINUE
440  40 CONTINUE
441  50 CONTINUE
442  60 CONTINUE
443  70 CONTINUE
444 *
445 * Print a summary of the results.
446 *
447  CALL alasum( path, nout, nfail, nrun, nerrs )
448 *
449  9999 FORMAT( ' M=', i5, ', N=', i5, ', K=', i5, ', NB=', i4, ', NX=',
450  $ i5, ', type ', i2, ', test(', i2, ')=', g12.5 )
451  RETURN
452 *
453 * End of ZCHKQR
454 *
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 zget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZGET02
Definition: zget02.f:134
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:208
subroutine zqrt02(M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZQRT02
Definition: zqrt02.f:135
subroutine zqrt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZQRT03
Definition: zqrt03.f:136
subroutine zqrt01(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZQRT01
Definition: zqrt01.f:126
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:121
logical function zgennd(M, N, A, LDA)
ZGENND
Definition: zgennd.f:68
subroutine zgeqrs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
ZGEQRS
Definition: zgeqrs.f:121
subroutine zqrt01p(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZQRT01P
Definition: zqrt01p.f:126
subroutine zerrqr(PATH, NUNIT)
ZERRQR
Definition: zerrqr.f:55
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:332
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:103
Here is the call graph for this function:
Here is the caller graph for this function: