162 SUBROUTINE zchktr( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
163 $ thresh, tsterr, nmax, a, ainv, b, x, xact,
164 $ work, rwork, nout )
173 INTEGER NMAX, NN, NNB, NNS, NOUT
174 DOUBLE PRECISION THRESH
178 INTEGER NBVAL( * ), NSVAL( * ), NVAL( * )
179 DOUBLE PRECISION RWORK( * )
180 COMPLEX*16 A( * ), AINV( * ), B( * ), WORK( * ), X( * ),
187 INTEGER NTYPE1, NTYPES
188 parameter( ntype1 = 10, ntypes = 18 )
190 parameter( ntests = 9 )
192 parameter( ntran = 3 )
193 DOUBLE PRECISION ONE, ZERO
194 parameter( one = 1.0d0, zero = 0.0d0 )
197 CHARACTER DIAG, NORM, TRANS, UPLO, XTYPE
199 INTEGER I, IDIAG, IMAT, IN, INB, INFO, IRHS, ITRAN,
200 $ iuplo, k, lda, n, nb, nerrs, nfail, nrhs, nrun
201 DOUBLE PRECISION AINVNM, ANORM, DUMMY, RCOND, RCONDC, RCONDI,
205 CHARACTER TRANSS( ntran ), UPLOS( 2 )
206 INTEGER ISEED( 4 ), ISEEDY( 4 )
207 DOUBLE PRECISION RESULT( ntests )
211 DOUBLE PRECISION ZLANTR
212 EXTERNAL lsame, zlantr
223 INTEGER INFOT, IOUNIT
226 COMMON / infoc / infot, iounit, ok, lerr
227 COMMON / srnamc / srnamt
233 DATA iseedy / 1988, 1989, 1990, 1991 /
234 DATA uplos /
'U',
'L' / , transs /
'N',
'T',
'C' /
240 path( 1: 1 ) =
'Zomplex precision'
246 iseed( i ) = iseedy( i )
252 $ CALL
zerrtr( path, nout )
263 DO 80 imat = 1, ntype1
267 IF( .NOT.dotype( imat ) )
274 uplo = uplos( iuplo )
279 CALL
zlattr( imat, uplo,
'No transpose', diag, iseed, n,
280 $ a, lda, x, work, rwork, info )
284 IF( lsame( diag,
'N' ) )
THEN
300 CALL
zlacpy( uplo, n, n, a, lda, ainv, lda )
302 CALL
ztrtri( uplo, diag, n, ainv, lda, info )
307 $ CALL
alaerh( path,
'ZTRTRI', info, 0, uplo // diag,
308 $ n, n, -1, -1, nb, imat, nfail, nerrs,
313 anorm = zlantr(
'I', uplo, diag, n, n, a, lda, rwork )
314 ainvnm = zlantr(
'I', uplo, diag, n, n, ainv, lda,
316 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
319 rcondi = ( one / anorm ) / ainvnm
326 CALL
ztrt01( uplo, diag, n, a, lda, ainv, lda, rcondo,
327 $ rwork, result( 1 ) )
330 IF( result( 1 ).GE.thresh )
THEN
331 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
332 $ CALL
alahd( nout, path )
333 WRITE( nout, fmt = 9999 )uplo, diag, n, nb, imat,
348 DO 30 itran = 1, ntran
352 trans = transs( itran )
353 IF( itran.EQ.1 )
THEN
365 CALL
zlarhs( path, xtype, uplo, trans, n, n, 0,
366 $ idiag, nrhs, a, lda, xact, lda, b,
369 CALL
zlacpy(
'Full', n, nrhs, b, lda, x, lda )
372 CALL
ztrtrs( uplo, trans, diag, n, nrhs, a, lda,
378 $ CALL
alaerh( path,
'ZTRTRS', info, 0,
379 $ uplo // trans // diag, n, n, -1,
380 $ -1, nrhs, imat, nfail, nerrs,
388 CALL
ztrt02( uplo, trans, diag, n, nrhs, a, lda,
389 $ x, lda, b, lda, work, rwork,
395 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
403 CALL
ztrrfs( uplo, trans, diag, n, nrhs, a, lda,
404 $ b, lda, x, lda, rwork,
405 $ rwork( nrhs+1 ), work,
406 $ rwork( 2*nrhs+1 ), info )
411 $ CALL
alaerh( path,
'ZTRRFS', info, 0,
412 $ uplo // trans // diag, n, n, -1,
413 $ -1, nrhs, imat, nfail, nerrs,
416 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
418 CALL
ztrt05( uplo, trans, diag, n, nrhs, a, lda,
419 $ b, lda, x, lda, xact, lda, rwork,
420 $ rwork( nrhs+1 ), result( 5 ) )
426 IF( result( k ).GE.thresh )
THEN
427 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
428 $ CALL
alahd( nout, path )
429 WRITE( nout, fmt = 9998 )uplo, trans,
430 $ diag, n, nrhs, imat, k, result( k )
442 IF( itran.EQ.1 )
THEN
450 CALL
ztrcon( norm, uplo, diag, n, a, lda, rcond,
451 $ work, rwork, info )
456 $ CALL
alaerh( path,
'ZTRCON', info, 0,
457 $ norm // uplo // diag, n, n, -1, -1,
458 $ -1, imat, nfail, nerrs, nout )
460 CALL
ztrt06( rcond, rcondc, uplo, diag, n, a, lda,
461 $ rwork, result( 7 ) )
465 IF( result( 7 ).GE.thresh )
THEN
466 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
467 $ CALL
alahd( nout, path )
468 WRITE( nout, fmt = 9997 )norm, uplo, n, imat,
480 DO 110 imat = ntype1 + 1, ntypes
484 IF( .NOT.dotype( imat ) )
491 uplo = uplos( iuplo )
492 DO 90 itran = 1, ntran
496 trans = transs( itran )
501 CALL
zlattr( imat, uplo, trans, diag, iseed, n, a,
502 $ lda, x, work, rwork, info )
508 CALL
zcopy( n, x, 1, b, 1 )
509 CALL
zlatrs( uplo, trans, diag,
'N', n, a, lda, b,
510 $ scale, rwork, info )
515 $ CALL
alaerh( path,
'ZLATRS', info, 0,
516 $ uplo // trans // diag //
'N', n, n,
517 $ -1, -1, -1, imat, nfail, nerrs, nout )
519 CALL
ztrt03( uplo, trans, diag, n, 1, a, lda, scale,
520 $ rwork, one, b, lda, x, lda, work,
526 CALL
zcopy( n, x, 1, b( n+1 ), 1 )
527 CALL
zlatrs( uplo, trans, diag,
'Y', n, a, lda,
528 $ b( n+1 ), scale, rwork, info )
533 $ CALL
alaerh( path,
'ZLATRS', info, 0,
534 $ uplo // trans // diag //
'Y', n, n,
535 $ -1, -1, -1, imat, nfail, nerrs, nout )
537 CALL
ztrt03( uplo, trans, diag, n, 1, a, lda, scale,
538 $ rwork, one, b( n+1 ), lda, x, lda, work,
544 IF( result( 8 ).GE.thresh )
THEN
545 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
546 $ CALL
alahd( nout, path )
547 WRITE( nout, fmt = 9996 )
'ZLATRS', uplo, trans,
548 $ diag,
'N', n, imat, 8, result( 8 )
551 IF( result( 9 ).GE.thresh )
THEN
552 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
553 $ CALL
alahd( nout, path )
554 WRITE( nout, fmt = 9996 )
'ZLATRS', uplo, trans,
555 $ diag,
'Y', n, imat, 9, result( 9 )
566 CALL
alasum( path, nout, nfail, nrun, nerrs )
568 9999
FORMAT(
' UPLO=''', a1,
''', DIAG=''', a1,
''', N=', i5,
', NB=',
569 $ i4,
', type ', i2,
', test(', i2,
')= ', g12.5 )
570 9998
FORMAT(
' UPLO=''', a1,
''', TRANS=''', a1,
''', DIAG=''', a1,
571 $
''', N=', i5,
', NB=', i4,
', type ', i2,
',
572 $ test(', i2,
')= ', g12.5 )
573 9997
FORMAT(
' NORM=''', a1,
''', UPLO =''', a1,
''', N=', i5,
',',
574 $ 11x,
' type ', i2,
', test(', i2,
')=', g12.5 )
575 9996
FORMAT( 1x, a,
'( ''', a1,
''', ''', a1,
''', ''', a1,
''', ''',
576 $ a1,
''',', i5,
', ... ), type ', i2,
', test(', i2,
')=',
subroutine zerrtr(PATH, NUNIT)
ZERRTR
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine ztrrfs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZTRRFS
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine ztrt01(UPLO, DIAG, N, A, LDA, AINV, LDAINV, RCOND, RWORK, RESID)
ZTRT01
subroutine ztrcon(NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, RWORK, INFO)
ZTRCON
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
subroutine ztrt02(UPLO, TRANS, DIAG, N, NRHS, A, LDA, X, LDX, B, LDB, WORK, RWORK, RESID)
ZTRT02
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine ztrt05(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZTRT05
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine ztrtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
ZTRTRS
subroutine ztrt03(UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
ZTRT03
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 zchktr(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AINV, B, X, XACT, WORK, RWORK, NOUT)
ZCHKTR
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine ztrtri(UPLO, DIAG, N, A, LDA, INFO)
ZTRTRI
subroutine ztrt06(RCOND, RCONDC, UPLO, DIAG, N, A, LDA, RWORK, RAT)
ZTRT06
subroutine zlattr(IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, WORK, RWORK, INFO)
ZLATTR