144 SUBROUTINE schkgt( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
145 $ A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT )
153 INTEGER NN, NNS, NOUT
158 INTEGER IWORK( * ), NSVAL( * ), NVAL( * )
159 REAL A( * ), AF( * ), B( * ), RWORK( * ), WORK( * ),
167 parameter( one = 1.0e+0, zero = 0.0e+0 )
169 parameter( ntypes = 12 )
171 parameter( ntests = 7 )
174 LOGICAL TRFCON, ZEROT
175 CHARACTER DIST, NORM, TRANS, TYPE
177 INTEGER I, IMAT, IN, INFO, IRHS, ITRAN, IX, IZERO, J,
178 $ k, kl, koff, ku, lda, m, mode, n, nerrs, nfail,
180 REAL AINVNM, ANORM, COND, RCOND, RCONDC, RCONDI,
184 CHARACTER TRANSS( 3 )
185 INTEGER ISEED( 4 ), ISEEDY( 4 )
186 REAL RESULT( NTESTS ), Z( 3 )
189 REAL SASUM, SGET06, SLANGT
190 EXTERNAL sasum, sget06, slangt
207 COMMON / infoc / infot, nunit, ok, lerr
208 COMMON / srnamc / srnamt
211 DATA iseedy / 0, 0, 0, 1 / , transs /
'N',
'T',
216 path( 1: 1 ) =
'Single precision'
222 iseed( i ) = iseedy( i )
228 $
CALL serrge( path, nout )
242 DO 100 imat = 1, nimat
246 IF( .NOT.dotype( imat ) )
251 CALL slatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
254 zerot = imat.GE.8 .AND. imat.LE.10
259 koff = max( 2-ku, 3-max( 1, n ) )
261 CALL slatms( n, n, dist, iseed,
TYPE, rwork, mode, cond,
262 $ anorm, kl, ku,
'Z', af( koff ), 3, work,
268 CALL alaerh( path,
'SLATMS', info, 0,
' ', n, n, kl,
269 $ ku, -1, imat, nfail, nerrs, nout )
275 CALL scopy( n-1, af( 4 ), 3, a, 1 )
276 CALL scopy( n-1, af( 3 ), 3, a( n+m+1 ), 1 )
278 CALL scopy( n, af( 2 ), 3, a( m+1 ), 1 )
284 IF( .NOT.zerot .OR. .NOT.dotype( 7 ) )
THEN
288 CALL slarnv( 2, iseed, n+2*m, a )
290 $
CALL sscal( n+2*m, anorm, a, 1 )
291 ELSE IF( izero.GT.0 )
THEN
296 IF( izero.EQ.1 )
THEN
300 ELSE IF( izero.EQ.n )
THEN
304 a( 2*n-2+izero ) = z( 1 )
305 a( n-1+izero ) = z( 2 )
312 IF( .NOT.zerot )
THEN
314 ELSE IF( imat.EQ.8 )
THEN
322 ELSE IF( imat.EQ.9 )
THEN
330 DO 20 i = izero, n - 1
344 CALL scopy( n+2*m, a, 1, af, 1 )
346 CALL sgttrf( n, af, af( m+1 ), af( n+m+1 ), af( n+2*m+1 ),
352 $
CALL alaerh( path,
'SGTTRF', info, izero,
' ', n, n, 1,
353 $ 1, -1, imat, nfail, nerrs, nout )
356 CALL sgtt01( n, a, a( m+1 ), a( n+m+1 ), af, af( m+1 ),
357 $ af( n+m+1 ), af( n+2*m+1 ), iwork, work, lda,
358 $ rwork, result( 1 ) )
362 IF( result( 1 ).GE.thresh )
THEN
363 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
364 $
CALL alahd( nout, path )
365 WRITE( nout, fmt = 9999 )n, imat, 1, result( 1 )
371 trans = transs( itran )
372 IF( itran.EQ.1 )
THEN
377 anorm = slangt( norm, n, a, a( m+1 ), a( n+m+1 ) )
379 IF( .NOT.trfcon )
THEN
391 CALL sgttrs( trans, n, 1, af, af( m+1 ),
392 $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
394 ainvnm = max( ainvnm, sasum( n, x, 1 ) )
399 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
402 rcondc = ( one / anorm ) / ainvnm
404 IF( itran.EQ.1 )
THEN
418 CALL sgtcon( norm, n, af, af( m+1 ), af( n+m+1 ),
419 $ af( n+2*m+1 ), iwork, anorm, rcond, work,
420 $ iwork( n+1 ), info )
425 $
CALL alaerh( path,
'SGTCON', info, 0, norm, n, n, -1,
426 $ -1, -1, imat, nfail, nerrs, nout )
428 result( 7 ) = sget06( rcond, rcondc )
432 IF( result( 7 ).GE.thresh )
THEN
433 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
434 $
CALL alahd( nout, path )
435 WRITE( nout, fmt = 9997 )norm, n, imat, 7,
454 CALL slarnv( 2, iseed, n, xact( ix ) )
459 trans = transs( itran )
460 IF( itran.EQ.1 )
THEN
468 CALL slagtm( trans, n, nrhs, one, a, a( m+1 ),
469 $ a( n+m+1 ), xact, lda, zero, b, lda )
474 CALL slacpy(
'Full', n, nrhs, b, lda, x, lda )
476 CALL sgttrs( trans, n, nrhs, af, af( m+1 ),
477 $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
483 $
CALL alaerh( path,
'SGTTRS', info, 0, trans, n, n,
484 $ -1, -1, nrhs, imat, nfail, nerrs,
487 CALL slacpy(
'Full', n, nrhs, b, lda, work, lda )
488 CALL sgtt02( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
489 $ x, lda, work, lda, result( 2 ) )
494 CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
501 CALL sgtrfs( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
502 $ af, af( m+1 ), af( n+m+1 ),
503 $ af( n+2*m+1 ), iwork, b, lda, x, lda,
504 $ rwork, rwork( nrhs+1 ), work,
505 $ iwork( n+1 ), info )
510 $
CALL alaerh( path,
'SGTRFS', info, 0, trans, n, n,
511 $ -1, -1, nrhs, imat, nfail, nerrs,
514 CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
516 CALL sgtt05( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
517 $ b, lda, x, lda, xact, lda, rwork,
518 $ rwork( nrhs+1 ), result( 5 ) )
524 IF( result( k ).GE.thresh )
THEN
525 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
526 $
CALL alahd( nout, path )
527 WRITE( nout, fmt = 9998 )trans, n, nrhs, imat,
541 CALL alasum( path, nout, nfail, nrun, nerrs )
543 9999
FORMAT( 12x,
'N =', i5,
',', 10x,
' type ', i2,
', test(', i2,
545 9998
FORMAT(
' TRANS=''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
546 $ i2,
', test(', i2,
') = ', g12.5 )
547 9997
FORMAT(
' NORM =''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
548 $
', test(', i2,
') = ', g12.5 )