157 INTEGER nn, nns, nout
158 DOUBLE PRECISION thresh
162 INTEGER iwork( * ), nsval( * ), nval( * )
163 DOUBLE PRECISION rwork( * )
164 COMPLEX*16 a( * ), af( * ), b( * ), work( * ), x( * ),
171 DOUBLE PRECISION one, zero
172 parameter ( one = 1.0d+0, zero = 0.0d+0 )
174 parameter ( ntypes = 12 )
176 parameter ( ntests = 7 )
179 LOGICAL trfcon, zerot
180 CHARACTER dist, norm, trans, type
182 INTEGER i, imat, in, info, irhs, itran, ix, izero, j,
183 $ k, kl, koff, ku, lda, m, mode, n, nerrs, nfail,
185 DOUBLE PRECISION ainvnm, anorm, cond, rcond, rcondc, rcondi,
189 CHARACTER transs( 3 )
190 INTEGER iseed( 4 ), iseedy( 4 )
191 DOUBLE PRECISION result( ntests )
213 COMMON / infoc / infot, nunit, ok, lerr
214 COMMON / srnamc / srnamt
217 DATA iseedy / 0, 0, 0, 1 / , transs /
'N',
'T',
222 path( 1: 1 ) =
'Zomplex precision'
228 iseed( i ) = iseedy( i )
234 $
CALL zerrge( path, nout )
248 DO 100 imat = 1, nimat
252 IF( .NOT.dotype( imat ) )
257 CALL zlatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
260 zerot = imat.GE.8 .AND. imat.LE.10
265 koff = max( 2-ku, 3-max( 1, n ) )
267 CALL zlatms( n, n, dist, iseed,
TYPE, rwork, mode, cond,
268 $ anorm, kl, ku,
'Z', af( koff ), 3, work,
274 CALL alaerh( path,
'ZLATMS', info, 0,
' ', n, n, kl,
275 $ ku, -1, imat, nfail, nerrs, nout )
281 CALL zcopy( n-1, af( 4 ), 3, a, 1 )
282 CALL zcopy( n-1, af( 3 ), 3, a( n+m+1 ), 1 )
284 CALL zcopy( n, af( 2 ), 3, a( m+1 ), 1 )
290 IF( .NOT.zerot .OR. .NOT.dotype( 7 ) )
THEN
295 CALL zlarnv( 2, iseed, n+2*m, a )
297 $
CALL zdscal( n+2*m, anorm, a, 1 )
298 ELSE IF( izero.GT.0 )
THEN
303 IF( izero.EQ.1 )
THEN
307 ELSE IF( izero.EQ.n )
THEN
311 a( 2*n-2+izero ) = z( 1 )
312 a( n-1+izero ) = z( 2 )
319 IF( .NOT.zerot )
THEN
321 ELSE IF( imat.EQ.8 )
THEN
329 ELSE IF( imat.EQ.9 )
THEN
337 DO 20 i = izero, n - 1
351 CALL zcopy( n+2*m, a, 1, af, 1 )
353 CALL zgttrf( n, af, af( m+1 ), af( n+m+1 ), af( n+2*m+1 ),
359 $
CALL alaerh( path,
'ZGTTRF', info, izero,
' ', n, n, 1,
360 $ 1, -1, imat, nfail, nerrs, nout )
363 CALL zgtt01( n, a, a( m+1 ), a( n+m+1 ), af, af( m+1 ),
364 $ af( n+m+1 ), af( n+2*m+1 ), iwork, work, lda,
365 $ rwork, result( 1 ) )
369 IF( result( 1 ).GE.thresh )
THEN
370 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
371 $
CALL alahd( nout, path )
372 WRITE( nout, fmt = 9999 )n, imat, 1, result( 1 )
378 trans = transs( itran )
379 IF( itran.EQ.1 )
THEN
384 anorm =
zlangt( norm, n, a, a( m+1 ), a( n+m+1 ) )
386 IF( .NOT.trfcon )
THEN
397 CALL zgttrs( trans, n, 1, af, af( m+1 ),
398 $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
400 ainvnm = max( ainvnm,
dzasum( n, x, 1 ) )
405 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
408 rcondc = ( one / anorm ) / ainvnm
410 IF( itran.EQ.1 )
THEN
424 CALL zgtcon( norm, n, af, af( m+1 ), af( n+m+1 ),
425 $ af( n+2*m+1 ), iwork, anorm, rcond, work,
431 $
CALL alaerh( path,
'ZGTCON', info, 0, norm, n, n, -1,
432 $ -1, -1, imat, nfail, nerrs, nout )
434 result( 7 ) =
dget06( rcond, rcondc )
438 IF( result( 7 ).GE.thresh )
THEN
439 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
440 $
CALL alahd( nout, path )
441 WRITE( nout, fmt = 9997 )norm, n, imat, 7,
460 CALL zlarnv( 2, iseed, n, xact( ix ) )
465 trans = transs( itran )
466 IF( itran.EQ.1 )
THEN
474 CALL zlagtm( trans, n, nrhs, one, a, a( m+1 ),
475 $ a( n+m+1 ), xact, lda, zero, b, lda )
480 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
482 CALL zgttrs( trans, n, nrhs, af, af( m+1 ),
483 $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
489 $
CALL alaerh( path,
'ZGTTRS', info, 0, trans, n, n,
490 $ -1, -1, nrhs, imat, nfail, nerrs,
493 CALL zlacpy(
'Full', n, nrhs, b, lda, work, lda )
494 CALL zgtt02( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
495 $ x, lda, work, lda, result( 2 ) )
500 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
507 CALL zgtrfs( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
508 $ af, af( m+1 ), af( n+m+1 ),
509 $ af( n+2*m+1 ), iwork, b, lda, x, lda,
510 $ rwork, rwork( nrhs+1 ), work,
511 $ rwork( 2*nrhs+1 ), info )
516 $
CALL alaerh( path,
'ZGTRFS', info, 0, trans, n, n,
517 $ -1, -1, nrhs, imat, nfail, nerrs,
520 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
522 CALL zgtt05( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
523 $ b, lda, x, lda, xact, lda, rwork,
524 $ rwork( nrhs+1 ), result( 5 ) )
530 IF( result( k ).GE.thresh )
THEN
531 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
532 $
CALL alahd( nout, path )
533 WRITE( nout, fmt = 9998 )trans, n, nrhs, imat,
546 CALL alasum( path, nout, nfail, nrun, nerrs )
548 9999
FORMAT( 12x,
'N =', i5,
',', 10x,
' type ', i2,
', test(', i2,
550 9998
FORMAT(
' TRANS=''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
551 $ i2,
', test(', i2,
') = ', g12.5 )
552 9997
FORMAT(
' NORM =''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
553 $
', test(', i2,
') = ', g12.5 )
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine zgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
ZGTTRS
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, INFO)
ZGTCON
subroutine zgtt05(TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZGTT05
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
subroutine zerrge(PATH, NUNIT)
ZERRGE
double precision function dzasum(N, ZX, INCX)
DZASUM
subroutine zgtt01(N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
ZGTT01
subroutine zgttrf(N, DL, D, DU, DU2, IPIV, INFO)
ZGTTRF
double precision function zlangt(NORM, N, DL, D, DU)
ZLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
double precision function dget06(RCOND, RCONDC)
DGET06
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zgtt02(TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
ZGTT02
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine zlagtm(TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA, B, LDB)
ZLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix...
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine zgtrfs(TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGTRFS