LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine dchkge ( logical, dimension( * )  DOTYPE,
integer  NM,
integer, dimension( * )  MVAL,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
double precision  THRESH,
logical  TSTERR,
integer  NMAX,
double precision, dimension( * )  A,
double precision, dimension( * )  AFAC,
double precision, dimension( * )  AINV,
double precision, dimension( * )  B,
double precision, dimension( * )  X,
double precision, dimension( * )  XACT,
double precision, dimension( * )  WORK,
double precision, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

DCHKGE

Purpose: 
 DCHKGE tests DGETRF, -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 DOUBLE PRECISION
          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 DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AINV
          AINV is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]B
          B is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is DOUBLE PRECISION array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension
                      (max(2*NMAX,2*NSMAX+NWORK))
[out]IWORK
          IWORK is INTEGER array, dimension (2*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 187 of file dchkge.f.

187 *
188 * -- LAPACK test routine (version 3.4.0) --
189 * -- LAPACK is a software package provided by Univ. of Tennessee, --
190 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
191 * November 2011
192 *
193 * .. Scalar Arguments ..
194  LOGICAL tsterr
195  INTEGER nm, nmax, nn, nnb, nns, nout
196  DOUBLE PRECISION thresh
197 * ..
198 * .. Array Arguments ..
199  LOGICAL dotype( * )
200  INTEGER iwork( * ), mval( * ), nbval( * ), nsval( * ),
201  $ nval( * )
202  DOUBLE PRECISION a( * ), afac( * ), ainv( * ), b( * ),
203  $ rwork( * ), work( * ), x( * ), xact( * )
204 * ..
205 *
206 * =====================================================================
207 *
208 * .. Parameters ..
209  DOUBLE PRECISION one, zero
210  parameter ( one = 1.0d+0, zero = 0.0d+0 )
211  INTEGER ntypes
212  parameter ( ntypes = 11 )
213  INTEGER ntests
214  parameter ( ntests = 8 )
215  INTEGER ntran
216  parameter ( ntran = 3 )
217 * ..
218 * .. Local Scalars ..
219  LOGICAL trfcon, zerot
220  CHARACTER dist, norm, trans, TYPE, xtype
221  CHARACTER*3 path
222  INTEGER i, im, imat, in, inb, info, ioff, irhs, itran,
223  $ izero, k, kl, ku, lda, lwork, m, mode, n, nb,
224  $ nerrs, nfail, nimat, nrhs, nrun, nt
225  DOUBLE PRECISION ainvnm, anorm, anormi, anormo, cndnum, dummy,
226  $ rcond, rcondc, rcondi, rcondo
227 * ..
228 * .. Local Arrays ..
229  CHARACTER transs( ntran )
230  INTEGER iseed( 4 ), iseedy( 4 )
231  DOUBLE PRECISION result( ntests )
232 * ..
233 * .. External Functions ..
234  DOUBLE PRECISION dget06, dlange
235  EXTERNAL dget06, dlange
236 * ..
237 * .. External Subroutines ..
238  EXTERNAL alaerh, alahd, alasum, derrge, dgecon, dgerfs,
239  $ dget01, dget02, dget03, dget04, dget07, dgetrf,
240  $ dgetri, dgetrs, dlacpy, dlarhs, dlaset, dlatb4,
241  $ dlatms, xlaenv
242 * ..
243 * .. Intrinsic Functions ..
244  INTRINSIC max, min
245 * ..
246 * .. Scalars in Common ..
247  LOGICAL lerr, ok
248  CHARACTER*32 srnamt
249  INTEGER infot, nunit
250 * ..
251 * .. Common blocks ..
252  COMMON / infoc / infot, nunit, ok, lerr
253  COMMON / srnamc / srnamt
254 * ..
255 * .. Data statements ..
256  DATA iseedy / 1988, 1989, 1990, 1991 / ,
257  $ transs / 'N', 'T', 'C' /
258 * ..
259 * .. Executable Statements ..
260 *
261 * Initialize constants and the random number seed.
262 *
263  path( 1: 1 ) = 'Double precision'
264  path( 2: 3 ) = 'GE'
265  nrun = 0
266  nfail = 0
267  nerrs = 0
268  DO 10 i = 1, 4
269  iseed( i ) = iseedy( i )
270  10 CONTINUE
271 *
272 * Test the error exits
273 *
274  CALL xlaenv( 1, 1 )
275  IF( tsterr )
276  $ CALL derrge( path, nout )
277  infot = 0
278  CALL xlaenv( 2, 2 )
279 *
280 * Do for each value of M in MVAL
281 *
282  DO 120 im = 1, nm
283  m = mval( im )
284  lda = max( 1, m )
285 *
286 * Do for each value of N in NVAL
287 *
288  DO 110 in = 1, nn
289  n = nval( in )
290  xtype = 'N'
291  nimat = ntypes
292  IF( m.LE.0 .OR. n.LE.0 )
293  $ nimat = 1
294 *
295  DO 100 imat = 1, nimat
296 *
297 * Do the tests only if DOTYPE( IMAT ) is true.
298 *
299  IF( .NOT.dotype( imat ) )
300  $ GO TO 100
301 *
302 * Skip types 5, 6, or 7 if the matrix size is too small.
303 *
304  zerot = imat.GE.5 .AND. imat.LE.7
305  IF( zerot .AND. n.LT.imat-4 )
306  $ GO TO 100
307 *
308 * Set up parameters with DLATB4 and generate a test matrix
309 * with DLATMS.
310 *
311  CALL dlatb4( path, imat, m, n, TYPE, kl, ku, anorm, mode,
312  $ cndnum, dist )
313 *
314  srnamt = 'DLATMS'
315  CALL dlatms( m, n, dist, iseed, TYPE, rwork, mode,
316  $ cndnum, anorm, kl, ku, 'No packing', a, lda,
317  $ work, info )
318 *
319 * Check error code from DLATMS.
320 *
321  IF( info.NE.0 ) THEN
322  CALL alaerh( path, 'DLATMS', info, 0, ' ', m, n, -1,
323  $ -1, -1, imat, nfail, nerrs, nout )
324  GO TO 100
325  END IF
326 *
327 * For types 5-7, zero one or more columns of the matrix to
328 * test that INFO is returned correctly.
329 *
330  IF( zerot ) THEN
331  IF( imat.EQ.5 ) THEN
332  izero = 1
333  ELSE IF( imat.EQ.6 ) THEN
334  izero = min( m, n )
335  ELSE
336  izero = min( m, n ) / 2 + 1
337  END IF
338  ioff = ( izero-1 )*lda
339  IF( imat.LT.7 ) THEN
340  DO 20 i = 1, m
341  a( ioff+i ) = zero
342  20 CONTINUE
343  ELSE
344  CALL dlaset( 'Full', m, n-izero+1, zero, zero,
345  $ a( ioff+1 ), lda )
346  END IF
347  ELSE
348  izero = 0
349  END IF
350 *
351 * These lines, if used in place of the calls in the DO 60
352 * loop, cause the code to bomb on a Sun SPARCstation.
353 *
354 * ANORMO = DLANGE( 'O', M, N, A, LDA, RWORK )
355 * ANORMI = DLANGE( 'I', M, N, A, LDA, RWORK )
356 *
357 * Do for each blocksize in NBVAL
358 *
359  DO 90 inb = 1, nnb
360  nb = nbval( inb )
361  CALL xlaenv( 1, nb )
362 *
363 * Compute the LU factorization of the matrix.
364 *
365  CALL dlacpy( 'Full', m, n, a, lda, afac, lda )
366  srnamt = 'DGETRF'
367  CALL dgetrf( m, n, afac, lda, iwork, info )
368 *
369 * Check error code from DGETRF.
370 *
371  IF( info.NE.izero )
372  $ CALL alaerh( path, 'DGETRF', info, izero, ' ', m,
373  $ n, -1, -1, nb, imat, nfail, nerrs,
374  $ nout )
375  trfcon = .false.
376 *
377 *+ TEST 1
378 * Reconstruct matrix from factors and compute residual.
379 *
380  CALL dlacpy( 'Full', m, n, afac, lda, ainv, lda )
381  CALL dget01( m, n, a, lda, ainv, lda, iwork, rwork,
382  $ result( 1 ) )
383  nt = 1
384 *
385 *+ TEST 2
386 * Form the inverse if the factorization was successful
387 * and compute the residual.
388 *
389  IF( m.EQ.n .AND. info.EQ.0 ) THEN
390  CALL dlacpy( 'Full', n, n, afac, lda, ainv, lda )
391  srnamt = 'DGETRI'
392  nrhs = nsval( 1 )
393  lwork = nmax*max( 3, nrhs )
394  CALL dgetri( n, ainv, lda, iwork, work, lwork,
395  $ info )
396 *
397 * Check error code from DGETRI.
398 *
399  IF( info.NE.0 )
400  $ CALL alaerh( path, 'DGETRI', info, 0, ' ', n, n,
401  $ -1, -1, nb, imat, nfail, nerrs,
402  $ nout )
403 *
404 * Compute the residual for the matrix times its
405 * inverse. Also compute the 1-norm condition number
406 * of A.
407 *
408  CALL dget03( n, a, lda, ainv, lda, work, lda,
409  $ rwork, rcondo, result( 2 ) )
410  anormo = dlange( 'O', m, n, a, lda, rwork )
411 *
412 * Compute the infinity-norm condition number of A.
413 *
414  anormi = dlange( 'I', m, n, a, lda, rwork )
415  ainvnm = dlange( 'I', n, n, ainv, lda, rwork )
416  IF( anormi.LE.zero .OR. ainvnm.LE.zero ) THEN
417  rcondi = one
418  ELSE
419  rcondi = ( one / anormi ) / ainvnm
420  END IF
421  nt = 2
422  ELSE
423 *
424 * Do only the condition estimate if INFO > 0.
425 *
426  trfcon = .true.
427  anormo = dlange( 'O', m, n, a, lda, rwork )
428  anormi = dlange( 'I', m, n, a, lda, rwork )
429  rcondo = zero
430  rcondi = zero
431  END IF
432 *
433 * Print information about the tests so far that did not
434 * pass the threshold.
435 *
436  DO 30 k = 1, nt
437  IF( result( k ).GE.thresh ) THEN
438  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
439  $ CALL alahd( nout, path )
440  WRITE( nout, fmt = 9999 )m, n, nb, imat, k,
441  $ result( k )
442  nfail = nfail + 1
443  END IF
444  30 CONTINUE
445  nrun = nrun + nt
446 *
447 * Skip the remaining tests if this is not the first
448 * block size or if M .ne. N. Skip the solve tests if
449 * the matrix is singular.
450 *
451  IF( inb.GT.1 .OR. m.NE.n )
452  $ GO TO 90
453  IF( trfcon )
454  $ GO TO 70
455 *
456  DO 60 irhs = 1, nns
457  nrhs = nsval( irhs )
458  xtype = 'N'
459 *
460  DO 50 itran = 1, ntran
461  trans = transs( itran )
462  IF( itran.EQ.1 ) THEN
463  rcondc = rcondo
464  ELSE
465  rcondc = rcondi
466  END IF
467 *
468 *+ TEST 3
469 * Solve and compute residual for A * X = B.
470 *
471  srnamt = 'DLARHS'
472  CALL dlarhs( path, xtype, ' ', trans, n, n, kl,
473  $ ku, nrhs, a, lda, xact, lda, b,
474  $ lda, iseed, info )
475  xtype = 'C'
476 *
477  CALL dlacpy( 'Full', n, nrhs, b, lda, x, lda )
478  srnamt = 'DGETRS'
479  CALL dgetrs( trans, n, nrhs, afac, lda, iwork,
480  $ x, lda, info )
481 *
482 * Check error code from DGETRS.
483 *
484  IF( info.NE.0 )
485  $ CALL alaerh( path, 'DGETRS', info, 0, trans,
486  $ n, n, -1, -1, nrhs, imat, nfail,
487  $ nerrs, nout )
488 *
489  CALL dlacpy( 'Full', n, nrhs, b, lda, work,
490  $ lda )
491  CALL dget02( trans, n, n, nrhs, a, lda, x, lda,
492  $ work, lda, rwork, result( 3 ) )
493 *
494 *+ TEST 4
495 * Check solution from generated exact solution.
496 *
497  CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
498  $ result( 4 ) )
499 *
500 *+ TESTS 5, 6, and 7
501 * Use iterative refinement to improve the
502 * solution.
503 *
504  srnamt = 'DGERFS'
505  CALL dgerfs( trans, n, nrhs, a, lda, afac, lda,
506  $ iwork, b, lda, x, lda, rwork,
507  $ rwork( nrhs+1 ), work,
508  $ iwork( n+1 ), info )
509 *
510 * Check error code from DGERFS.
511 *
512  IF( info.NE.0 )
513  $ CALL alaerh( path, 'DGERFS', info, 0, trans,
514  $ n, n, -1, -1, nrhs, imat, nfail,
515  $ nerrs, nout )
516 *
517  CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
518  $ result( 5 ) )
519  CALL dget07( trans, n, nrhs, a, lda, b, lda, x,
520  $ lda, xact, lda, rwork, .true.,
521  $ rwork( nrhs+1 ), result( 6 ) )
522 *
523 * Print information about the tests that did not
524 * pass the threshold.
525 *
526  DO 40 k = 3, 7
527  IF( result( k ).GE.thresh ) THEN
528  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
529  $ CALL alahd( nout, path )
530  WRITE( nout, fmt = 9998 )trans, n, nrhs,
531  $ imat, k, result( k )
532  nfail = nfail + 1
533  END IF
534  40 CONTINUE
535  nrun = nrun + 5
536  50 CONTINUE
537  60 CONTINUE
538 *
539 *+ TEST 8
540 * Get an estimate of RCOND = 1/CNDNUM.
541 *
542  70 CONTINUE
543  DO 80 itran = 1, 2
544  IF( itran.EQ.1 ) THEN
545  anorm = anormo
546  rcondc = rcondo
547  norm = 'O'
548  ELSE
549  anorm = anormi
550  rcondc = rcondi
551  norm = 'I'
552  END IF
553  srnamt = 'DGECON'
554  CALL dgecon( norm, n, afac, lda, anorm, rcond,
555  $ work, iwork( n+1 ), info )
556 *
557 * Check error code from DGECON.
558 *
559  IF( info.NE.0 )
560  $ CALL alaerh( path, 'DGECON', info, 0, norm, n,
561  $ n, -1, -1, -1, imat, nfail, nerrs,
562  $ nout )
563 *
564 * This line is needed on a Sun SPARCstation.
565 *
566  dummy = rcond
567 *
568  result( 8 ) = dget06( rcond, rcondc )
569 *
570 * Print information about the tests that did not pass
571 * the threshold.
572 *
573  IF( result( 8 ).GE.thresh ) THEN
574  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
575  $ CALL alahd( nout, path )
576  WRITE( nout, fmt = 9997 )norm, n, imat, 8,
577  $ result( 8 )
578  nfail = nfail + 1
579  END IF
580  nrun = nrun + 1
581  80 CONTINUE
582  90 CONTINUE
583  100 CONTINUE
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 DCHKGE
600 *
dlaset
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: dlaset.f:112
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
dgetrf
subroutine dgetrf(M, N, A, LDA, IPIV, INFO)
DGETRF
Definition: dgetrf.f:110
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
dlarhs
subroutine dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
Definition: dlarhs.f:206
dget03
subroutine dget03(N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
DGET03
Definition: dget03.f:111
dgerfs
subroutine dgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGERFS
Definition: dgerfs.f:187
dlacpy
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
dgetri
subroutine dgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
DGETRI
Definition: dgetri.f:116
dget01
subroutine dget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
DGET01
Definition: dget01.f:109
dgetrs
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGETRS
Definition: dgetrs.f:123
derrge
subroutine derrge(PATH, NUNIT)
DERRGE
Definition: derrge.f:57
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
dlange
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
dget07
subroutine dget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
DGET07
Definition: dget07.f:167
dget02
subroutine dget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DGET02
Definition: dget02.f:135
dlatb4
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
Definition: dlatb4.f:122
dget04
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
Definition: dget04.f:104
dget06
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
dlatms
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:323
dgecon
subroutine dgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
DGECON
Definition: dgecon.f:126
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: