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 )
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 sgtrfs(TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGTRFS
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
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 sgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SGTCON
subroutine sgtt02(TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
SGTT02
subroutine serrge(PATH, NUNIT)
SERRGE
real function sget06(RCOND, RCONDC)
SGET06
subroutine sgttrf(N, DL, D, DU, DU2, IPIV, INFO)
SGTTRF
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
real function slangt(NORM, N, DL, D, DU)
SLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine sgtt01(N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
SGTT01
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
real function sasum(N, SX, INCX)
SASUM
subroutine sgtt05(TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
SGTT05
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 sscal(N, SA, SX, INCX)
SSCAL
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM