LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 198 of file cchkql.f.

198 *
199 * -- LAPACK test routine (version 3.4.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 * November 2011
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,
242  $ clacpy, clarhs, clatb4, clatms, cqlt01, cqlt02,
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 *
cqlt02
subroutine cqlt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQLT02
Definition: cqlt02.f:138
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
clarhs
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
Definition: clarhs.f:211
cgeqls
subroutine cgeqls(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
CGEQLS
Definition: cgeqls.f:124
cqlt01
subroutine cqlt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQLT01
Definition: cqlt01.f:128
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
cerrql
subroutine cerrql(PATH, NUNIT)
CERRQL
Definition: cerrql.f:57
cget02
subroutine cget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CGET02
Definition: cget02.f:135
clatms
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
cqlt03
subroutine cqlt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQLT03
Definition: cqlt03.f:138
clacpy
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
clatb4
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75

Here is the call graph for this function:

Here is the caller graph for this function: