LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ cchkge()

subroutine cchkge ( logical, dimension( * )  DOTYPE,
integer  NM,
integer, dimension( * )  MVAL,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
real  THRESH,
logical  TSTERR,
integer  NMAX,
complex, dimension( * )  A,
complex, dimension( * )  AFAC,
complex, dimension( * )  AINV,
complex, dimension( * )  B,
complex, dimension( * )  X,
complex, dimension( * )  XACT,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

CCHKGE

Purpose:
 CCHKGE tests CGETRF, -TRI, -TRS, -RFS, and -CON.
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 contained in the vector NBVAL.
[in]NBVAL
          NBVAL is INTEGER array, dimension (NBVAL)
          The values of the blocksize NB.
[in]NNS
          NNS is INTEGER
          The number of values of NRHS contained in the vector NSVAL.
[in]NSVAL
          NSVAL is INTEGER array, dimension (NNS)
          The values of the number of right hand sides NRHS.
[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]AFAC
          AFAC is COMPLEX array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is REAL array, dimension
                      (max(2*NMAX,2*NSMAX+NWORK))
[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.
Date
December 2016

Definition at line 188 of file cchkge.f.

188 *
189 * -- LAPACK test routine (version 3.7.0) --
190 * -- LAPACK is a software package provided by Univ. of Tennessee, --
191 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
192 * December 2016
193 *
194 * .. Scalar Arguments ..
195  LOGICAL TSTERR
196  INTEGER NM, NMAX, NN, NNB, NNS, NOUT
197  REAL THRESH
198 * ..
199 * .. Array Arguments ..
200  LOGICAL DOTYPE( * )
201  INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
202  $ NVAL( * )
203  REAL RWORK( * )
204  COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
205  $ WORK( * ), X( * ), XACT( * )
206 * ..
207 *
208 * =====================================================================
209 *
210 * .. Parameters ..
211  REAL ONE, ZERO
212  parameter( one = 1.0e+0, zero = 0.0e+0 )
213  INTEGER NTYPES
214  parameter( ntypes = 11 )
215  INTEGER NTESTS
216  parameter( ntests = 8 )
217  INTEGER NTRAN
218  parameter( ntran = 3 )
219 * ..
220 * .. Local Scalars ..
221  LOGICAL TRFCON, ZEROT
222  CHARACTER DIST, NORM, TRANS, TYPE, XTYPE
223  CHARACTER*3 PATH
224  INTEGER I, IM, IMAT, IN, INB, INFO, IOFF, IRHS, ITRAN,
225  $ IZERO, K, KL, KU, LDA, LWORK, M, MODE, N, NB,
226  $ NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
227  REAL AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, DUMMY,
228  $ RCOND, RCONDC, RCONDI, RCONDO
229 * ..
230 * .. Local Arrays ..
231  CHARACTER TRANSS( NTRAN )
232  INTEGER ISEED( 4 ), ISEEDY( 4 )
233  REAL RESULT( NTESTS )
234 * ..
235 * .. External Functions ..
236  REAL CLANGE, SGET06
237  EXTERNAL clange, sget06
238 * ..
239 * .. External Subroutines ..
240  EXTERNAL alaerh, alahd, alasum, cerrge, cgecon, cgerfs,
241  $ cget01, cget02, cget03, cget04, cget07, cgetrf,
242  $ cgetri, cgetrs, clacpy, clarhs, claset, clatb4,
243  $ clatms, xlaenv
244 * ..
245 * .. Intrinsic Functions ..
246  INTRINSIC cmplx, 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  $ transs / 'N', 'T', 'C' /
260 * ..
261 * .. Executable Statements ..
262 *
263 * Initialize constants and the random number seed.
264 *
265  path( 1: 1 ) = 'Complex precision'
266  path( 2: 3 ) = 'GE'
267  nrun = 0
268  nfail = 0
269  nerrs = 0
270  DO 10 i = 1, 4
271  iseed( i ) = iseedy( i )
272  10 CONTINUE
273 *
274 * Test the error exits
275 *
276  CALL xlaenv( 1, 1 )
277  IF( tsterr )
278  $ CALL cerrge( path, nout )
279  infot = 0
280  CALL xlaenv( 2, 2 )
281 *
282 * Do for each value of M in MVAL
283 *
284  DO 120 im = 1, nm
285  m = mval( im )
286  lda = max( 1, m )
287 *
288 * Do for each value of N in NVAL
289 *
290  DO 110 in = 1, nn
291  n = nval( in )
292  xtype = 'N'
293  nimat = ntypes
294  IF( m.LE.0 .OR. n.LE.0 )
295  $ nimat = 1
296 *
297  DO 100 imat = 1, nimat
298 *
299 * Do the tests only if DOTYPE( IMAT ) is true.
300 *
301  IF( .NOT.dotype( imat ) )
302  $ GO TO 100
303 *
304 * Skip types 5, 6, or 7 if the matrix size is too small.
305 *
306  zerot = imat.GE.5 .AND. imat.LE.7
307  IF( zerot .AND. n.LT.imat-4 )
308  $ GO TO 100
309 *
310 * Set up parameters with CLATB4 and generate a test matrix
311 * with CLATMS.
312 *
313  CALL clatb4( path, imat, m, n, TYPE, KL, KU, ANORM, MODE,
314  $ CNDNUM, DIST )
315 *
316  srnamt = 'CLATMS'
317  CALL clatms( m, n, dist, iseed, TYPE, RWORK, MODE,
318  $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA,
319  $ WORK, INFO )
320 *
321 * Check error code from CLATMS.
322 *
323  IF( info.NE.0 ) THEN
324  CALL alaerh( path, 'CLATMS', info, 0, ' ', m, n, -1,
325  $ -1, -1, imat, nfail, nerrs, nout )
326  GO TO 100
327  END IF
328 *
329 * For types 5-7, zero one or more columns of the matrix to
330 * test that INFO is returned correctly.
331 *
332  IF( zerot ) THEN
333  IF( imat.EQ.5 ) THEN
334  izero = 1
335  ELSE IF( imat.EQ.6 ) THEN
336  izero = min( m, n )
337  ELSE
338  izero = min( m, n ) / 2 + 1
339  END IF
340  ioff = ( izero-1 )*lda
341  IF( imat.LT.7 ) THEN
342  DO 20 i = 1, m
343  a( ioff+i ) = zero
344  20 CONTINUE
345  ELSE
346  CALL claset( 'Full', m, n-izero+1, cmplx( zero ),
347  $ cmplx( zero ), a( ioff+1 ), lda )
348  END IF
349  ELSE
350  izero = 0
351  END IF
352 *
353 * These lines, if used in place of the calls in the DO 60
354 * loop, cause the code to bomb on a Sun SPARCstation.
355 *
356 * ANORMO = CLANGE( 'O', M, N, A, LDA, RWORK )
357 * ANORMI = CLANGE( 'I', M, N, A, LDA, RWORK )
358 *
359 * Do for each blocksize in NBVAL
360 *
361  DO 90 inb = 1, nnb
362  nb = nbval( inb )
363  CALL xlaenv( 1, nb )
364 *
365 * Compute the LU factorization of the matrix.
366 *
367  CALL clacpy( 'Full', m, n, a, lda, afac, lda )
368  srnamt = 'CGETRF'
369  CALL cgetrf( m, n, afac, lda, iwork, info )
370 *
371 * Check error code from CGETRF.
372 *
373  IF( info.NE.izero )
374  $ CALL alaerh( path, 'CGETRF', info, izero, ' ', m,
375  $ n, -1, -1, nb, imat, nfail, nerrs,
376  $ nout )
377  trfcon = .false.
378 *
379 *+ TEST 1
380 * Reconstruct matrix from factors and compute residual.
381 *
382  CALL clacpy( 'Full', m, n, afac, lda, ainv, lda )
383  CALL cget01( m, n, a, lda, ainv, lda, iwork, rwork,
384  $ result( 1 ) )
385  nt = 1
386 *
387 *+ TEST 2
388 * Form the inverse if the factorization was successful
389 * and compute the residual.
390 *
391  IF( m.EQ.n .AND. info.EQ.0 ) THEN
392  CALL clacpy( 'Full', n, n, afac, lda, ainv, lda )
393  srnamt = 'CGETRI'
394  nrhs = nsval( 1 )
395  lwork = nmax*max( 3, nrhs )
396  CALL cgetri( n, ainv, lda, iwork, work, lwork,
397  $ info )
398 *
399 * Check error code from CGETRI.
400 *
401  IF( info.NE.0 )
402  $ CALL alaerh( path, 'CGETRI', info, 0, ' ', n, n,
403  $ -1, -1, nb, imat, nfail, nerrs,
404  $ nout )
405 *
406 * Compute the residual for the matrix times its
407 * inverse. Also compute the 1-norm condition number
408 * of A.
409 *
410  CALL cget03( n, a, lda, ainv, lda, work, lda,
411  $ rwork, rcondo, result( 2 ) )
412  anormo = clange( 'O', m, n, a, lda, rwork )
413 *
414 * Compute the infinity-norm condition number of A.
415 *
416  anormi = clange( 'I', m, n, a, lda, rwork )
417  ainvnm = clange( 'I', n, n, ainv, lda, rwork )
418  IF( anormi.LE.zero .OR. ainvnm.LE.zero ) THEN
419  rcondi = one
420  ELSE
421  rcondi = ( one / anormi ) / ainvnm
422  END IF
423  nt = 2
424  ELSE
425 *
426 * Do only the condition estimate if INFO > 0.
427 *
428  trfcon = .true.
429  anormo = clange( 'O', m, n, a, lda, rwork )
430  anormi = clange( 'I', m, n, a, lda, rwork )
431  rcondo = zero
432  rcondi = zero
433  END IF
434 *
435 * Print information about the tests so far that did not
436 * pass the threshold.
437 *
438  DO 30 k = 1, nt
439  IF( result( k ).GE.thresh ) THEN
440  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
441  $ CALL alahd( nout, path )
442  WRITE( nout, fmt = 9999 )m, n, nb, imat, k,
443  $ result( k )
444  nfail = nfail + 1
445  END IF
446  30 CONTINUE
447  nrun = nrun + nt
448 *
449 * Skip the remaining tests if this is not the first
450 * block size or if M .ne. N. Skip the solve tests if
451 * the matrix is singular.
452 *
453  IF( inb.GT.1 .OR. m.NE.n )
454  $ GO TO 90
455  IF( trfcon )
456  $ GO TO 70
457 *
458  DO 60 irhs = 1, nns
459  nrhs = nsval( irhs )
460  xtype = 'N'
461 *
462  DO 50 itran = 1, ntran
463  trans = transs( itran )
464  IF( itran.EQ.1 ) THEN
465  rcondc = rcondo
466  ELSE
467  rcondc = rcondi
468  END IF
469 *
470 *+ TEST 3
471 * Solve and compute residual for A * X = B.
472 *
473  srnamt = 'CLARHS'
474  CALL clarhs( path, xtype, ' ', trans, n, n, kl,
475  $ ku, nrhs, a, lda, xact, lda, b,
476  $ lda, iseed, info )
477  xtype = 'C'
478 *
479  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
480  srnamt = 'CGETRS'
481  CALL cgetrs( trans, n, nrhs, afac, lda, iwork,
482  $ x, lda, info )
483 *
484 * Check error code from CGETRS.
485 *
486  IF( info.NE.0 )
487  $ CALL alaerh( path, 'CGETRS', info, 0, trans,
488  $ n, n, -1, -1, nrhs, imat, nfail,
489  $ nerrs, nout )
490 *
491  CALL clacpy( 'Full', n, nrhs, b, lda, work,
492  $ lda )
493  CALL cget02( trans, n, n, nrhs, a, lda, x, lda,
494  $ work, lda, rwork, result( 3 ) )
495 *
496 *+ TEST 4
497 * Check solution from generated exact solution.
498 *
499  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
500  $ result( 4 ) )
501 *
502 *+ TESTS 5, 6, and 7
503 * Use iterative refinement to improve the
504 * solution.
505 *
506  srnamt = 'CGERFS'
507  CALL cgerfs( trans, n, nrhs, a, lda, afac, lda,
508  $ iwork, b, lda, x, lda, rwork,
509  $ rwork( nrhs+1 ), work,
510  $ rwork( 2*nrhs+1 ), info )
511 *
512 * Check error code from CGERFS.
513 *
514  IF( info.NE.0 )
515  $ CALL alaerh( path, 'CGERFS', info, 0, trans,
516  $ n, n, -1, -1, nrhs, imat, nfail,
517  $ nerrs, nout )
518 *
519  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
520  $ result( 5 ) )
521  CALL cget07( trans, n, nrhs, a, lda, b, lda, x,
522  $ lda, xact, lda, rwork, .true.,
523  $ rwork( nrhs+1 ), result( 6 ) )
524 *
525 * Print information about the tests that did not
526 * pass the threshold.
527 *
528  DO 40 k = 3, 7
529  IF( result( k ).GE.thresh ) THEN
530  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
531  $ CALL alahd( nout, path )
532  WRITE( nout, fmt = 9998 )trans, n, nrhs,
533  $ imat, k, result( k )
534  nfail = nfail + 1
535  END IF
536  40 CONTINUE
537  nrun = nrun + 5
538  50 CONTINUE
539  60 CONTINUE
540 *
541 *+ TEST 8
542 * Get an estimate of RCOND = 1/CNDNUM.
543 *
544  70 CONTINUE
545  DO 80 itran = 1, 2
546  IF( itran.EQ.1 ) THEN
547  anorm = anormo
548  rcondc = rcondo
549  norm = 'O'
550  ELSE
551  anorm = anormi
552  rcondc = rcondi
553  norm = 'I'
554  END IF
555  srnamt = 'CGECON'
556  CALL cgecon( norm, n, afac, lda, anorm, rcond,
557  $ work, rwork, info )
558 *
559 * Check error code from CGECON.
560 *
561  IF( info.NE.0 )
562  $ CALL alaerh( path, 'CGECON', info, 0, norm, n,
563  $ n, -1, -1, -1, imat, nfail, nerrs,
564  $ nout )
565 *
566 * This line is needed on a Sun SPARCstation.
567 *
568  dummy = rcond
569 *
570  result( 8 ) = sget06( rcond, rcondc )
571 *
572 * Print information about the tests that did not pass
573 * the threshold.
574 *
575  IF( result( 8 ).GE.thresh ) THEN
576  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
577  $ CALL alahd( nout, path )
578  WRITE( nout, fmt = 9997 )norm, n, imat, 8,
579  $ result( 8 )
580  nfail = nfail + 1
581  END IF
582  nrun = nrun + 1
583  80 CONTINUE
584  90 CONTINUE
585  100 CONTINUE
586 *
587  110 CONTINUE
588  120 CONTINUE
589 *
590 * Print a summary of the results.
591 *
592  CALL alasum( path, nout, nfail, nrun, nerrs )
593 *
594  9999 FORMAT( ' M = ', i5, ', N =', i5, ', NB =', i4, ', type ', i2,
595  $ ', test(', i2, ') =', g12.5 )
596  9998 FORMAT( ' TRANS=''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
597  $ i2, ', test(', i2, ') =', g12.5 )
598  9997 FORMAT( ' NORM =''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
599  $ ', test(', i2, ') =', g12.5 )
600  RETURN
601 *
602 * End of CCHKGE
603 *
Here is the call graph for this function:
Here is the caller graph for this function:
cget07
subroutine cget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
CGET07
Definition: cget07.f:168
clange
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: clange.f:117
cgetrf
subroutine cgetrf(M, N, A, LDA, IPIV, INFO)
CGETRF
Definition: cgetrf.f:110
cgecon
subroutine cgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CGECON
Definition: cgecon.f:126
cget01
subroutine cget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
CGET01
Definition: cget01.f:110
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:109
cget04
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104
cget03
subroutine cget03(N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
CGET03
Definition: cget03.f:112
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
cgetrs
subroutine cgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CGETRS
Definition: cgetrs.f:123
sget06
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
cgetri
subroutine cgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
CGETRI
Definition: cgetri.f:116
clatms
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
claset
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: claset.f:108
cget02
subroutine cget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CGET02
Definition: cget02.f:135
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
cgerfs
subroutine cgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGERFS
Definition: cgerfs.f:188
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
cerrge
subroutine cerrge(PATH, NUNIT)
CERRGE
Definition: cerrge.f:57
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
clatb4
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83