146 SUBROUTINE dchkgt( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
147 $ a, af, b, x, xact, work, rwork, iwork, nout )
156 INTEGER NN, NNS, NOUT
157 DOUBLE PRECISION THRESH
161 INTEGER IWORK( * ), NSVAL( * ), NVAL( * )
162 DOUBLE PRECISION A( * ), AF( * ), B( * ), RWORK( * ), WORK( * ),
169 DOUBLE PRECISION ONE, ZERO
170 parameter( one = 1.0d+0, zero = 0.0d+0 )
172 parameter( ntypes = 12 )
174 parameter( ntests = 7 )
177 LOGICAL TRFCON, ZEROT
178 CHARACTER DIST, NORM, TRANS, TYPE
180 INTEGER I, IMAT, IN, INFO, IRHS, ITRAN, IX, IZERO, J,
181 $ k, kl, koff, ku, lda, m, mode, n, nerrs, nfail,
183 DOUBLE PRECISION AINVNM, ANORM, COND, RCOND, RCONDC, RCONDI,
187 CHARACTER TRANSS( 3 )
188 INTEGER ISEED( 4 ), ISEEDY( 4 )
189 DOUBLE PRECISION RESULT( ntests ), Z( 3 )
192 DOUBLE PRECISION DASUM, DGET06, DLANGT
193 EXTERNAL dasum, dget06, dlangt
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 ) =
'Double precision'
225 iseed( i ) = iseedy( i )
231 $ CALL
derrge( path, nout )
245 DO 100 imat = 1, nimat
249 IF( .NOT.dotype( imat ) )
254 CALL
dlatb4( 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
dlatms( n, n, dist, iseed,
TYPE, RWORK, MODE, COND,
265 $ anorm, kl, ku,
'Z', af( koff ), 3, work,
271 CALL
alaerh( path,
'DLATMS', info, 0,
' ', n, n, kl,
272 $ ku, -1, imat, nfail, nerrs, nout )
278 CALL
dcopy( n-1, af( 4 ), 3, a, 1 )
279 CALL
dcopy( n-1, af( 3 ), 3, a( n+m+1 ), 1 )
281 CALL
dcopy( n, af( 2 ), 3, a( m+1 ), 1 )
287 IF( .NOT.zerot .OR. .NOT.dotype( 7 ) )
THEN
291 CALL
dlarnv( 2, iseed, n+2*m, a )
293 $ CALL
dscal( n+2*m, anorm, a, 1 )
294 ELSE IF( izero.GT.0 )
THEN
299 IF( izero.EQ.1 )
THEN
303 ELSE IF( izero.EQ.n )
THEN
307 a( 2*n-2+izero ) = z( 1 )
308 a( n-1+izero ) = z( 2 )
315 IF( .NOT.zerot )
THEN
317 ELSE IF( imat.EQ.8 )
THEN
325 ELSE IF( imat.EQ.9 )
THEN
333 DO 20 i = izero, n - 1
347 CALL
dcopy( n+2*m, a, 1, af, 1 )
349 CALL
dgttrf( n, af, af( m+1 ), af( n+m+1 ), af( n+2*m+1 ),
355 $ CALL
alaerh( path,
'DGTTRF', info, izero,
' ', n, n, 1,
356 $ 1, -1, imat, nfail, nerrs, nout )
359 CALL
dgtt01( n, a, a( m+1 ), a( n+m+1 ), af, af( m+1 ),
360 $ af( n+m+1 ), af( n+2*m+1 ), iwork, work, lda,
361 $ rwork, result( 1 ) )
365 IF( result( 1 ).GE.thresh )
THEN
366 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
367 $ CALL
alahd( nout, path )
368 WRITE( nout, fmt = 9999 )n, imat, 1, result( 1 )
374 trans = transs( itran )
375 IF( itran.EQ.1 )
THEN
380 anorm = dlangt( norm, n, a, a( m+1 ), a( n+m+1 ) )
382 IF( .NOT.trfcon )
THEN
394 CALL
dgttrs( trans, n, 1, af, af( m+1 ),
395 $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
397 ainvnm = max( ainvnm, dasum( 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
dgtcon( norm, n, af, af( m+1 ), af( n+m+1 ),
422 $ af( n+2*m+1 ), iwork, anorm, rcond, work,
423 $ iwork( n+1 ), info )
428 $ CALL
alaerh( path,
'DGTCON', info, 0, norm, n, n, -1,
429 $ -1, -1, imat, nfail, nerrs, nout )
431 result( 7 ) = dget06( 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
dlarnv( 2, iseed, n, xact( ix ) )
462 trans = transs( itran )
463 IF( itran.EQ.1 )
THEN
471 CALL
dlagtm( trans, n, nrhs, one, a, a( m+1 ),
472 $ a( n+m+1 ), xact, lda, zero, b, lda )
477 CALL
dlacpy(
'Full', n, nrhs, b, lda, x, lda )
479 CALL
dgttrs( trans, n, nrhs, af, af( m+1 ),
480 $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
486 $ CALL
alaerh( path,
'DGTTRS', info, 0, trans, n, n,
487 $ -1, -1, nrhs, imat, nfail, nerrs,
490 CALL
dlacpy(
'Full', n, nrhs, b, lda, work, lda )
491 CALL
dgtt02( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
492 $ x, lda, work, lda, result( 2 ) )
497 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
504 CALL
dgtrfs( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
505 $ af, af( m+1 ), af( n+m+1 ),
506 $ af( n+2*m+1 ), iwork, b, lda, x, lda,
507 $ rwork, rwork( nrhs+1 ), work,
508 $ iwork( n+1 ), info )
513 $ CALL
alaerh( path,
'DGTRFS', info, 0, trans, n, n,
514 $ -1, -1, nrhs, imat, nfail, nerrs,
517 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
519 CALL
dgtt05( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
520 $ b, lda, x, lda, xact, lda, rwork,
521 $ rwork( nrhs+1 ), result( 5 ) )
527 IF( result( k ).GE.thresh )
THEN
528 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
529 $ CALL
alahd( nout, path )
530 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 alahd(IOUNIT, PATH)
ALAHD
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine dgtrfs(TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGTRFS
subroutine dgtt02(TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
DGTT02
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dlagtm(TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA, B, LDB)
DLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix...
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine dlarnv(IDIST, ISEED, N, X)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
subroutine dgttrf(N, DL, D, DU, DU2, IPIV, INFO)
DGTTRF
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine dgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DGTCON
subroutine dgtt05(TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DGTT05
subroutine dgtt01(N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
DGTT01
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
subroutine dgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
DGTTRS
subroutine derrge(PATH, NUNIT)
DERRGE
subroutine dchkgt(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
DCHKGT