160 SUBROUTINE zchktr( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
161 $ THRESH, TSTERR, NMAX, A, AINV, B, X, XACT,
162 $ WORK, RWORK, NOUT )
170 INTEGER NMAX, NN, NNB, NNS, NOUT
171 DOUBLE PRECISION THRESH
175 INTEGER NBVAL( * ), NSVAL( * ), NVAL( * )
176 DOUBLE PRECISION RWORK( * )
177 COMPLEX*16 A( * ), AINV( * ), B( * ), WORK( * ), X( * ),
184 INTEGER NTYPE1, NTYPES
185 PARAMETER ( NTYPE1 = 10, ntypes = 18 )
187 parameter( ntests = 10 )
189 parameter( ntran = 3 )
190 DOUBLE PRECISION ONE, ZERO
191 parameter( one = 1.0d0, zero = 0.0d0 )
194 CHARACTER DIAG, NORM, TRANS, UPLO, XTYPE
196 INTEGER I, IDIAG, IMAT, IN, INB, INFO, IRHS, ITRAN,
197 $ iuplo, k, lda, n, nb, nerrs, nfail, nrhs, nrun
198 DOUBLE PRECISION AINVNM, ANORM, BIGNUM, DUMMY, RCOND, RCONDC,
199 $ RCONDI, RCONDO, RES, SCALE, DLAMCH
202 CHARACTER TRANSS( NTRAN ), UPLOS( 2 )
203 INTEGER ISEED( 4 ), ISEEDY( 4 )
204 DOUBLE PRECISION RESULT( NTESTS ), RWORK2( 2*NMAX ),
209 DOUBLE PRECISION ZLANTR
210 EXTERNAL lsame, zlantr
221 INTEGER INFOT, IOUNIT
224 COMMON / infoc / infot, iounit, ok, lerr
225 COMMON / srnamc / srnamt
231 DATA iseedy / 1988, 1989, 1990, 1991 /
232 DATA uplos /
'U',
'L' / , transs /
'N',
'T',
'C' /
238 path( 1: 1 ) =
'Zomplex precision'
240 bignum = dlamch(
'Overflow') / dlamch(
'Precision')
245 iseed( i ) = iseedy( i )
251 $
CALL zerrtr( path, nout )
262 DO 80 imat = 1, ntype1
266 IF( .NOT.dotype( imat ) )
273 uplo = uplos( iuplo )
278 CALL zlattr( imat, uplo,
'No transpose', diag, iseed, n,
279 $ a, lda, x, work, rwork, info )
283 IF( lsame( diag,
'N' ) )
THEN
299 CALL zlacpy( uplo, n, n, a, lda, ainv, lda )
301 CALL ztrtri( uplo, diag, n, ainv, lda, info )
306 $
CALL alaerh( path,
'ZTRTRI', info, 0, uplo // diag,
307 $ n, n, -1, -1, nb, imat, nfail, nerrs,
312 anorm = zlantr(
'I', uplo, diag, n, n, a, lda, rwork )
313 ainvnm = zlantr(
'I', uplo, diag, n, n, ainv, lda,
315 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
318 rcondi = ( one / anorm ) / ainvnm
325 CALL ztrt01( uplo, diag, n, a, lda, ainv, lda, rcondo,
326 $ rwork, result( 1 ) )
329 IF( result( 1 ).GE.thresh )
THEN
330 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
331 $
CALL alahd( nout, path )
332 WRITE( nout, fmt = 9999 )uplo, diag, n, nb, imat,
347 DO 30 itran = 1, ntran
351 trans = transs( itran )
352 IF( itran.EQ.1 )
THEN
364 CALL zlarhs( path, xtype, uplo, trans, n, n, 0,
365 $ idiag, nrhs, a, lda, xact, lda, b,
368 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
371 CALL ztrtrs( uplo, trans, diag, n, nrhs, a, lda,
377 $
CALL alaerh( path,
'ZTRTRS', info, 0,
378 $ uplo // trans // diag, n, n, -1,
379 $ -1, nrhs, imat, nfail, nerrs,
385 $ dummy = dble( a( 1 ) )
387 CALL ztrt02( uplo, trans, diag, n, nrhs, a, lda,
388 $ x, lda, b, lda, work, rwork,
394 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
402 CALL ztrrfs( uplo, trans, diag, n, nrhs, a, lda,
403 $ b, lda, x, lda, rwork,
404 $ rwork( nrhs+1 ), work,
405 $ rwork( 2*nrhs+1 ), info )
410 $
CALL alaerh( path,
'ZTRRFS', info, 0,
411 $ uplo // trans // diag, n, n, -1,
412 $ -1, nrhs, imat, nfail, nerrs,
415 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
417 CALL ztrt05( uplo, trans, diag, n, nrhs, a, lda,
418 $ b, lda, x, lda, xact, lda, rwork,
419 $ rwork( nrhs+1 ), result( 5 ) )
425 IF( result( k ).GE.thresh )
THEN
426 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
427 $
CALL alahd( nout, path )
428 WRITE( nout, fmt = 9998 )uplo, trans,
429 $ diag, n, nrhs, imat, k, result( k )
441 IF( itran.EQ.1 )
THEN
449 CALL ztrcon( norm, uplo, diag, n, a, lda, rcond,
450 $ work, rwork, info )
455 $
CALL alaerh( path,
'ZTRCON', info, 0,
456 $ norm // uplo // diag, n, n, -1, -1,
457 $ -1, imat, nfail, nerrs, nout )
459 CALL ztrt06( rcond, rcondc, uplo, diag, n, a, lda,
460 $ rwork, result( 7 ) )
464 IF( result( 7 ).GE.thresh )
THEN
465 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
466 $
CALL alahd( nout, path )
467 WRITE( nout, fmt = 9997 )norm, uplo, n, imat,
479 DO 110 imat = ntype1 + 1, ntypes
483 IF( .NOT.dotype( imat ) )
490 uplo = uplos( iuplo )
491 DO 90 itran = 1, ntran
495 trans = transs( itran )
500 CALL zlattr( imat, uplo, trans, diag, iseed, n, a,
501 $ lda, x, work, rwork, info )
507 CALL zcopy( n, x, 1, b, 1 )
508 CALL zlatrs( uplo, trans, diag,
'N', n, a, lda, b,
509 $ scale, rwork, info )
514 $
CALL alaerh( path,
'ZLATRS', info, 0,
515 $ uplo // trans // diag //
'N', n, n,
516 $ -1, -1, -1, imat, nfail, nerrs, nout )
518 CALL ztrt03( uplo, trans, diag, n, 1, a, lda, scale,
519 $ rwork, one, b, lda, x, lda, work,
525 CALL zcopy( n, x, 1, b( n+1 ), 1 )
526 CALL zlatrs( uplo, trans, diag,
'Y', n, a, lda,
527 $ b( n+1 ), scale, rwork, info )
532 $
CALL alaerh( path,
'ZLATRS', info, 0,
533 $ uplo // trans // diag //
'Y', n, n,
534 $ -1, -1, -1, imat, nfail, nerrs, nout )
536 CALL ztrt03( uplo, trans, diag, n, 1, a, lda, scale,
537 $ rwork, one, b( n+1 ), lda, x, lda, work,
544 CALL zcopy( n, x, 1, b, 1 )
545 CALL zcopy( n, x, 1, b( n+1 ), 1 )
546 CALL zdscal( n, bignum, b( n+1 ), 1 )
547 CALL zlatrs3( uplo, trans, diag,
'N', n, 2, a, lda,
548 $ b, max(1, n), scale3, rwork, rwork2,
554 $
CALL alaerh( path,
'ZLATRS3', info, 0,
555 $ uplo // trans // diag //
'N', n, n,
556 $ -1, -1, -1, imat, nfail, nerrs, nout )
557 CALL ztrt03( uplo, trans, diag, n, 1, a, lda,
558 $ scale3( 1 ), rwork, one, b( 1 ), lda,
559 $ x, lda, work, result( 10 ) )
560 CALL zdscal( n, bignum, x, 1 )
561 CALL ztrt03( uplo, trans, diag, n, 1, a, lda,
562 $ scale3( 2 ), rwork, one, b( n+1 ), lda,
563 $ x, lda, work, res )
564 result( 10 ) = max( result( 10 ), res )
569 IF( result( 8 ).GE.thresh )
THEN
570 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
571 $
CALL alahd( nout, path )
572 WRITE( nout, fmt = 9996 )
'ZLATRS', uplo, trans,
573 $ diag,
'N', n, imat, 8, result( 8 )
576 IF( result( 9 ).GE.thresh )
THEN
577 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
578 $
CALL alahd( nout, path )
579 WRITE( nout, fmt = 9996 )
'ZLATRS', uplo, trans,
580 $ diag,
'Y', n, imat, 9, result( 9 )
583 IF( result( 10 ).GE.thresh )
THEN
584 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
585 $
CALL alahd( nout, path )
586 WRITE( nout, fmt = 9996 )
'ZLATRS3', uplo, trans,
587 $ diag,
'N', n, imat, 10, result( 10 )
598 CALL alasum( path, nout, nfail, nrun, nerrs )
600 9999
FORMAT(
' UPLO=''', a1,
''', DIAG=''', a1,
''', N=', i5,
', NB=',
601 $ i4,
', type ', i2,
', test(', i2,
')= ', g12.5 )
602 9998
FORMAT(
' UPLO=''', a1,
''', TRANS=''', a1,
''', DIAG=''', a1,
603 $
''', N=', i5,
', NB=', i4,
', type ', i2,
', test(',
605 9997
FORMAT(
' NORM=''', a1,
''', UPLO =''', a1,
''', N=', i5,
',',
606 $ 11x,
' type ', i2,
', test(', i2,
')=', g12.5 )
607 9996
FORMAT( 1x, a,
'( ''', a1,
''', ''', a1,
''', ''', a1,
''', ''',
608 $ a1,
''',', i5,
', ... ), type ', i2,
', test(', i2,
')=',
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
subroutine xlaenv(ispec, nvalue)
XLAENV
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 zlatrs3(uplo, trans, diag, normin, n, nrhs, a, lda, x, ldx, scale, cnorm, work, lwork, info)
ZLATRS3 solves a triangular system of equations with the scale factors set to prevent overflow.
subroutine zlatrs(uplo, trans, diag, normin, n, a, lda, x, scale, cnorm, info)
ZLATRS solves a triangular system of equations with the scale factor set to prevent overflow.
subroutine zdscal(n, da, zx, incx)
ZDSCAL
subroutine ztrcon(norm, uplo, diag, n, a, lda, rcond, work, rwork, info)
ZTRCON
subroutine ztrrfs(uplo, trans, diag, n, nrhs, a, lda, b, ldb, x, ldx, ferr, berr, work, rwork, info)
ZTRRFS
subroutine ztrtri(uplo, diag, n, a, lda, info)
ZTRTRI
subroutine ztrtrs(uplo, trans, diag, n, nrhs, a, lda, b, ldb, info)
ZTRTRS
subroutine zchktr(dotype, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, ainv, b, x, xact, work, rwork, nout)
ZCHKTR
subroutine zerrtr(path, nunit)
ZERRTR
subroutine zget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
ZGET04
subroutine zlattr(imat, uplo, trans, diag, iseed, n, a, lda, b, work, rwork, info)
ZLATTR
subroutine ztrt01(uplo, diag, n, a, lda, ainv, ldainv, rcond, rwork, resid)
ZTRT01
subroutine ztrt02(uplo, trans, diag, n, nrhs, a, lda, x, ldx, b, ldb, work, rwork, resid)
ZTRT02
subroutine ztrt03(uplo, trans, diag, n, nrhs, a, lda, scale, cnorm, tscal, x, ldx, b, ldb, work, resid)
ZTRT03
subroutine ztrt05(uplo, trans, diag, n, nrhs, a, lda, b, ldb, x, ldx, xact, ldxact, ferr, berr, reslts)
ZTRT05
subroutine ztrt06(rcond, rcondc, uplo, diag, n, a, lda, rwork, rat)
ZTRT06