147 SUBROUTINE cchktb( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
148 $ NMAX, AB, AINV, B, X, XACT, WORK, RWORK, NOUT )
156 INTEGER NMAX, NN, NNS, NOUT
161 INTEGER NSVAL( * ), NVAL( * )
163 COMPLEX AB( * ), AINV( * ), B( * ), WORK( * ), X( * ),
170 INTEGER NTYPE1, NTYPES
171 parameter( ntype1 = 9, ntypes = 17 )
173 parameter( ntests = 8 )
175 parameter( ntran = 3 )
177 parameter( one = 1.0e+0, zero = 0.0e+0 )
180 CHARACTER DIAG, NORM, TRANS, UPLO, XTYPE
182 INTEGER I, IDIAG, IK, IMAT, IN, INFO, IRHS, ITRAN,
183 $ iuplo, j, k, kd, lda, ldab, n, nerrs, nfail,
184 $ nimat, nimat2, nk, nrhs, nrun
185 REAL AINVNM, ANORM, RCOND, RCONDC, RCONDI, RCONDO,
189 CHARACTER TRANSS( NTRAN ), UPLOS( 2 )
190 INTEGER ISEED( 4 ), ISEEDY( 4 )
191 REAL RESULT( NTESTS )
196 EXTERNAL lsame, clantb, clantr
207 INTEGER INFOT, IOUNIT
210 COMMON / infoc / infot, iounit, ok, lerr
211 COMMON / srnamc / srnamt
214 INTRINSIC cmplx, max, min
217 DATA iseedy / 1988, 1989, 1990, 1991 /
218 DATA uplos /
'U',
'L' / , transs /
'N',
'T',
'C' /
224 path( 1: 1 ) =
'Complex precision'
230 iseed( i ) = iseedy( i )
236 $
CALL cerrtr( path, nout )
261 ELSE IF( ik.EQ.2 )
THEN
263 ELSE IF( ik.EQ.3 )
THEN
265 ELSE IF( ik.EQ.4 )
THEN
270 DO 90 imat = 1, nimat
274 IF( .NOT.dotype( imat ) )
281 uplo = uplos( iuplo )
286 CALL clattb( imat, uplo,
'No transpose', diag, iseed,
287 $ n, kd, ab, ldab, x, work, rwork, info )
291 IF( lsame( diag,
'N' ) )
THEN
300 CALL claset(
'Full', n, n, cmplx( zero ),
301 $ cmplx( one ), ainv, lda )
302 IF( lsame( uplo,
'U' ) )
THEN
304 CALL ctbsv( uplo,
'No transpose', diag, j, kd,
305 $ ab, ldab, ainv( ( j-1 )*lda+1 ), 1 )
309 CALL ctbsv( uplo,
'No transpose', diag, n-j+1,
310 $ kd, ab( ( j-1 )*ldab+1 ), ldab,
311 $ ainv( ( j-1 )*lda+j ), 1 )
317 anorm = clantb(
'1', uplo, diag, n, kd, ab, ldab,
319 ainvnm = clantr(
'1', uplo, diag, n, n, ainv, lda,
321 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
324 rcondo = ( one / anorm ) / ainvnm
329 anorm = clantb(
'I', uplo, diag, n, kd, ab, ldab,
331 ainvnm = clantr(
'I', uplo, diag, n, n, ainv, lda,
333 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
336 rcondi = ( one / anorm ) / ainvnm
343 DO 50 itran = 1, ntran
347 trans = transs( itran )
348 IF( itran.EQ.1 )
THEN
360 CALL clarhs( path, xtype, uplo, trans, n, n, kd,
361 $ idiag, nrhs, ab, ldab, xact, lda,
362 $ b, lda, iseed, info )
364 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
367 CALL ctbtrs( uplo, trans, diag, n, kd, nrhs, ab,
368 $ ldab, x, lda, info )
373 $
CALL alaerh( path,
'CTBTRS', info, 0,
374 $ uplo // trans // diag, n, n, kd,
375 $ kd, nrhs, imat, nfail, nerrs,
378 CALL ctbt02( uplo, trans, diag, n, kd, nrhs, ab,
379 $ ldab, x, lda, b, lda, work, rwork,
385 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
393 CALL ctbrfs( uplo, trans, diag, n, kd, nrhs, ab,
394 $ ldab, b, lda, x, lda, rwork,
395 $ rwork( nrhs+1 ), work,
396 $ rwork( 2*nrhs+1 ), info )
401 $
CALL alaerh( path,
'CTBRFS', info, 0,
402 $ uplo // trans // diag, n, n, kd,
403 $ kd, nrhs, imat, nfail, nerrs,
406 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
408 CALL ctbt05( uplo, trans, diag, n, kd, nrhs, ab,
409 $ ldab, b, lda, x, lda, xact, lda,
410 $ rwork, rwork( nrhs+1 ),
417 IF( result( k ).GE.thresh )
THEN
418 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
419 $
CALL alahd( nout, path )
420 WRITE( nout, fmt = 9999 )uplo, trans,
421 $ diag, n, kd, nrhs, imat, k, result( k )
433 IF( itran.EQ.1 )
THEN
441 CALL ctbcon( norm, uplo, diag, n, kd, ab, ldab,
442 $ rcond, work, rwork, info )
447 $
CALL alaerh( path,
'CTBCON', info, 0,
448 $ norm // uplo // diag, n, n, kd, kd,
449 $ -1, imat, nfail, nerrs, nout )
451 CALL ctbt06( rcond, rcondc, uplo, diag, n, kd, ab,
452 $ ldab, rwork, result( 6 ) )
456 IF( result( 6 ).GE.thresh )
THEN
457 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
458 $
CALL alahd( nout, path )
459 WRITE( nout, fmt = 9998 )
'CTBCON', norm, uplo,
460 $ diag, n, kd, imat, 6, result( 6 )
470 DO 120 imat = ntype1 + 1, nimat2
474 IF( .NOT.dotype( imat ) )
481 uplo = uplos( iuplo )
482 DO 100 itran = 1, ntran
486 trans = transs( itran )
491 CALL clattb( imat, uplo, trans, diag, iseed, n, kd,
492 $ ab, ldab, x, work, rwork, info )
498 CALL ccopy( n, x, 1, b, 1 )
499 CALL clatbs( uplo, trans, diag,
'N', n, kd, ab,
500 $ ldab, b, scale, rwork, info )
505 $
CALL alaerh( path,
'CLATBS', info, 0,
506 $ uplo // trans // diag //
'N', n, n,
507 $ kd, kd, -1, imat, nfail, nerrs,
510 CALL ctbt03( uplo, trans, diag, n, kd, 1, ab, ldab,
511 $ scale, rwork, one, b, lda, x, lda,
512 $ work, result( 7 ) )
517 CALL ccopy( n, x, 1, b, 1 )
518 CALL clatbs( uplo, trans, diag,
'Y', n, kd, ab,
519 $ ldab, b, scale, rwork, info )
524 $
CALL alaerh( path,
'CLATBS', info, 0,
525 $ uplo // trans // diag //
'Y', n, n,
526 $ kd, kd, -1, imat, nfail, nerrs,
529 CALL ctbt03( uplo, trans, diag, n, kd, 1, ab, ldab,
530 $ scale, rwork, one, b, lda, x, lda,
531 $ work, result( 8 ) )
536 IF( result( 7 ).GE.thresh )
THEN
537 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
538 $
CALL alahd( nout, path )
539 WRITE( nout, fmt = 9997 )
'CLATBS', uplo, trans,
540 $ diag,
'N', n, kd, imat, 7, result( 7 )
543 IF( result( 8 ).GE.thresh )
THEN
544 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
545 $
CALL alahd( nout, path )
546 WRITE( nout, fmt = 9997 )
'CLATBS', uplo, trans,
547 $ diag,
'Y', n, kd, imat, 8, result( 8 )
559 CALL alasum( path, nout, nfail, nrun, nerrs )
561 9999
FORMAT(
' UPLO=''', a1,
''', TRANS=''', a1,
''',
562 $ DIAG=''', a1,
''', N=', i5,
', KD=', i5,
', NRHS=', i5,
563 $
', type ', i2,
', test(', i2,
')=', g12.5 )
564 9998
FORMAT( 1x, a,
'( ''', a1,
''', ''', a1,
''', ''', a1,
''',',
565 $ i5,
',', i5,
', ... ), type ', i2,
', test(', i2,
')=',
567 9997
FORMAT( 1x, a,
'( ''', a1,
''', ''', a1,
''', ''', a1,
''', ''',
568 $ a1,
''',', i5,
',', i5,
', ... ), type ', i2,
', test(',
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
subroutine clarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
CLARHS
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
subroutine alahd(iounit, path)
ALAHD
subroutine cchktb(dotype, nn, nval, nns, nsval, thresh, tsterr, nmax, ab, ainv, b, x, xact, work, rwork, nout)
CCHKTB
subroutine cerrtr(path, nunit)
CERRTR
subroutine cget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
CGET04
subroutine clattb(imat, uplo, trans, diag, iseed, n, kd, ab, ldab, b, work, rwork, info)
CLATTB
subroutine ctbt02(uplo, trans, diag, n, kd, nrhs, ab, ldab, x, ldx, b, ldb, work, rwork, resid)
CTBT02
subroutine ctbt03(uplo, trans, diag, n, kd, nrhs, ab, ldab, scale, cnorm, tscal, x, ldx, b, ldb, work, resid)
CTBT03
subroutine ctbt05(uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb, x, ldx, xact, ldxact, ferr, berr, reslts)
CTBT05
subroutine ctbt06(rcond, rcondc, uplo, diag, n, kd, ab, ldab, rwork, rat)
CTBT06
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
subroutine clacpy(uplo, m, n, a, lda, b, ldb)
CLACPY copies all or part of one two-dimensional array to another.
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.
subroutine clatbs(uplo, trans, diag, normin, n, kd, ab, ldab, x, scale, cnorm, info)
CLATBS solves a triangular banded system of equations.
subroutine ctbcon(norm, uplo, diag, n, kd, ab, ldab, rcond, work, rwork, info)
CTBCON
subroutine ctbrfs(uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CTBRFS
subroutine ctbsv(uplo, trans, diag, n, k, a, lda, x, incx)
CTBSV
subroutine ctbtrs(uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb, info)
CTBTRS