147 SUBROUTINE zchktb( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
148 $ NMAX, AB, AINV, B, X, XACT, WORK, RWORK, NOUT )
156 INTEGER NMAX, NN, NNS, NOUT
157 DOUBLE PRECISION THRESH
161 INTEGER NSVAL( * ), NVAL( * )
162 DOUBLE PRECISION RWORK( * )
163 COMPLEX*16 AB( * ), AINV( * ), B( * ), WORK( * ), X( * ),
170 INTEGER NTYPE1, NTYPES
171 parameter( ntype1 = 9, ntypes = 17 )
173 parameter( ntests = 8 )
175 parameter( ntran = 3 )
176 DOUBLE PRECISION ONE, ZERO
177 parameter( one = 1.0d+0, zero = 0.0d+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 DOUBLE PRECISION AINVNM, ANORM, RCOND, RCONDC, RCONDI, RCONDO,
189 CHARACTER TRANSS( NTRAN ), UPLOS( 2 )
190 INTEGER ISEED( 4 ), ISEEDY( 4 )
191 DOUBLE PRECISION RESULT( NTESTS )
195 DOUBLE PRECISION ZLANTB, ZLANTR
196 EXTERNAL lsame, zlantb, zlantr
207 INTEGER INFOT, IOUNIT
210 COMMON / infoc / infot, iounit, ok, lerr
211 COMMON / srnamc / srnamt
214 INTRINSIC dcmplx, max, min
217 DATA iseedy / 1988, 1989, 1990, 1991 /
218 DATA uplos /
'U',
'L' / , transs /
'N',
'T',
'C' /
224 path( 1: 1 ) =
'Zomplex precision'
230 iseed( i ) = iseedy( i )
236 $
CALL zerrtr( 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 zlattb( imat, uplo,
'No transpose', diag, iseed,
287 $ n, kd, ab, ldab, x, work, rwork, info )
291 IF( lsame( diag,
'N' ) )
THEN
300 CALL zlaset(
'Full', n, n, dcmplx( zero ),
301 $ dcmplx( one ), ainv, lda )
302 IF( lsame( uplo,
'U' ) )
THEN
304 CALL ztbsv( uplo,
'No transpose', diag, j, kd,
305 $ ab, ldab, ainv( ( j-1 )*lda+1 ), 1 )
309 CALL ztbsv( uplo,
'No transpose', diag, n-j+1,
310 $ kd, ab( ( j-1 )*ldab+1 ), ldab,
311 $ ainv( ( j-1 )*lda+j ), 1 )
317 anorm = zlantb(
'1', uplo, diag, n, kd, ab, ldab,
319 ainvnm = zlantr(
'1', uplo, diag, n, n, ainv, lda,
321 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
324 rcondo = ( one / anorm ) / ainvnm
329 anorm = zlantb(
'I', uplo, diag, n, kd, ab, ldab,
331 ainvnm = zlantr(
'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 zlarhs( path, xtype, uplo, trans, n, n, kd,
361 $ idiag, nrhs, ab, ldab, xact, lda,
362 $ b, lda, iseed, info )
364 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
367 CALL ztbtrs( uplo, trans, diag, n, kd, nrhs, ab,
368 $ ldab, x, lda, info )
373 $
CALL alaerh( path,
'ZTBTRS', info, 0,
374 $ uplo // trans // diag, n, n, kd,
375 $ kd, nrhs, imat, nfail, nerrs,
378 CALL ztbt02( uplo, trans, diag, n, kd, nrhs, ab,
379 $ ldab, x, lda, b, lda, work, rwork,
385 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
393 CALL ztbrfs( 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,
'ZTBRFS', info, 0,
402 $ uplo // trans // diag, n, n, kd,
403 $ kd, nrhs, imat, nfail, nerrs,
406 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
408 CALL ztbt05( 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 ztbcon( norm, uplo, diag, n, kd, ab, ldab,
442 $ rcond, work, rwork, info )
447 $
CALL alaerh( path,
'ZTBCON', info, 0,
448 $ norm // uplo // diag, n, n, kd, kd,
449 $ -1, imat, nfail, nerrs, nout )
451 CALL ztbt06( 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 )
'ZTBCON', 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 zlattb( imat, uplo, trans, diag, iseed, n, kd,
492 $ ab, ldab, x, work, rwork, info )
498 CALL zcopy( n, x, 1, b, 1 )
499 CALL zlatbs( uplo, trans, diag,
'N', n, kd, ab,
500 $ ldab, b, scale, rwork, info )
505 $
CALL alaerh( path,
'ZLATBS', info, 0,
506 $ uplo // trans // diag //
'N', n, n,
507 $ kd, kd, -1, imat, nfail, nerrs,
510 CALL ztbt03( uplo, trans, diag, n, kd, 1, ab, ldab,
511 $ scale, rwork, one, b, lda, x, lda,
512 $ work, result( 7 ) )
517 CALL zcopy( n, x, 1, b, 1 )
518 CALL zlatbs( uplo, trans, diag,
'Y', n, kd, ab,
519 $ ldab, b, scale, rwork, info )
524 $
CALL alaerh( path,
'ZLATBS', info, 0,
525 $ uplo // trans // diag //
'Y', n, n,
526 $ kd, kd, -1, imat, nfail, nerrs,
529 CALL ztbt03( 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 )
'ZLATBS', 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 )
'ZLATBS', 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 zlarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
ZLARHS
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
subroutine alahd(iounit, path)
ALAHD
subroutine zcopy(n, zx, incx, zy, incy)
ZCOPY
subroutine zlacpy(uplo, m, n, a, lda, b, ldb)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zlaset(uplo, m, n, alpha, beta, a, lda)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
subroutine zlatbs(uplo, trans, diag, normin, n, kd, ab, ldab, x, scale, cnorm, info)
ZLATBS solves a triangular banded system of equations.
subroutine ztbcon(norm, uplo, diag, n, kd, ab, ldab, rcond, work, rwork, info)
ZTBCON
subroutine ztbrfs(uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb, x, ldx, ferr, berr, work, rwork, info)
ZTBRFS
subroutine ztbsv(uplo, trans, diag, n, k, a, lda, x, incx)
ZTBSV
subroutine ztbtrs(uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb, info)
ZTBTRS
subroutine zchktb(dotype, nn, nval, nns, nsval, thresh, tsterr, nmax, ab, ainv, b, x, xact, work, rwork, nout)
ZCHKTB
subroutine zerrtr(path, nunit)
ZERRTR
subroutine zget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
ZGET04
subroutine zlattb(imat, uplo, trans, diag, iseed, n, kd, ab, ldab, b, work, rwork, info)
ZLATTB
subroutine ztbt02(uplo, trans, diag, n, kd, nrhs, ab, ldab, x, ldx, b, ldb, work, rwork, resid)
ZTBT02
subroutine ztbt03(uplo, trans, diag, n, kd, nrhs, ab, ldab, scale, cnorm, tscal, x, ldx, b, ldb, work, resid)
ZTBT03
subroutine ztbt05(uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb, x, ldx, xact, ldxact, ferr, berr, reslts)
ZTBT05
subroutine ztbt06(rcond, rcondc, uplo, diag, n, kd, ab, ldab, rwork, rat)
ZTBT06