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 )
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 alahd(IOUNIT, PATH)
ALAHD
subroutine zerrtr(PATH, NUNIT)
ZERRTR
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine ztrt06(RCOND, RCONDC, UPLO, DIAG, N, A, LDA, RWORK, RAT)
ZTRT06
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine ztrt02(UPLO, TRANS, DIAG, N, NRHS, A, LDA, X, LDX, B, LDB, WORK, RWORK, RESID)
ZTRT02
subroutine ztrcon(NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, RWORK, INFO)
ZTRCON
subroutine ztrt01(UPLO, DIAG, N, A, LDA, AINV, LDAINV, RCOND, RWORK, RESID)
ZTRT01
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
subroutine ztrrfs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZTRRFS
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine ztrtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
ZTRTRS
subroutine zlattr(IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, WORK, RWORK, INFO)
ZLATTR
subroutine ztrt05(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZTRT05
logical function lsame(CA, CB)
LSAME
subroutine ztrtri(UPLO, DIAG, N, A, LDA, INFO)
ZTRTRI
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, or the element of largest absolute value of a trapezoidal or triangular matrix.
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 ztrt03(UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
ZTRT03
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM