147 SUBROUTINE cchkgt( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
148 $ a, af, b, x, xact, work, rwork, iwork, nout )
157 INTEGER NN, NNS, NOUT
162 INTEGER IWORK( * ), NSVAL( * ), NVAL( * )
164 COMPLEX A( * ), AF( * ), B( * ), WORK( * ), X( * ),
172 parameter( one = 1.0e+0, zero = 0.0e+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 REAL AINVNM, ANORM, COND, RCOND, RCONDC, RCONDI,
189 CHARACTER TRANSS( 3 )
190 INTEGER ISEED( 4 ), ISEEDY( 4 )
191 REAL RESULT( ntests )
195 REAL CLANGT, SCASUM, SGET06
196 EXTERNAL clangt, scasum, sget06
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 ) =
'Complex precision'
228 iseed( i ) = iseedy( i )
234 $ CALL
cerrge( path, nout )
248 DO 100 imat = 1, nimat
252 IF( .NOT.dotype( imat ) )
257 CALL
clatb4( 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
clatms( n, n, dist, iseed,
TYPE, RWORK, MODE, COND,
268 $ anorm, kl, ku,
'Z', af( koff ), 3, work,
274 CALL
alaerh( path,
'CLATMS', info, 0,
' ', n, n, kl,
275 $ ku, -1, imat, nfail, nerrs, nout )
281 CALL
ccopy( n-1, af( 4 ), 3, a, 1 )
282 CALL
ccopy( n-1, af( 3 ), 3, a( n+m+1 ), 1 )
284 CALL
ccopy( n, af( 2 ), 3, a( m+1 ), 1 )
290 IF( .NOT.zerot .OR. .NOT.dotype( 7 ) )
THEN
295 CALL
clarnv( 2, iseed, n+2*m, a )
297 $ CALL
csscal( 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
ccopy( n+2*m, a, 1, af, 1 )
353 CALL
cgttrf( n, af, af( m+1 ), af( n+m+1 ), af( n+2*m+1 ),
359 $ CALL
alaerh( path,
'CGTTRF', info, izero,
' ', n, n, 1,
360 $ 1, -1, imat, nfail, nerrs, nout )
363 CALL
cgtt01( 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 = clangt( norm, n, a, a( m+1 ), a( n+m+1 ) )
386 IF( .NOT.trfcon )
THEN
397 CALL
cgttrs( trans, n, 1, af, af( m+1 ),
398 $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
400 ainvnm = max( ainvnm, scasum( 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
cgtcon( norm, n, af, af( m+1 ), af( n+m+1 ),
425 $ af( n+2*m+1 ), iwork, anorm, rcond, work,
431 $ CALL
alaerh( path,
'CGTCON', info, 0, norm, n, n, -1,
432 $ -1, -1, imat, nfail, nerrs, nout )
434 result( 7 ) = sget06( 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
clarnv( 2, iseed, n, xact( ix ) )
465 trans = transs( itran )
466 IF( itran.EQ.1 )
THEN
474 CALL
clagtm( trans, n, nrhs, one, a,
475 $ a( m+1 ), a( n+m+1 ), xact, lda,
481 CALL
clacpy(
'Full', n, nrhs, b, lda, x, lda )
483 CALL
cgttrs( trans, n, nrhs, af, af( m+1 ),
484 $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
490 $ CALL
alaerh( path,
'CGTTRS', info, 0, trans, n, n,
491 $ -1, -1, nrhs, imat, nfail, nerrs,
494 CALL
clacpy(
'Full', n, nrhs, b, lda, work, lda )
495 CALL
cgtt02( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
496 $ x, lda, work, lda, result( 2 ) )
501 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
508 CALL
cgtrfs( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
509 $ af, af( m+1 ), af( n+m+1 ),
510 $ af( n+2*m+1 ), iwork, b, lda, x, lda,
511 $ rwork, rwork( nrhs+1 ), work,
512 $ rwork( 2*nrhs+1 ), info )
517 $ CALL
alaerh( path,
'CGTRFS', info, 0, trans, n, n,
518 $ -1, -1, nrhs, imat, nfail, nerrs,
521 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
523 CALL
cgtt05( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
524 $ b, lda, x, lda, xact, lda, rwork,
525 $ rwork( nrhs+1 ), result( 5 ) )
531 IF( result( k ).GE.thresh )
THEN
532 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
533 $ CALL
alahd( nout, path )
534 WRITE( nout, fmt = 9998 )trans, n, nrhs, imat,
547 CALL
alasum( path, nout, nfail, nrun, nerrs )
549 9999
FORMAT( 12x,
'N =', i5,
',', 10x,
' type ', i2,
', test(', i2,
551 9998
FORMAT(
' TRANS=''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
552 $ i2,
', test(', i2,
') = ', g12.5 )
553 9997
FORMAT(
' NORM =''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
554 $
', test(', i2,
') = ', g12.5 )
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine cgtt01(N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
CGTT01
subroutine cgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, INFO)
CGTCON
subroutine cerrge(PATH, NUNIT)
CERRGE
subroutine cgtt05(TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CGTT05
subroutine cgtt02(TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
CGTT02
subroutine cgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
CGTTRS
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cgttrf(N, DL, D, DU, DU2, IPIV, INFO)
CGTTRF
subroutine clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cchkgt(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CCHKGT
subroutine csscal(N, SA, CX, INCX)
CSSCAL
subroutine cgtrfs(TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGTRFS
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
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...