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 alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
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 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 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 zgtt01(N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
ZGTT01
subroutine aladhd(IOUNIT, PATH)
ALADHD
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 zgttrf(N, DL, D, DU, DU2, IPIV, INFO)
ZGTTRF
subroutine zerrvx(PATH, NUNIT)
ZERRVX
subroutine zdrvgt(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZDRVGT
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 zgtsv(N, NRHS, DL, D, DU, B, LDB, INFO)
ZGTSV computes the solution to system of linear equations A * X = B for GT matrices ...