LAPACK  3.10.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 (NNB)
          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.

Definition at line 183 of file cchkge.f.

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