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 )