LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine dchktb ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
double precision  THRESH,
logical  TSTERR,
integer  NMAX,
double precision, dimension( * )  AB,
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 
)

DCHKTB

Purpose: 
 DCHKTB tests DTBTRS, -RFS, and -CON, and DLATBS.
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]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]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 leading dimension of the work arrays.
          NMAX >= the maximum value of N in NVAL.
[out]AB
          AB 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(NMAX,2*NSMAX))
[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
November 2011

Definition at line 157 of file dchktb.f.

157 *
158 * -- LAPACK test routine (version 3.4.0) --
159 * -- LAPACK is a software package provided by Univ. of Tennessee, --
160 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
161 * November 2011
162 *
163 * .. Scalar Arguments ..
164  LOGICAL tsterr
165  INTEGER nmax, nn, nns, nout
166  DOUBLE PRECISION thresh
167 * ..
168 * .. Array Arguments ..
169  LOGICAL dotype( * )
170  INTEGER iwork( * ), nsval( * ), nval( * )
171  DOUBLE PRECISION ab( * ), ainv( * ), b( * ), rwork( * ),
172  $ work( * ), x( * ), xact( * )
173 * ..
174 *
175 * =====================================================================
176 *
177 * .. Parameters ..
178  INTEGER ntype1, ntypes
179  parameter ( ntype1 = 9, ntypes = 17 )
180  INTEGER ntests
181  parameter ( ntests = 8 )
182  INTEGER ntran
183  parameter ( ntran = 3 )
184  DOUBLE PRECISION one, zero
185  parameter ( one = 1.0d+0, zero = 0.0d+0 )
186 * ..
187 * .. Local Scalars ..
188  CHARACTER diag, norm, trans, uplo, xtype
189  CHARACTER*3 path
190  INTEGER i, idiag, ik, imat, in, info, irhs, itran,
191  $ iuplo, j, k, kd, lda, ldab, n, nerrs, nfail,
192  $ nimat, nimat2, nk, nrhs, nrun
193  DOUBLE PRECISION ainvnm, anorm, rcond, rcondc, rcondi, rcondo,
194  $ scale
195 * ..
196 * .. Local Arrays ..
197  CHARACTER transs( ntran ), uplos( 2 )
198  INTEGER iseed( 4 ), iseedy( 4 )
199  DOUBLE PRECISION result( ntests )
200 * ..
201 * .. External Functions ..
202  LOGICAL lsame
203  DOUBLE PRECISION dlantb, dlantr
204  EXTERNAL lsame, dlantb, dlantr
205 * ..
206 * .. External Subroutines ..
207  EXTERNAL alaerh, alahd, alasum, dcopy, derrtr, dget04,
208  $ dlacpy, dlarhs, dlaset, dlatbs, dlattb, dtbcon,
209  $ dtbrfs, dtbsv, dtbt02, dtbt03, dtbt05, dtbt06,
210  $ dtbtrs
211 * ..
212 * .. Scalars in Common ..
213  LOGICAL lerr, ok
214  CHARACTER*32 srnamt
215  INTEGER infot, iounit
216 * ..
217 * .. Common blocks ..
218  COMMON / infoc / infot, iounit, ok, lerr
219  COMMON / srnamc / srnamt
220 * ..
221 * .. Intrinsic Functions ..
222  INTRINSIC max, min
223 * ..
224 * .. Data statements ..
225  DATA iseedy / 1988, 1989, 1990, 1991 /
226  DATA uplos / 'U', 'L' / , transs / 'N', 'T', 'C' /
227 * ..
228 * .. Executable Statements ..
229 *
230 * Initialize constants and the random number seed.
231 *
232  path( 1: 1 ) = 'Double precision'
233  path( 2: 3 ) = 'TB'
234  nrun = 0
235  nfail = 0
236  nerrs = 0
237  DO 10 i = 1, 4
238  iseed( i ) = iseedy( i )
239  10 CONTINUE
240 *
241 * Test the error exits
242 *
243  IF( tsterr )
244  $ CALL derrtr( path, nout )
245  infot = 0
246 *
247  DO 140 in = 1, nn
248 *
249 * Do for each value of N in NVAL
250 *
251  n = nval( in )
252  lda = max( 1, n )
253  xtype = 'N'
254  nimat = ntype1
255  nimat2 = ntypes
256  IF( n.LE.0 ) THEN
257  nimat = 1
258  nimat2 = ntype1 + 1
259  END IF
260 *
261  nk = min( n+1, 4 )
262  DO 130 ik = 1, nk
263 *
264 * Do for KD = 0, N, (3N-1)/4, and (N+1)/4. This order makes
265 * it easier to skip redundant values for small values of N.
266 *
267  IF( ik.EQ.1 ) THEN
268  kd = 0
269  ELSE IF( ik.EQ.2 ) THEN
270  kd = max( n, 0 )
271  ELSE IF( ik.EQ.3 ) THEN
272  kd = ( 3*n-1 ) / 4
273  ELSE IF( ik.EQ.4 ) THEN
274  kd = ( n+1 ) / 4
275  END IF
276  ldab = kd + 1
277 *
278  DO 90 imat = 1, nimat
279 *
280 * Do the tests only if DOTYPE( IMAT ) is true.
281 *
282  IF( .NOT.dotype( imat ) )
283  $ GO TO 90
284 *
285  DO 80 iuplo = 1, 2
286 *
287 * Do first for UPLO = 'U', then for UPLO = 'L'
288 *
289  uplo = uplos( iuplo )
290 *
291 * Call DLATTB to generate a triangular test matrix.
292 *
293  srnamt = 'DLATTB'
294  CALL dlattb( imat, uplo, 'No transpose', diag, iseed,
295  $ n, kd, ab, ldab, x, work, info )
296 *
297 * Set IDIAG = 1 for non-unit matrices, 2 for unit.
298 *
299  IF( lsame( diag, 'N' ) ) THEN
300  idiag = 1
301  ELSE
302  idiag = 2
303  END IF
304 *
305 * Form the inverse of A so we can get a good estimate
306 * of RCONDC = 1/(norm(A) * norm(inv(A))).
307 *
308  CALL dlaset( 'Full', n, n, zero, one, ainv, lda )
309  IF( lsame( uplo, 'U' ) ) THEN
310  DO 20 j = 1, n
311  CALL dtbsv( uplo, 'No transpose', diag, j, kd,
312  $ ab, ldab, ainv( ( j-1 )*lda+1 ), 1 )
313  20 CONTINUE
314  ELSE
315  DO 30 j = 1, n
316  CALL dtbsv( uplo, 'No transpose', diag, n-j+1,
317  $ kd, ab( ( j-1 )*ldab+1 ), ldab,
318  $ ainv( ( j-1 )*lda+j ), 1 )
319  30 CONTINUE
320  END IF
321 *
322 * Compute the 1-norm condition number of A.
323 *
324  anorm = dlantb( '1', uplo, diag, n, kd, ab, ldab,
325  $ rwork )
326  ainvnm = dlantr( '1', uplo, diag, n, n, ainv, lda,
327  $ rwork )
328  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
329  rcondo = one
330  ELSE
331  rcondo = ( one / anorm ) / ainvnm
332  END IF
333 *
334 * Compute the infinity-norm condition number of A.
335 *
336  anorm = dlantb( 'I', uplo, diag, n, kd, ab, ldab,
337  $ rwork )
338  ainvnm = dlantr( 'I', uplo, diag, n, n, ainv, lda,
339  $ rwork )
340  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
341  rcondi = one
342  ELSE
343  rcondi = ( one / anorm ) / ainvnm
344  END IF
345 *
346  DO 60 irhs = 1, nns
347  nrhs = nsval( irhs )
348  xtype = 'N'
349 *
350  DO 50 itran = 1, ntran
351 *
352 * Do for op(A) = A, A**T, or A**H.
353 *
354  trans = transs( itran )
355  IF( itran.EQ.1 ) THEN
356  norm = 'O'
357  rcondc = rcondo
358  ELSE
359  norm = 'I'
360  rcondc = rcondi
361  END IF
362 *
363 *+ TEST 1
364 * Solve and compute residual for op(A)*x = b.
365 *
366  srnamt = 'DLARHS'
367  CALL dlarhs( path, xtype, uplo, trans, n, n, kd,
368  $ idiag, nrhs, ab, ldab, xact, lda,
369  $ b, lda, iseed, info )
370  xtype = 'C'
371  CALL dlacpy( 'Full', n, nrhs, b, lda, x, lda )
372 *
373  srnamt = 'DTBTRS'
374  CALL dtbtrs( uplo, trans, diag, n, kd, nrhs, ab,
375  $ ldab, x, lda, info )
376 *
377 * Check error code from DTBTRS.
378 *
379  IF( info.NE.0 )
380  $ CALL alaerh( path, 'DTBTRS', info, 0,
381  $ uplo // trans // diag, n, n, kd,
382  $ kd, nrhs, imat, nfail, nerrs,
383  $ nout )
384 *
385  CALL dtbt02( uplo, trans, diag, n, kd, nrhs, ab,
386  $ ldab, x, lda, b, lda, work,
387  $ result( 1 ) )
388 *
389 *+ TEST 2
390 * Check solution from generated exact solution.
391 *
392  CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
393  $ result( 2 ) )
394 *
395 *+ TESTS 3, 4, and 5
396 * Use iterative refinement to improve the solution
397 * and compute error bounds.
398 *
399  srnamt = 'DTBRFS'
400  CALL dtbrfs( uplo, trans, diag, n, kd, nrhs, ab,
401  $ ldab, b, lda, x, lda, rwork,
402  $ rwork( nrhs+1 ), work, iwork,
403  $ info )
404 *
405 * Check error code from DTBRFS.
406 *
407  IF( info.NE.0 )
408  $ CALL alaerh( path, 'DTBRFS', info, 0,
409  $ uplo // trans // diag, n, n, kd,
410  $ kd, nrhs, imat, nfail, nerrs,
411  $ nout )
412 *
413  CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
414  $ result( 3 ) )
415  CALL dtbt05( uplo, trans, diag, n, kd, nrhs, ab,
416  $ ldab, b, lda, x, lda, xact, lda,
417  $ rwork, rwork( nrhs+1 ),
418  $ result( 4 ) )
419 *
420 * Print information about the tests that did not
421 * pass the threshold.
422 *
423  DO 40 k = 1, 5
424  IF( result( k ).GE.thresh ) THEN
425  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
426  $ CALL alahd( nout, path )
427  WRITE( nout, fmt = 9999 )uplo, trans,
428  $ diag, n, kd, nrhs, imat, k, result( k )
429  nfail = nfail + 1
430  END IF
431  40 CONTINUE
432  nrun = nrun + 5
433  50 CONTINUE
434  60 CONTINUE
435 *
436 *+ TEST 6
437 * Get an estimate of RCOND = 1/CNDNUM.
438 *
439  DO 70 itran = 1, 2
440  IF( itran.EQ.1 ) THEN
441  norm = 'O'
442  rcondc = rcondo
443  ELSE
444  norm = 'I'
445  rcondc = rcondi
446  END IF
447  srnamt = 'DTBCON'
448  CALL dtbcon( norm, uplo, diag, n, kd, ab, ldab,
449  $ rcond, work, iwork, info )
450 *
451 * Check error code from DTBCON.
452 *
453  IF( info.NE.0 )
454  $ CALL alaerh( path, 'DTBCON', info, 0,
455  $ norm // uplo // diag, n, n, kd, kd,
456  $ -1, imat, nfail, nerrs, nout )
457 *
458  CALL dtbt06( rcond, rcondc, uplo, diag, n, kd, ab,
459  $ ldab, rwork, result( 6 ) )
460 *
461 * Print information about the tests that did not pass
462 * the threshold.
463 *
464  IF( result( 6 ).GE.thresh ) THEN
465  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
466  $ CALL alahd( nout, path )
467  WRITE( nout, fmt = 9998 ) 'DTBCON', norm, uplo,
468  $ diag, n, kd, imat, 6, result( 6 )
469  nfail = nfail + 1
470  END IF
471  nrun = nrun + 1
472  70 CONTINUE
473  80 CONTINUE
474  90 CONTINUE
475 *
476 * Use pathological test matrices to test DLATBS.
477 *
478  DO 120 imat = ntype1 + 1, nimat2
479 *
480 * Do the tests only if DOTYPE( IMAT ) is true.
481 *
482  IF( .NOT.dotype( imat ) )
483  $ GO TO 120
484 *
485  DO 110 iuplo = 1, 2
486 *
487 * Do first for UPLO = 'U', then for UPLO = 'L'
488 *
489  uplo = uplos( iuplo )
490  DO 100 itran = 1, ntran
491 *
492 * Do for op(A) = A, A**T, and A**H.
493 *
494  trans = transs( itran )
495 *
496 * Call DLATTB to generate a triangular test matrix.
497 *
498  srnamt = 'DLATTB'
499  CALL dlattb( imat, uplo, trans, diag, iseed, n, kd,
500  $ ab, ldab, x, work, info )
501 *
502 *+ TEST 7
503 * Solve the system op(A)*x = b
504 *
505  srnamt = 'DLATBS'
506  CALL dcopy( n, x, 1, b, 1 )
507  CALL dlatbs( uplo, trans, diag, 'N', n, kd, ab,
508  $ ldab, b, scale, rwork, info )
509 *
510 * Check error code from DLATBS.
511 *
512  IF( info.NE.0 )
513  $ CALL alaerh( path, 'DLATBS', info, 0,
514  $ uplo // trans // diag // 'N', n, n,
515  $ kd, kd, -1, imat, nfail, nerrs,
516  $ nout )
517 *
518  CALL dtbt03( uplo, trans, diag, n, kd, 1, ab, ldab,
519  $ scale, rwork, one, b, lda, x, lda,
520  $ work, result( 7 ) )
521 *
522 *+ TEST 8
523 * Solve op(A)*x = b again with NORMIN = 'Y'.
524 *
525  CALL dcopy( n, x, 1, b, 1 )
526  CALL dlatbs( uplo, trans, diag, 'Y', n, kd, ab,
527  $ ldab, b, scale, rwork, info )
528 *
529 * Check error code from DLATBS.
530 *
531  IF( info.NE.0 )
532  $ CALL alaerh( path, 'DLATBS', info, 0,
533  $ uplo // trans // diag // 'Y', n, n,
534  $ kd, kd, -1, imat, nfail, nerrs,
535  $ nout )
536 *
537  CALL dtbt03( uplo, trans, diag, n, kd, 1, ab, ldab,
538  $ scale, rwork, one, b, lda, x, lda,
539  $ work, result( 8 ) )
540 *
541 * Print information about the tests that did not pass
542 * the threshold.
543 *
544  IF( result( 7 ).GE.thresh ) THEN
545  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
546  $ CALL alahd( nout, path )
547  WRITE( nout, fmt = 9997 )'DLATBS', uplo, trans,
548  $ diag, 'N', n, kd, imat, 7, result( 7 )
549  nfail = nfail + 1
550  END IF
551  IF( result( 8 ).GE.thresh ) THEN
552  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
553  $ CALL alahd( nout, path )
554  WRITE( nout, fmt = 9997 )'DLATBS', uplo, trans,
555  $ diag, 'Y', n, kd, imat, 8, result( 8 )
556  nfail = nfail + 1
557  END IF
558  nrun = nrun + 2
559  100 CONTINUE
560  110 CONTINUE
561  120 CONTINUE
562  130 CONTINUE
563  140 CONTINUE
564 *
565 * Print a summary of the results.
566 *
567  CALL alasum( path, nout, nfail, nrun, nerrs )
568 *
569  9999 FORMAT( ' UPLO=''', a1, ''', TRANS=''', a1, ''',
570  $ DIAG=''', a1, ''', N=', i5, ', KD=', i5, ', NRHS=', i5,
571  $ ', type ', i2, ', test(', i2, ')=', g12.5 )
572  9998 FORMAT( 1x, a, '( ''', a1, ''', ''', a1, ''', ''', a1, ''',',
573  $ i5, ',', i5, ', ... ), type ', i2, ', test(', i2, ')=',
574  $ g12.5 )
575  9997 FORMAT( 1x, a, '( ''', a1, ''', ''', a1, ''', ''', a1, ''', ''',
576  $ a1, ''',', i5, ',', i5, ', ... ), type ', i2, ', test(',
577  $ i1, ')=', g12.5 )
578  RETURN
579 *
580 * End of DCHKTB
581 *
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
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
dcopy
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
Definition: dcopy.f:53
dtbsv
subroutine dtbsv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
DTBSV
Definition: dtbsv.f:191
dtbcon
subroutine dtbcon(NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, IWORK, INFO)
DTBCON
Definition: dtbcon.f:145
dtbtrs
subroutine dtbtrs(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
DTBTRS
Definition: dtbtrs.f:148
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
dtbt05
subroutine dtbt05(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DTBT05
Definition: dtbt05.f:191
dtbt03
subroutine dtbt03(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
DTBT03
Definition: dtbt03.f:177
dtbt02
subroutine dtbt02(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, X, LDX, B, LDB, WORK, RESID)
DTBT02
Definition: dtbt02.f:156
dlattb
subroutine dlattb(IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, LDAB, B, WORK, INFO)
DLATTB
Definition: dlattb.f:137
dtbt06
subroutine dtbt06(RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB, WORK, RAT)
DTBT06
Definition: dtbt06.f:127
dget04
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
Definition: dget04.f:104
derrtr
subroutine derrtr(PATH, NUNIT)
DERRTR
Definition: derrtr.f:57
dlantr
double precision function dlantr(NORM, UPLO, DIAG, M, N, A, LDA, WORK)
DLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix.
Definition: dlantr.f:143
dtbrfs
subroutine dtbrfs(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DTBRFS
Definition: dtbrfs.f:190
dlatbs
subroutine dlatbs(UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, SCALE, CNORM, INFO)
DLATBS solves a triangular banded system of equations.
Definition: dlatbs.f:244
dlantb
double precision function dlantb(NORM, UPLO, DIAG, N, K, AB, LDAB, WORK)
DLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular band matrix.
Definition: dlantb.f:142
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
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: