LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ cchklq()

subroutine cchklq ( 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 
)

CCHKLQ

Purpose:
 CCHKLQ tests CGELQF, CUNGLQ and CUNMLQ.
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.

Definition at line 193 of file cchklq.f.

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