154 SUBROUTINE dchktb( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
155 $ nmax, ab, ainv,
b, x, xact, work, rwork, iwork,
165 INTEGER nmax, nn, nns, nout
166 DOUBLE PRECISION thresh
170 INTEGER iwork( * ), nsval( * ), nval( * )
171 DOUBLE PRECISION ab( * ), ainv( * ),
b( * ), rwork( * ),
172 $ work( * ), x( * ), xact( * )
178 INTEGER ntype1, ntypes
179 parameter( ntype1 = 9, ntypes = 17 )
181 parameter( ntests = 8 )
183 parameter( ntran = 3 )
184 DOUBLE PRECISION one, zero
185 parameter( one = 1.0d+0, zero = 0.0d+0 )
188 CHARACTER diag, norm, trans, uplo, xtype
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,
197 CHARACTER transs( ntran ), uplos( 2 )
198 INTEGER iseed( 4 ), iseedy( 4 )
199 DOUBLE PRECISION result( ntests )
215 INTEGER infot, iounit
218 COMMON / infoc / infot, iounit, ok, lerr
219 COMMON / srnamc / srnamt
225 DATA iseedy / 1988, 1989, 1990, 1991 /
226 DATA uplos /
'U',
'L' / , transs /
'N',
'T',
'C' /
232 path( 1: 1 ) =
'Double precision'
238 iseed( i ) = iseedy( i )
244 $ CALL
derrtr( path, nout )
269 ELSE IF( ik.EQ.2 )
THEN
271 ELSE IF( ik.EQ.3 )
THEN
273 ELSE IF( ik.EQ.4 )
THEN
278 DO 90 imat = 1, nimat
282 IF( .NOT.dotype( imat ) )
289 uplo = uplos( iuplo )
294 CALL
dlattb( imat, uplo,
'No transpose', diag, iseed,
295 $ n, kd, ab, ldab, x, work, info )
299 IF(
lsame( diag,
'N' ) )
THEN
308 CALL
dlaset(
'Full', n, n, zero, one, ainv, lda )
309 IF(
lsame( uplo,
'U' ) )
THEN
311 CALL
dtbsv( uplo,
'No transpose', diag,
j, kd,
312 $ ab, ldab, ainv( (
j-1 )*lda+1 ), 1 )
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 )
324 anorm =
dlantb(
'1', uplo, diag, n, kd, ab, ldab,
326 ainvnm =
dlantr(
'1', uplo, diag, n, n, ainv, lda,
328 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
331 rcondo = ( one / anorm ) / ainvnm
336 anorm =
dlantb(
'I', uplo, diag, n, kd, ab, ldab,
338 ainvnm =
dlantr(
'I', uplo, diag, n, n, ainv, lda,
340 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
343 rcondi = ( one / anorm ) / ainvnm
350 DO 50 itran = 1, ntran
354 trans = transs( itran )
355 IF( itran.EQ.1 )
THEN
367 CALL
dlarhs( path, xtype, uplo, trans, n, n, kd,
368 $ idiag, nrhs, ab, ldab, xact, lda,
369 $
b, lda, iseed, info )
371 CALL
dlacpy(
'Full', n, nrhs,
b, lda, x, lda )
374 CALL
dtbtrs( uplo, trans, diag, n, kd, nrhs, ab,
375 $ ldab, x, lda, info )
380 $ CALL
alaerh( path,
'DTBTRS', info, 0,
381 $ uplo // trans // diag, n, n, kd,
382 $ kd, nrhs, imat, nfail, nerrs,
385 CALL
dtbt02( uplo, trans, diag, n, kd, nrhs, ab,
386 $ ldab, x, lda,
b, lda, work,
392 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
400 CALL
dtbrfs( uplo, trans, diag, n, kd, nrhs, ab,
401 $ ldab,
b, lda, x, lda, rwork,
402 $ rwork( nrhs+1 ), work, iwork,
408 $ CALL
alaerh( path,
'DTBRFS', info, 0,
409 $ uplo // trans // diag, n, n, kd,
410 $ kd, nrhs, imat, nfail, nerrs,
413 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
415 CALL
dtbt05( uplo, trans, diag, n, kd, nrhs, ab,
416 $ ldab,
b, lda, x, lda, xact, lda,
417 $ rwork, rwork( nrhs+1 ),
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 )
440 IF( itran.EQ.1 )
THEN
448 CALL
dtbcon( norm, uplo, diag, n, kd, ab, ldab,
449 $ rcond, work, iwork, info )
454 $ CALL
alaerh( path,
'DTBCON', info, 0,
455 $ norm // uplo // diag, n, n, kd, kd,
456 $ -1, imat, nfail, nerrs, nout )
458 CALL
dtbt06( rcond, rcondc, uplo, diag, n, kd, ab,
459 $ ldab, rwork, result( 6 ) )
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 )
478 DO 120 imat = ntype1 + 1, nimat2
482 IF( .NOT.dotype( imat ) )
489 uplo = uplos( iuplo )
490 DO 100 itran = 1, ntran
494 trans = transs( itran )
499 CALL
dlattb( imat, uplo, trans, diag, iseed, n, kd,
500 $ ab, ldab, x, work, info )
506 CALL
dcopy( n, x, 1,
b, 1 )
507 CALL
dlatbs( uplo, trans, diag,
'N', n, kd, ab,
508 $ ldab,
b, scale, rwork, info )
513 $ CALL
alaerh( path,
'DLATBS', info, 0,
514 $ uplo // trans // diag //
'N', n, n,
515 $ kd, kd, -1, imat, nfail, nerrs,
518 CALL
dtbt03( uplo, trans, diag, n, kd, 1, ab, ldab,
519 $ scale, rwork, one,
b, lda, x, lda,
520 $ work, result( 7 ) )
525 CALL
dcopy( n, x, 1,
b, 1 )
526 CALL
dlatbs( uplo, trans, diag,
'Y', n, kd, ab,
527 $ ldab,
b, scale, rwork, info )
532 $ CALL
alaerh( path,
'DLATBS', info, 0,
533 $ uplo // trans // diag //
'Y', n, n,
534 $ kd, kd, -1, imat, nfail, nerrs,
537 CALL
dtbt03( uplo, trans, diag, n, kd, 1, ab, ldab,
538 $ scale, rwork, one,
b, lda, x, lda,
539 $ work, result( 8 ) )
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 )
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 )
567 CALL
alasum( path, nout, nfail, nrun, nerrs )
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,
')=',
575 9997
FORMAT( 1x, a,
'( ''', a1,
''', ''', a1,
''', ''', a1,
''', ''',
576 $ a1,
''',', i5,
',', i5,
', ... ), type ', i2,
', test(',
subroutine dtbsv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
DTBSV
subroutine dchktb(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, AB, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
DCHKTB
subroutine dtbtrs(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
DTBTRS
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine dlatbs(UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, SCALE, CNORM, INFO)
DLATBS solves a triangular banded system of equations.
subroutine derrtr(PATH, NUNIT)
DERRTR
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
subroutine dtbt02(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, X, LDX, B, LDB, WORK, RESID)
DTBT02
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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.
logical function lsame(CA, CB)
LSAME
subroutine dtbt03(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
DTBT03
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine dtbt05(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DTBT05
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.
subroutine dtbcon(NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, IWORK, INFO)
DTBCON
subroutine dlattb(IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, LDAB, B, WORK, INFO)
DLATTB
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dtbt06(RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB, WORK, RAT)
DTBT06
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
subroutine dtbrfs(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DTBRFS
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...