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 = 9 )
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, DUMMY, RCOND, RCONDC, RCONDI,
202 CHARACTER TRANSS( NTRAN ), UPLOS( 2 )
203 INTEGER ISEED( 4 ), ISEEDY( 4 )
204 DOUBLE PRECISION RESULT( NTESTS )
208 DOUBLE PRECISION ZLANTR
220 INTEGER INFOT, IOUNIT
223 COMMON / infoc / infot, iounit, ok, lerr
224 COMMON / srnamc / srnamt
230 DATA iseedy / 1988, 1989, 1990, 1991 /
231 DATA uplos /
'U',
'L' / , transs /
'N',
'T',
'C' /
237 path( 1: 1 ) =
'Zomplex precision'
243 iseed( i ) = iseedy( i )
249 $
CALL zerrtr( path, nout )
260 DO 80 imat = 1, ntype1
264 IF( .NOT.dotype( imat ) )
271 uplo = uplos( iuplo )
276 CALL zlattr( imat, uplo,
'No transpose', diag, iseed, n,
277 $ a, lda, x, work, rwork, info )
281 IF(
lsame( diag,
'N' ) )
THEN
297 CALL zlacpy( uplo, n, n, a, lda, ainv, lda )
299 CALL ztrtri( uplo, diag, n, ainv, lda, info )
304 $
CALL alaerh( path,
'ZTRTRI', info, 0, uplo // diag,
305 $ n, n, -1, -1, nb, imat, nfail, nerrs,
310 anorm =
zlantr(
'I', uplo, diag, n, n, a, lda, rwork )
311 ainvnm =
zlantr(
'I', uplo, diag, n, n, ainv, lda,
313 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
316 rcondi = ( one / anorm ) / ainvnm
323 CALL ztrt01( uplo, diag, n, a, lda, ainv, lda, rcondo,
324 $ rwork, result( 1 ) )
327 IF( result( 1 ).GE.thresh )
THEN
328 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
329 $
CALL alahd( nout, path )
330 WRITE( nout, fmt = 9999 )uplo, diag, n, nb, imat,
345 DO 30 itran = 1, ntran
349 trans = transs( itran )
350 IF( itran.EQ.1 )
THEN
362 CALL zlarhs( path, xtype, uplo, trans, n, n, 0,
363 $ idiag, nrhs, a, lda, xact, lda, b,
366 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
369 CALL ztrtrs( uplo, trans, diag, n, nrhs, a, lda,
375 $
CALL alaerh( path,
'ZTRTRS', info, 0,
376 $ uplo // trans // diag, n, n, -1,
377 $ -1, nrhs, imat, nfail, nerrs,
385 CALL ztrt02( uplo, trans, diag, n, nrhs, a, lda,
386 $ x, lda, b, lda, work, rwork,
392 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
400 CALL ztrrfs( uplo, trans, diag, n, nrhs, a, lda,
401 $ b, lda, x, lda, rwork,
402 $ rwork( nrhs+1 ), work,
403 $ rwork( 2*nrhs+1 ), info )
408 $
CALL alaerh( path,
'ZTRRFS', info, 0,
409 $ uplo // trans // diag, n, n, -1,
410 $ -1, nrhs, imat, nfail, nerrs,
413 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
415 CALL ztrt05( uplo, trans, diag, n, nrhs, a, lda,
416 $ b, lda, x, lda, xact, lda, rwork,
417 $ rwork( nrhs+1 ), result( 5 ) )
423 IF( result( k ).GE.thresh )
THEN
424 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
425 $
CALL alahd( nout, path )
426 WRITE( nout, fmt = 9998 )uplo, trans,
427 $ diag, n, nrhs, imat, k, result( k )
439 IF( itran.EQ.1 )
THEN
447 CALL ztrcon( norm, uplo, diag, n, a, lda, rcond,
448 $ work, rwork, info )
453 $
CALL alaerh( path,
'ZTRCON', info, 0,
454 $ norm // uplo // diag, n, n, -1, -1,
455 $ -1, imat, nfail, nerrs, nout )
457 CALL ztrt06( rcond, rcondc, uplo, diag, n, a, lda,
458 $ rwork, result( 7 ) )
462 IF( result( 7 ).GE.thresh )
THEN
463 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
464 $
CALL alahd( nout, path )
465 WRITE( nout, fmt = 9997 )norm, uplo, n, imat,
477 DO 110 imat = ntype1 + 1, ntypes
481 IF( .NOT.dotype( imat ) )
488 uplo = uplos( iuplo )
489 DO 90 itran = 1, ntran
493 trans = transs( itran )
498 CALL zlattr( imat, uplo, trans, diag, iseed, n, a,
499 $ lda, x, work, rwork, info )
505 CALL zcopy( n, x, 1, b, 1 )
506 CALL zlatrs( uplo, trans, diag,
'N', n, a, lda, b,
507 $ scale, rwork, info )
512 $
CALL alaerh( path,
'ZLATRS', info, 0,
513 $ uplo // trans // diag //
'N', n, n,
514 $ -1, -1, -1, imat, nfail, nerrs, nout )
516 CALL ztrt03( uplo, trans, diag, n, 1, a, lda, scale,
517 $ rwork, one, b, lda, x, lda, work,
523 CALL zcopy( n, x, 1, b( n+1 ), 1 )
524 CALL zlatrs( uplo, trans, diag,
'Y', n, a, lda,
525 $ b( n+1 ), scale, rwork, info )
530 $
CALL alaerh( path,
'ZLATRS', info, 0,
531 $ uplo // trans // diag //
'Y', n, n,
532 $ -1, -1, -1, imat, nfail, nerrs, nout )
534 CALL ztrt03( uplo, trans, diag, n, 1, a, lda, scale,
535 $ rwork, one, b( n+1 ), lda, x, lda, work,
541 IF( result( 8 ).GE.thresh )
THEN
542 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
543 $
CALL alahd( nout, path )
544 WRITE( nout, fmt = 9996 )
'ZLATRS', uplo, trans,
545 $ diag,
'N', n, imat, 8, result( 8 )
548 IF( result( 9 ).GE.thresh )
THEN
549 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
550 $
CALL alahd( nout, path )
551 WRITE( nout, fmt = 9996 )
'ZLATRS', uplo, trans,
552 $ diag,
'Y', n, imat, 9, result( 9 )
563 CALL alasum( path, nout, nfail, nrun, nerrs )
565 9999
FORMAT(
' UPLO=''', a1,
''', DIAG=''', a1,
''', N=', i5,
', NB=',
566 $ i4,
', type ', i2,
', test(', i2,
')= ', g12.5 )
567 9998
FORMAT(
' UPLO=''', a1,
''', TRANS=''', a1,
''', DIAG=''', a1,
568 $
''', N=', i5,
', NB=', i4,
', type ', i2,
',
569 $ test(', i2,
')= ', g12.5 )
570 9997
FORMAT(
' NORM=''', a1,
''', UPLO =''', a1,
''', N=', i5,
',',
571 $ 11x,
' type ', i2,
', test(', i2,
')=', g12.5 )
572 9996
FORMAT( 1x, a,
'( ''', a1,
''', ''', a1,
''', ''', a1,
''', ''',
573 $ a1,
''',', i5,
', ... ), type ', i2,
', test(', i2,
')=',
logical function lsame(CA, CB)
LSAME
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine ztrt06(RCOND, RCONDC, UPLO, DIAG, N, A, LDA, RWORK, RAT)
ZTRT06
subroutine ztrt03(UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
ZTRT03
subroutine ztrt01(UPLO, DIAG, N, A, LDA, AINV, LDAINV, RCOND, RWORK, RESID)
ZTRT01
subroutine ztrt05(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZTRT05
subroutine zlattr(IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, WORK, RWORK, INFO)
ZLATTR
subroutine zerrtr(PATH, NUNIT)
ZERRTR
subroutine ztrt02(UPLO, TRANS, DIAG, N, NRHS, A, LDA, X, LDX, B, LDB, WORK, RWORK, RESID)
ZTRT02
double precision function zlantr(NORM, UPLO, DIAG, M, N, A, LDA, WORK)
ZLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
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 ztrtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
ZTRTRS
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