152 SUBROUTINE dchktb( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
153 $ NMAX, AB, AINV, B, X, XACT, WORK, RWORK, IWORK,
162 INTEGER NMAX, NN, NNS, NOUT
163 DOUBLE PRECISION THRESH
167 INTEGER IWORK( * ), NSVAL( * ), NVAL( * )
168 DOUBLE PRECISION AB( * ), AINV( * ), B( * ), RWORK( * ),
169 $ work( * ), x( * ), xact( * )
175 INTEGER NTYPE1, NTYPES
176 PARAMETER ( NTYPE1 = 9, ntypes = 17 )
178 parameter( ntests = 8 )
180 parameter( ntran = 3 )
181 DOUBLE PRECISION ONE, ZERO
182 parameter( one = 1.0d+0, zero = 0.0d+0 )
185 CHARACTER DIAG, NORM, TRANS, UPLO, XTYPE
187 INTEGER I, IDIAG, IK, IMAT, IN, INFO, IRHS, ITRAN,
188 $ iuplo, j, k, kd, lda, ldab, n, nerrs, nfail,
189 $ nimat, nimat2, nk, nrhs, nrun
190 DOUBLE PRECISION AINVNM, ANORM, RCOND, RCONDC, RCONDI, RCONDO,
194 CHARACTER TRANSS( NTRAN ), UPLOS( 2 )
195 INTEGER ISEED( 4 ), ISEEDY( 4 )
196 DOUBLE PRECISION RESULT( NTESTS )
200 DOUBLE PRECISION DLANTB, DLANTR
201 EXTERNAL lsame, dlantb, dlantr
212 INTEGER INFOT, IOUNIT
215 COMMON / infoc / infot, iounit, ok, lerr
216 COMMON / srnamc / srnamt
222 DATA iseedy / 1988, 1989, 1990, 1991 /
223 DATA uplos /
'U',
'L' / , transs /
'N',
'T',
'C' /
229 path( 1: 1 ) =
'Double precision'
235 iseed( i ) = iseedy( i )
241 $
CALL derrtr( path, nout )
266 ELSE IF( ik.EQ.2 )
THEN
268 ELSE IF( ik.EQ.3 )
THEN
270 ELSE IF( ik.EQ.4 )
THEN
275 DO 90 imat = 1, nimat
279 IF( .NOT.dotype( imat ) )
286 uplo = uplos( iuplo )
291 CALL dlattb( imat, uplo,
'No transpose', diag, iseed,
292 $ n, kd, ab, ldab, x, work, info )
296 IF( lsame( diag,
'N' ) )
THEN
305 CALL dlaset(
'Full', n, n, zero, one, ainv, lda )
306 IF( lsame( uplo,
'U' ) )
THEN
308 CALL dtbsv( uplo,
'No transpose', diag, j, kd,
309 $ ab, ldab, ainv( ( j-1 )*lda+1 ), 1 )
313 CALL dtbsv( uplo,
'No transpose', diag, n-j+1,
314 $ kd, ab( ( j-1 )*ldab+1 ), ldab,
315 $ ainv( ( j-1 )*lda+j ), 1 )
321 anorm = dlantb(
'1', uplo, diag, n, kd, ab, ldab,
323 ainvnm = dlantr(
'1', uplo, diag, n, n, ainv, lda,
325 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
328 rcondo = ( one / anorm ) / ainvnm
333 anorm = dlantb(
'I', uplo, diag, n, kd, ab, ldab,
335 ainvnm = dlantr(
'I', uplo, diag, n, n, ainv, lda,
337 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
340 rcondi = ( one / anorm ) / ainvnm
347 DO 50 itran = 1, ntran
351 trans = transs( itran )
352 IF( itran.EQ.1 )
THEN
364 CALL dlarhs( path, xtype, uplo, trans, n, n, kd,
365 $ idiag, nrhs, ab, ldab, xact, lda,
366 $ b, lda, iseed, info )
368 CALL dlacpy(
'Full', n, nrhs, b, lda, x, lda )
371 CALL dtbtrs( uplo, trans, diag, n, kd, nrhs, ab,
372 $ ldab, x, lda, info )
377 $
CALL alaerh( path,
'DTBTRS', info, 0,
378 $ uplo // trans // diag, n, n, kd,
379 $ kd, nrhs, imat, nfail, nerrs,
382 CALL dtbt02( uplo, trans, diag, n, kd, nrhs, ab,
383 $ ldab, x, lda, b, lda, work,
389 CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
397 CALL dtbrfs( uplo, trans, diag, n, kd, nrhs, ab,
398 $ ldab, b, lda, x, lda, rwork,
399 $ rwork( nrhs+1 ), work, iwork,
405 $
CALL alaerh( path,
'DTBRFS', info, 0,
406 $ uplo // trans // diag, n, n, kd,
407 $ kd, nrhs, imat, nfail, nerrs,
410 CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
412 CALL dtbt05( uplo, trans, diag, n, kd, nrhs, ab,
413 $ ldab, b, lda, x, lda, xact, lda,
414 $ rwork, rwork( nrhs+1 ),
421 IF( result( k ).GE.thresh )
THEN
422 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
423 $
CALL alahd( nout, path )
424 WRITE( nout, fmt = 9999 )uplo, trans,
425 $ diag, n, kd, nrhs, imat, k, result( k )
437 IF( itran.EQ.1 )
THEN
445 CALL dtbcon( norm, uplo, diag, n, kd, ab, ldab,
446 $ rcond, work, iwork, info )
451 $
CALL alaerh( path,
'DTBCON', info, 0,
452 $ norm // uplo // diag, n, n, kd, kd,
453 $ -1, imat, nfail, nerrs, nout )
455 CALL dtbt06( rcond, rcondc, uplo, diag, n, kd, ab,
456 $ ldab, rwork, result( 6 ) )
461 IF( result( 6 ).GE.thresh )
THEN
462 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
463 $
CALL alahd( nout, path )
464 WRITE( nout, fmt = 9998 )
'DTBCON', norm, uplo,
465 $ diag, n, kd, imat, 6, result( 6 )
475 DO 120 imat = ntype1 + 1, nimat2
479 IF( .NOT.dotype( imat ) )
486 uplo = uplos( iuplo )
487 DO 100 itran = 1, ntran
491 trans = transs( itran )
496 CALL dlattb( imat, uplo, trans, diag, iseed, n, kd,
497 $ ab, ldab, x, work, info )
503 CALL dcopy( n, x, 1, b, 1 )
504 CALL dlatbs( uplo, trans, diag,
'N', n, kd, ab,
505 $ ldab, b, scale, rwork, info )
510 $
CALL alaerh( path,
'DLATBS', info, 0,
511 $ uplo // trans // diag //
'N', n, n,
512 $ kd, kd, -1, imat, nfail, nerrs,
515 CALL dtbt03( uplo, trans, diag, n, kd, 1, ab, ldab,
516 $ scale, rwork, one, b, lda, x, lda,
517 $ work, result( 7 ) )
522 CALL dcopy( n, x, 1, b, 1 )
523 CALL dlatbs( uplo, trans, diag,
'Y', n, kd, ab,
524 $ ldab, b, scale, rwork, info )
529 $
CALL alaerh( path,
'DLATBS', info, 0,
530 $ uplo // trans // diag //
'Y', n, n,
531 $ kd, kd, -1, imat, nfail, nerrs,
534 CALL dtbt03( uplo, trans, diag, n, kd, 1, ab, ldab,
535 $ scale, rwork, one, b, lda, x, lda,
536 $ work, result( 8 ) )
541 IF( result( 7 ).GE.thresh )
THEN
542 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
543 $
CALL alahd( nout, path )
544 WRITE( nout, fmt = 9997 )
'DLATBS', uplo, trans,
545 $ diag,
'N', n, kd, imat, 7, result( 7 )
548 IF( result( 8 ).GE.thresh )
THEN
549 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
550 $
CALL alahd( nout, path )
551 WRITE( nout, fmt = 9997 )
'DLATBS', uplo, trans,
552 $ diag,
'Y', n, kd, imat, 8, result( 8 )
564 CALL alasum( path, nout, nfail, nrun, nerrs )
566 9999
FORMAT(
' UPLO=''', a1,
''', TRANS=''', a1,
''',
567 $ DIAG=''', a1,
''', N=', i5,
', KD=', i5,
', NRHS=', i5,
568 $
', type ', i2,
', test(', i2,
')=', g12.5 )
569 9998
FORMAT( 1x, a,
'( ''', a1,
''', ''', a1,
''', ''', a1,
''',',
570 $ i5,
',', i5,
', ... ), type ', i2,
', test(', i2,
')=',
572 9997
FORMAT( 1x, a,
'( ''', a1,
''', ''', a1,
''', ''', a1,
''', ''',
573 $ a1,
''',', i5,
',', i5,
', ... ), type ', i2,
', test(',
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
subroutine dlarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
DLARHS
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
subroutine alahd(iounit, path)
ALAHD
subroutine dchktb(dotype, nn, nval, nns, nsval, thresh, tsterr, nmax, ab, ainv, b, x, xact, work, rwork, iwork, nout)
DCHKTB
subroutine derrtr(path, nunit)
DERRTR
subroutine dget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
DGET04
subroutine dlattb(imat, uplo, trans, diag, iseed, n, kd, ab, ldab, b, work, info)
DLATTB
subroutine dtbt02(uplo, trans, diag, n, kd, nrhs, ab, ldab, x, ldx, b, ldb, work, resid)
DTBT02
subroutine dtbt03(uplo, trans, diag, n, kd, nrhs, ab, ldab, scale, cnorm, tscal, x, ldx, b, ldb, work, resid)
DTBT03
subroutine dtbt05(uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb, x, ldx, xact, ldxact, ferr, berr, reslts)
DTBT05
subroutine dtbt06(rcond, rcondc, uplo, diag, n, kd, ab, ldab, work, rat)
DTBT06
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
subroutine dlacpy(uplo, m, n, a, lda, b, ldb)
DLACPY copies all or part of one two-dimensional array to another.
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.
subroutine dlatbs(uplo, trans, diag, normin, n, kd, ab, ldab, x, scale, cnorm, info)
DLATBS solves a triangular banded system of equations.
subroutine dtbcon(norm, uplo, diag, n, kd, ab, ldab, rcond, work, iwork, info)
DTBCON
subroutine dtbrfs(uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DTBRFS
subroutine dtbsv(uplo, trans, diag, n, k, a, lda, x, incx)
DTBSV
subroutine dtbtrs(uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb, info)
DTBTRS