139 SUBROUTINE zdrvgt( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, AF,
140 $ b, x, xact, work, rwork, iwork, nout )
149 INTEGER NN, NOUT, NRHS
150 DOUBLE PRECISION THRESH
154 INTEGER IWORK( * ), NVAL( * )
155 DOUBLE PRECISION RWORK( * )
156 COMPLEX*16 A( * ), AF( * ), B( * ), WORK( * ), X( * ),
163 DOUBLE PRECISION ONE, ZERO
164 parameter( one = 1.0d+0, zero = 0.0d+0 )
166 parameter( ntypes = 12 )
168 parameter( ntests = 6 )
171 LOGICAL TRFCON, ZEROT
172 CHARACTER DIST, FACT, TRANS, TYPE
174 INTEGER I, IFACT, IMAT, IN, INFO, ITRAN, IX, IZERO, J,
175 $ k, k1, kl, koff, ku, lda, m, mode, n, nerrs,
176 $ nfail, nimat, nrun, nt
177 DOUBLE PRECISION AINVNM, ANORM, ANORMI, ANORMO, COND, RCOND,
178 $ rcondc, rcondi, rcondo
181 CHARACTER TRANSS( 3 )
182 INTEGER ISEED( 4 ), ISEEDY( 4 )
183 DOUBLE PRECISION RESULT( ntests ), Z( 3 )
186 DOUBLE PRECISION DGET06, DZASUM, ZLANGT
187 EXTERNAL dget06, dzasum, zlangt
196 INTRINSIC dcmplx, max
204 COMMON / infoc / infot, nunit, ok, lerr
205 COMMON / srnamc / srnamt
208 DATA iseedy / 0, 0, 0, 1 / , transs /
'N',
'T',
213 path( 1: 1 ) =
'Zomplex precision'
219 iseed( i ) = iseedy( i )
225 $ CALL
zerrvx( path, nout )
239 DO 130 imat = 1, nimat
243 IF( .NOT.dotype( imat ) )
248 CALL
zlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
251 zerot = imat.GE.8 .AND. imat.LE.10
256 koff = max( 2-ku, 3-max( 1, n ) )
258 CALL
zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE, COND,
259 $ anorm, kl, ku,
'Z', af( koff ), 3, work,
265 CALL
alaerh( path,
'ZLATMS', info, 0,
' ', n, n, kl,
266 $ ku, -1, imat, nfail, nerrs, nout )
272 CALL
zcopy( n-1, af( 4 ), 3, a, 1 )
273 CALL
zcopy( n-1, af( 3 ), 3, a( n+m+1 ), 1 )
275 CALL
zcopy( n, af( 2 ), 3, a( m+1 ), 1 )
281 IF( .NOT.zerot .OR. .NOT.dotype( 7 ) )
THEN
285 CALL
zlarnv( 2, iseed, n+2*m, a )
287 $ CALL
zdscal( n+2*m, anorm, a, 1 )
288 ELSE IF( izero.GT.0 )
THEN
293 IF( izero.EQ.1 )
THEN
297 ELSE IF( izero.EQ.n )
THEN
301 a( 2*n-2+izero ) = z( 1 )
302 a( n-1+izero ) = z( 2 )
309 IF( .NOT.zerot )
THEN
311 ELSE IF( imat.EQ.8 )
THEN
319 ELSE IF( imat.EQ.9 )
THEN
327 DO 20 i = izero, n - 1
338 IF( ifact.EQ.1 )
THEN
353 ELSE IF( ifact.EQ.1 )
THEN
354 CALL
zcopy( n+2*m, a, 1, af, 1 )
358 anormo = zlangt(
'1', n, a, a( m+1 ), a( n+m+1 ) )
359 anormi = zlangt(
'I', n, a, a( m+1 ), a( n+m+1 ) )
363 CALL
zgttrf( n, af, af( m+1 ), af( n+m+1 ),
364 $ af( n+2*m+1 ), iwork, info )
375 CALL
zgttrs(
'No transpose', n, 1, af, af( m+1 ),
376 $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
378 ainvnm = max( ainvnm, dzasum( n, x, 1 ) )
383 IF( anormo.LE.zero .OR. ainvnm.LE.zero )
THEN
386 rcondo = ( one / anormo ) / ainvnm
398 CALL
zgttrs(
'Conjugate transpose', n, 1, af,
399 $ af( m+1 ), af( n+m+1 ), af( n+2*m+1 ),
400 $ iwork, x, lda, info )
401 ainvnm = max( ainvnm, dzasum( n, x, 1 ) )
406 IF( anormi.LE.zero .OR. ainvnm.LE.zero )
THEN
409 rcondi = ( one / anormi ) / ainvnm
414 trans = transs( itran )
415 IF( itran.EQ.1 )
THEN
425 CALL
zlarnv( 2, iseed, n, xact( ix ) )
431 CALL
zlagtm( trans, n, nrhs, one, a, a( m+1 ),
432 $ a( n+m+1 ), xact, lda, zero, b, lda )
434 IF( ifact.EQ.2 .AND. itran.EQ.1 )
THEN
441 CALL
zcopy( n+2*m, a, 1, af, 1 )
442 CALL
zlacpy(
'Full', n, nrhs, b, lda, x, lda )
445 CALL
zgtsv( n, nrhs, af, af( m+1 ), af( n+m+1 ), x,
451 $ CALL
alaerh( path,
'ZGTSV ', info, izero,
' ',
452 $ n, n, 1, 1, nrhs, imat, nfail,
455 IF( izero.EQ.0 )
THEN
459 CALL
zlacpy(
'Full', n, nrhs, b, lda, work,
461 CALL
zgtt02( trans, n, nrhs, a, a( m+1 ),
462 $ a( n+m+1 ), x, lda, work, lda,
467 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
476 IF( result( k ).GE.thresh )
THEN
477 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
478 $ CALL
aladhd( nout, path )
479 WRITE( nout, fmt = 9999 )
'ZGTSV ', n, imat,
489 IF( ifact.GT.1 )
THEN
497 CALL
zlaset(
'Full', n, nrhs, dcmplx( zero ),
498 $ dcmplx( zero ), x, lda )
504 CALL
zgtsvx( fact, trans, n, nrhs, a, a( m+1 ),
505 $ a( n+m+1 ), af, af( m+1 ), af( n+m+1 ),
506 $ af( n+2*m+1 ), iwork, b, lda, x, lda,
507 $ rcond, rwork, rwork( nrhs+1 ), work,
508 $ rwork( 2*nrhs+1 ), info )
513 $ CALL
alaerh( path,
'ZGTSVX', info, izero,
514 $ fact // trans, n, n, 1, 1, nrhs, imat,
515 $ nfail, nerrs, nout )
517 IF( ifact.GE.2 )
THEN
522 CALL
zgtt01( n, a, a( m+1 ), a( n+m+1 ), af,
523 $ af( m+1 ), af( n+m+1 ), af( n+2*m+1 ),
524 $ iwork, work, lda, rwork, result( 1 ) )
535 CALL
zlacpy(
'Full', n, nrhs, b, lda, work, lda )
536 CALL
zgtt02( trans, n, nrhs, a, a( m+1 ),
537 $ a( n+m+1 ), x, lda, work, lda,
542 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
547 CALL
zgtt05( trans, n, nrhs, a, a( m+1 ),
548 $ a( n+m+1 ), b, lda, x, lda, xact, lda,
549 $ rwork, rwork( nrhs+1 ), result( 4 ) )
557 IF( result( k ).GE.thresh )
THEN
558 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
559 $ CALL
aladhd( nout, path )
560 WRITE( nout, fmt = 9998 )
'ZGTSVX', fact, trans,
561 $ n, imat, k, result( k )
568 result( 6 ) = dget06( rcond, rcondc )
569 IF( result( 6 ).GE.thresh )
THEN
570 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
571 $ CALL
aladhd( nout, path )
572 WRITE( nout, fmt = 9998 )
'ZGTSVX', fact, trans, n,
573 $ imat, k, result( k )
576 nrun = nrun + nt - k1 + 2
585 CALL
alasvm( path, nout, nfail, nrun, nerrs )
587 9999
FORMAT( 1x, a,
', N =', i5,
', type ', i2,
', test ', i2,
588 $
', ratio = ', g12.5 )
589 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', TRANS=''', a1,
''', N =',
590 $ i5,
', type ', i2,
', test ', i2,
', ratio = ', g12.5 )
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 zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zdrvgt(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZDRVGT
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zgttrf(N, DL, D, DU, DU2, IPIV, INFO)
ZGTTRF
subroutine zgtt05(TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZGTT05
subroutine zgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
ZGTTRS
subroutine zgtt02(TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
ZGTT02
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zgtsvx(FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZGTSVX computes the solution to system of linear equations A * X = B for GT matrices ...
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine zgtt01(N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
ZGTT01
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine zerrvx(PATH, NUNIT)
ZERRVX
subroutine zgtsv(N, NRHS, DL, D, DU, B, LDB, INFO)
ZGTSV computes the solution to system of linear equations A * X = B for GT matrices ...
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4