147 SUBROUTINE zchkgt( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
148 $ A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT )
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 )
195 DOUBLE PRECISION DGET06, DZASUM, ZLANGT
196 EXTERNAL dget06, dzasum, zlangt
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 )