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(',