146 SUBROUTINE schkgt( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
147 $ a, af, b, x, xact, work, rwork, iwork, nout )
156 INTEGER NN, NNS, NOUT
161 INTEGER IWORK( * ), NSVAL( * ), NVAL( * )
162 REAL A( * ), AF( * ), B( * ), RWORK( * ), WORK( * ),
170 parameter( one = 1.0e+0, zero = 0.0e+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 REAL AINVNM, ANORM, COND, RCOND, RCONDC, RCONDI,
187 CHARACTER TRANSS( 3 )
188 INTEGER ISEED( 4 ), ISEEDY( 4 )
189 REAL RESULT( ntests ), Z( 3 )
192 REAL SASUM, SGET06, SLANGT
193 EXTERNAL sasum, sget06, slangt
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 ) =
'Single precision'
225 iseed( i ) = iseedy( i )
231 $ CALL
serrge( path, nout )
245 DO 100 imat = 1, nimat
249 IF( .NOT.dotype( imat ) )
254 CALL
slatb4( 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
slatms( n, n, dist, iseed,
TYPE, RWORK, MODE, COND,
265 $ anorm, kl, ku,
'Z', af( koff ), 3, work,
271 CALL
alaerh( path,
'SLATMS', info, 0,
' ', n, n, kl,
272 $ ku, -1, imat, nfail, nerrs, nout )
278 CALL
scopy( n-1, af( 4 ), 3, a, 1 )
279 CALL
scopy( n-1, af( 3 ), 3, a( n+m+1 ), 1 )
281 CALL
scopy( n, af( 2 ), 3, a( m+1 ), 1 )
287 IF( .NOT.zerot .OR. .NOT.dotype( 7 ) )
THEN
291 CALL
slarnv( 2, iseed, n+2*m, a )
293 $ CALL
sscal( 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
scopy( n+2*m, a, 1, af, 1 )
349 CALL
sgttrf( n, af, af( m+1 ), af( n+m+1 ), af( n+2*m+1 ),
355 $ CALL
alaerh( path,
'SGTTRF', info, izero,
' ', n, n, 1,
356 $ 1, -1, imat, nfail, nerrs, nout )
359 CALL
sgtt01( 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 = slangt( norm, n, a, a( m+1 ), a( n+m+1 ) )
382 IF( .NOT.trfcon )
THEN
394 CALL
sgttrs( trans, n, 1, af, af( m+1 ),
395 $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
397 ainvnm = max( ainvnm, sasum( 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
sgtcon( 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,
'SGTCON', 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
slarnv( 2, iseed, n, xact( ix ) )
462 trans = transs( itran )
463 IF( itran.EQ.1 )
THEN
471 CALL
slagtm( trans, n, nrhs, one, a, a( m+1 ),
472 $ a( n+m+1 ), xact, lda, zero, b, lda )
477 CALL
slacpy(
'Full', n, nrhs, b, lda, x, lda )
479 CALL
sgttrs( trans, n, nrhs, af, af( m+1 ),
480 $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
486 $ CALL
alaerh( path,
'SGTTRS', info, 0, trans, n, n,
487 $ -1, -1, nrhs, imat, nfail, nerrs,
490 CALL
slacpy(
'Full', n, nrhs, b, lda, work, lda )
491 CALL
sgtt02( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
492 $ x, lda, work, lda, result( 2 ) )
497 CALL
sget04( n, nrhs, x, lda, xact, lda, rcondc,
504 CALL
sgtrfs( 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,
'SGTRFS', info, 0, trans, n, n,
514 $ -1, -1, nrhs, imat, nfail, nerrs,
517 CALL
sget04( n, nrhs, x, lda, xact, lda, rcondc,
519 CALL
sgtt05( 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 serrge(PATH, NUNIT)
SERRGE
subroutine schkgt(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKGT
subroutine sgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SGTCON
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine sgtt05(TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
SGTT05
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
subroutine sgtrfs(TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGTRFS
subroutine sgtt01(N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
SGTT01
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine sgttrf(N, DL, D, DU, DU2, IPIV, INFO)
SGTTRF
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
SGTTRS
subroutine slarnv(IDIST, ISEED, N, X)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine sgtt02(TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
SGTT02
subroutine slagtm(TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA, B, LDB)
SLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix...
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
subroutine sscal(N, SA, SX, INCX)
SSCAL