LAPACK  3.8.0 LAPACK: Linear Algebra PACKage

## ◆ cchkql()

 subroutine cchkql ( logical, dimension( * ) DOTYPE, integer NM, integer, dimension( * ) MVAL, integer NN, integer, dimension( * ) NVAL, integer NNB, integer, dimension( * ) NBVAL, integer, dimension( * ) NXVAL, integer NRHS, real THRESH, logical TSTERR, integer NMAX, complex, dimension( * ) A, complex, dimension( * ) AF, complex, dimension( * ) AQ, complex, dimension( * ) AL, complex, dimension( * ) AC, complex, dimension( * ) B, complex, dimension( * ) X, complex, dimension( * ) XACT, complex, dimension( * ) TAU, complex, dimension( * ) WORK, real, dimension( * ) RWORK, integer NOUT )

CCHKQL

Purpose:
` CCHKQL tests CGEQLF, CUNGQL and CUNMQL.`
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 REAL 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 array, dimension (NMAX*NMAX)` [out] AF ` AF is COMPLEX array, dimension (NMAX*NMAX)` [out] AQ ` AQ is COMPLEX array, dimension (NMAX*NMAX)` [out] AL ` AL is COMPLEX array, dimension (NMAX*NMAX)` [out] AC ` AC is COMPLEX array, dimension (NMAX*NMAX)` [out] B ` B is COMPLEX array, dimension (NMAX*NRHS)` [out] X ` X is COMPLEX array, dimension (NMAX*NRHS)` [out] XACT ` XACT is COMPLEX array, dimension (NMAX*NRHS)` [out] TAU ` TAU is COMPLEX array, dimension (NMAX)` [out] WORK ` WORK is COMPLEX array, dimension (NMAX*NMAX)` [out] RWORK ` RWORK is REAL array, dimension (NMAX)` [in] NOUT ``` NOUT is INTEGER The unit number for output.```
Date
December 2016

Definition at line 198 of file cchkql.f.

198 *
199 * -- LAPACK test routine (version 3.7.0) --
200 * -- LAPACK is a software package provided by Univ. of Tennessee, --
201 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
202 * December 2016
203 *
204 * .. Scalar Arguments ..
205  LOGICAL tsterr
206  INTEGER nm, nmax, nn, nnb, nout, nrhs
207  REAL thresh
208 * ..
209 * .. Array Arguments ..
210  LOGICAL dotype( * )
211  INTEGER mval( * ), nbval( * ), nval( * ),
212  \$ nxval( * )
213  REAL rwork( * )
214  COMPLEX a( * ), ac( * ), af( * ), al( * ), aq( * ),
215  \$ b( * ), tau( * ), work( * ), x( * ), xact( * )
216 * ..
217 *
218 * =====================================================================
219 *
220 * .. Parameters ..
221  INTEGER ntests
222  parameter( ntests = 7 )
223  INTEGER ntypes
224  parameter( ntypes = 8 )
225  REAL zero
226  parameter( zero = 0.0e0 )
227 * ..
228 * .. Local Scalars ..
229  CHARACTER dist, type
230  CHARACTER*3 path
231  INTEGER i, ik, im, imat, in, inb, info, k, kl, ku, lda,
232  \$ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
233  \$ nrun, nt, nx
234  REAL anorm, cndnum
235 * ..
236 * .. Local Arrays ..
237  INTEGER iseed( 4 ), iseedy( 4 ), kval( 4 )
238  REAL result( ntests )
239 * ..
240 * .. External Subroutines ..
241  EXTERNAL alaerh, alahd, alasum, cerrql, cgeqls, cget02,
243  \$ cqlt03, xlaenv
244 * ..
245 * .. Intrinsic Functions ..
246  INTRINSIC max, min
247 * ..
248 * .. Scalars in Common ..
249  LOGICAL lerr, ok
250  CHARACTER*32 srnamt
251  INTEGER infot, nunit
252 * ..
253 * .. Common blocks ..
254  COMMON / infoc / infot, nunit, ok, lerr
255  COMMON / srnamc / srnamt
256 * ..
257 * .. Data statements ..
258  DATA iseedy / 1988, 1989, 1990, 1991 /
259 * ..
260 * .. Executable Statements ..
261 *
262 * Initialize constants and the random number seed.
263 *
264  path( 1: 1 ) = 'Complex precision'
265  path( 2: 3 ) = 'QL'
266  nrun = 0
267  nfail = 0
268  nerrs = 0
269  DO 10 i = 1, 4
270  iseed( i ) = iseedy( i )
271  10 CONTINUE
272 *
273 * Test the error exits
274 *
275  IF( tsterr )
276  \$ CALL cerrql( path, nout )
277  infot = 0
278  CALL xlaenv( 2, 2 )
279 *
280  lda = nmax
281  lwork = nmax*max( nmax, nrhs )
282 *
283 * Do for each value of M in MVAL.
284 *
285  DO 70 im = 1, nm
286  m = mval( im )
287 *
288 * Do for each value of N in NVAL.
289 *
290  DO 60 in = 1, nn
291  n = nval( in )
292  minmn = min( m, n )
293  DO 50 imat = 1, ntypes
294 *
295 * Do the tests only if DOTYPE( IMAT ) is true.
296 *
297  IF( .NOT.dotype( imat ) )
298  \$ GO TO 50
299 *
300 * Set up parameters with CLATB4 and generate a test matrix
301 * with CLATMS.
302 *
303  CALL clatb4( path, imat, m, n, TYPE, kl, ku, anorm, mode,
304  \$ cndnum, dist )
305 *
306  srnamt = 'CLATMS'
307  CALL clatms( m, n, dist, iseed, TYPE, rwork, mode,
308  \$ cndnum, anorm, kl, ku, 'No packing', a, lda,
309  \$ work, info )
310 *
311 * Check error code from CLATMS.
312 *
313  IF( info.NE.0 ) THEN
314  CALL alaerh( path, 'CLATMS', info, 0, ' ', m, n, -1,
315  \$ -1, -1, imat, nfail, nerrs, nout )
316  GO TO 50
317  END IF
318 *
319 * Set some values for K: the first value must be MINMN,
320 * corresponding to the call of CQLT01; other values are
321 * used in the calls of CQLT02, and must not exceed MINMN.
322 *
323  kval( 1 ) = minmn
324  kval( 2 ) = 0
325  kval( 3 ) = 1
326  kval( 4 ) = minmn / 2
327  IF( minmn.EQ.0 ) THEN
328  nk = 1
329  ELSE IF( minmn.EQ.1 ) THEN
330  nk = 2
331  ELSE IF( minmn.LE.3 ) THEN
332  nk = 3
333  ELSE
334  nk = 4
335  END IF
336 *
337 * Do for each value of K in KVAL
338 *
339  DO 40 ik = 1, nk
340  k = kval( ik )
341 *
342 * Do for each pair of values (NB,NX) in NBVAL and NXVAL.
343 *
344  DO 30 inb = 1, nnb
345  nb = nbval( inb )
346  CALL xlaenv( 1, nb )
347  nx = nxval( inb )
348  CALL xlaenv( 3, nx )
349  DO i = 1, ntests
350  result( i ) = zero
351  END DO
352  nt = 2
353  IF( ik.EQ.1 ) THEN
354 *
355 * Test CGEQLF
356 *
357  CALL cqlt01( m, n, a, af, aq, al, lda, tau,
358  \$ work, lwork, rwork, result( 1 ) )
359  ELSE IF( m.GE.n ) THEN
360 *
361 * Test CUNGQL, using factorization
362 * returned by CQLT01
363 *
364  CALL cqlt02( m, n, k, a, af, aq, al, lda, tau,
365  \$ work, lwork, rwork, result( 1 ) )
366  END IF
367  IF( m.GE.k ) THEN
368 *
369 * Test CUNMQL, using factorization returned
370 * by CQLT01
371 *
372  CALL cqlt03( m, n, k, af, ac, al, aq, lda, tau,
373  \$ work, lwork, rwork, result( 3 ) )
374  nt = nt + 4
375 *
376 * If M>=N and K=N, call CGEQLS to solve a system
377 * with NRHS right hand sides and compute the
378 * residual.
379 *
380  IF( k.EQ.n .AND. inb.EQ.1 ) THEN
381 *
382 * Generate a solution and set the right
383 * hand side.
384 *
385  srnamt = 'CLARHS'
386  CALL clarhs( path, 'New', 'Full',
387  \$ 'No transpose', m, n, 0, 0,
388  \$ nrhs, a, lda, xact, lda, b, lda,
389  \$ iseed, info )
390 *
391  CALL clacpy( 'Full', m, nrhs, b, lda, x,
392  \$ lda )
393  srnamt = 'CGEQLS'
394  CALL cgeqls( m, n, nrhs, af, lda, tau, x,
395  \$ lda, work, lwork, info )
396 *
397 * Check error code from CGEQLS.
398 *
399  IF( info.NE.0 )
400  \$ CALL alaerh( path, 'CGEQLS', info, 0, ' ',
401  \$ m, n, nrhs, -1, nb, imat,
402  \$ nfail, nerrs, nout )
403 *
404  CALL cget02( 'No transpose', m, n, nrhs, a,
405  \$ lda, x( m-n+1 ), lda, b, lda,
406  \$ rwork, result( 7 ) )
407  nt = nt + 1
408  END IF
409  END IF
410 *
411 * Print information about the tests that did not
412 * pass the threshold.
413 *
414  DO 20 i = 1, nt
415  IF( result( i ).GE.thresh ) THEN
416  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
417  \$ CALL alahd( nout, path )
418  WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
419  \$ imat, i, result( i )
420  nfail = nfail + 1
421  END IF
422  20 CONTINUE
423  nrun = nrun + nt
424  30 CONTINUE
425  40 CONTINUE
426  50 CONTINUE
427  60 CONTINUE
428  70 CONTINUE
429 *
430 * Print a summary of the results.
431 *
432  CALL alasum( path, nout, nfail, nrun, nerrs )
433 *
434  9999 FORMAT( ' M=', i5, ', N=', i5, ', K=', i5, ', NB=', i4, ', NX=',
435  \$ i5, ', type ', i2, ', test(', i2, ')=', g12.5 )
436  RETURN
437 *
438 * End of CCHKQL
439 *
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:149
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine cgeqls(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
CGEQLS
Definition: cgeqls.f:124
subroutine cget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CGET02
Definition: cget02.f:135
subroutine cerrql(PATH, NUNIT)
CERRQL
Definition: cerrql.f:57
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine cqlt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQLT01
Definition: cqlt01.f:128
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
subroutine cqlt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQLT03
Definition: cqlt03.f:138
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
Definition: clarhs.f:211
subroutine cqlt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQLT02
Definition: cqlt02.f:138
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
Here is the call graph for this function:
Here is the caller graph for this function: