145 SUBROUTINE cchkgt( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
146 $ A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT )
154 INTEGER NN, NNS, NOUT
159 INTEGER IWORK( * ), NSVAL( * ), NVAL( * )
161 COMPLEX A( * ), AF( * ), B( * ), WORK( * ), X( * ),
169 parameter( one = 1.0e+0, zero = 0.0e+0 )
171 parameter( ntypes = 12 )
173 parameter( ntests = 7 )
176 LOGICAL TRFCON, ZEROT
177 CHARACTER DIST, NORM, TRANS, TYPE
179 INTEGER I, IMAT, IN, INFO, IRHS, ITRAN, IX, IZERO, J,
180 $ k, kl, koff, ku, lda, m, mode, n, nerrs, nfail,
182 REAL AINVNM, ANORM, COND, RCOND, RCONDC, RCONDI,
186 CHARACTER TRANSS( 3 )
187 INTEGER ISEED( 4 ), ISEEDY( 4 )
188 REAL RESULT( NTESTS )
192 REAL CLANGT, SCASUM, SGET06
193 EXTERNAL clangt, scasum, sget06
210 COMMON / infoc / infot, nunit, ok, lerr
211 COMMON / srnamc / srnamt
214 DATA iseedy / 0, 0, 0, 1 / , transs /
'N',
'T',
219 path( 1: 1 ) =
'Complex precision'
225 iseed( i ) = iseedy( i )
231 $
CALL cerrge( path, nout )
245 DO 100 imat = 1, nimat
249 IF( .NOT.dotype( imat ) )
254 CALL clatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
257 zerot = imat.GE.8 .AND. imat.LE.10
262 koff = max( 2-ku, 3-max( 1, n ) )
264 CALL clatms( n, n, dist, iseed,
TYPE, rwork, mode, cond,
265 $ anorm, kl, ku,
'Z', af( koff ), 3, work,
271 CALL alaerh( path,
'CLATMS', info, 0,
' ', n, n, kl,
272 $ ku, -1, imat, nfail, nerrs, nout )
278 CALL ccopy( n-1, af( 4 ), 3, a, 1 )
279 CALL ccopy( n-1, af( 3 ), 3, a( n+m+1 ), 1 )
281 CALL ccopy( n, af( 2 ), 3, a( m+1 ), 1 )
287 IF( .NOT.zerot .OR. .NOT.dotype( 7 ) )
THEN
292 CALL clarnv( 2, iseed, n+2*m, a )
294 $
CALL csscal( n+2*m, anorm, a, 1 )
295 ELSE IF( izero.GT.0 )
THEN
300 IF( izero.EQ.1 )
THEN
304 ELSE IF( izero.EQ.n )
THEN
308 a( 2*n-2+izero ) = z( 1 )
309 a( n-1+izero ) = z( 2 )
316 IF( .NOT.zerot )
THEN
318 ELSE IF( imat.EQ.8 )
THEN
326 ELSE IF( imat.EQ.9 )
THEN
334 DO 20 i = izero, n - 1
348 CALL ccopy( n+2*m, a, 1, af, 1 )
350 CALL cgttrf( n, af, af( m+1 ), af( n+m+1 ), af( n+2*m+1 ),
356 $
CALL alaerh( path,
'CGTTRF', info, izero,
' ', n, n, 1,
357 $ 1, -1, imat, nfail, nerrs, nout )
360 CALL cgtt01( n, a, a( m+1 ), a( n+m+1 ), af, af( m+1 ),
361 $ af( n+m+1 ), af( n+2*m+1 ), iwork, work, lda,
362 $ rwork, result( 1 ) )
366 IF( result( 1 ).GE.thresh )
THEN
367 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
368 $
CALL alahd( nout, path )
369 WRITE( nout, fmt = 9999 )n, imat, 1, result( 1 )
375 trans = transs( itran )
376 IF( itran.EQ.1 )
THEN
381 anorm = clangt( norm, n, a, a( m+1 ), a( n+m+1 ) )
383 IF( .NOT.trfcon )
THEN
394 CALL cgttrs( trans, n, 1, af, af( m+1 ),
395 $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
397 ainvnm = max( ainvnm, scasum( n, x, 1 ) )
402 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
405 rcondc = ( one / anorm ) / ainvnm
407 IF( itran.EQ.1 )
THEN
421 CALL cgtcon( norm, n, af, af( m+1 ), af( n+m+1 ),
422 $ af( n+2*m+1 ), iwork, anorm, rcond, work,
428 $
CALL alaerh( path,
'CGTCON', info, 0, norm, n, n, -1,
429 $ -1, -1, imat, nfail, nerrs, nout )
431 result( 7 ) = sget06( rcond, rcondc )
435 IF( result( 7 ).GE.thresh )
THEN
436 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
437 $
CALL alahd( nout, path )
438 WRITE( nout, fmt = 9997 )norm, n, imat, 7,
457 CALL clarnv( 2, iseed, n, xact( ix ) )
462 trans = transs( itran )
463 IF( itran.EQ.1 )
THEN
471 CALL clagtm( trans, n, nrhs, one, a,
472 $ a( m+1 ), a( n+m+1 ), xact, lda,
478 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
480 CALL cgttrs( trans, n, nrhs, af, af( m+1 ),
481 $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
487 $
CALL alaerh( path,
'CGTTRS', info, 0, trans, n, n,
488 $ -1, -1, nrhs, imat, nfail, nerrs,
491 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
492 CALL cgtt02( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
493 $ x, lda, work, lda, result( 2 ) )
498 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
505 CALL cgtrfs( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
506 $ af, af( m+1 ), af( n+m+1 ),
507 $ af( n+2*m+1 ), iwork, b, lda, x, lda,
508 $ rwork, rwork( nrhs+1 ), work,
509 $ rwork( 2*nrhs+1 ), info )
514 $
CALL alaerh( path,
'CGTRFS', info, 0, trans, n, n,
515 $ -1, -1, nrhs, imat, nfail, nerrs,
518 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
520 CALL cgtt05( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
521 $ b, lda, x, lda, xact, lda, rwork,
522 $ rwork( nrhs+1 ), result( 5 ) )
528 IF( result( k ).GE.thresh )
THEN
529 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
530 $
CALL alahd( nout, path )
531 WRITE( nout, fmt = 9998 )trans, n, nrhs, imat,
544 CALL alasum( path, nout, nfail, nrun, nerrs )
546 9999
FORMAT( 12x,
'N =', i5,
',', 10x,
' type ', i2,
', test(', i2,
548 9998
FORMAT(
' TRANS=''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
549 $ i2,
', test(', i2,
') = ', g12.5 )
550 9997
FORMAT(
' NORM =''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
551 $
', test(', i2,
') = ', g12.5 )
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
subroutine alahd(iounit, path)
ALAHD
subroutine cchkgt(dotype, nn, nval, nns, nsval, thresh, tsterr, a, af, b, x, xact, work, rwork, iwork, nout)
CCHKGT
subroutine cerrge(path, nunit)
CERRGE
subroutine cget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
CGET04
subroutine cgtt01(n, dl, d, du, dlf, df, duf, du2, ipiv, work, ldwork, rwork, resid)
CGTT01
subroutine cgtt02(trans, n, nrhs, dl, d, du, x, ldx, b, ldb, resid)
CGTT02
subroutine cgtt05(trans, n, nrhs, dl, d, du, b, ldb, x, ldx, xact, ldxact, ferr, berr, reslts)
CGTT05
subroutine clatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
CLATB4
subroutine clatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
CLATMS
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
subroutine cgtcon(norm, n, dl, d, du, du2, ipiv, anorm, rcond, work, info)
CGTCON
subroutine cgtrfs(trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CGTRFS
subroutine cgttrf(n, dl, d, du, du2, ipiv, info)
CGTTRF
subroutine cgttrs(trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb, info)
CGTTRS
subroutine clacpy(uplo, m, n, a, lda, b, ldb)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clagtm(trans, n, nrhs, alpha, dl, d, du, x, ldx, beta, b, ldb)
CLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix,...
subroutine clarnv(idist, iseed, n, x)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine csscal(n, sa, cx, incx)
CSSCAL