171 SUBROUTINE schkpo( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
172 $ thresh, tsterr, nmax, a, afac, ainv,
b, x,
173 $ xact, work, rwork, iwork, nout )
182 INTEGER nmax, nn, nnb, nns, nout
187 INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
188 REAL a( * ), afac( * ), ainv( * ),
b( * ),
189 $ rwork( * ), work( * ), x( * ), xact( * )
196 parameter( zero = 0.0e+0 )
198 parameter( ntypes = 9 )
200 parameter( ntests = 8 )
204 CHARACTER dist, type, uplo, xtype
206 INTEGER i, imat, in, inb, info, ioff, irhs, iuplo,
207 $ izero, k, kl, ku, lda, mode, n, nb, nerrs,
208 $ nfail, nimat, nrhs, nrun
209 REAL anorm, cndnum, rcond, rcondc
213 INTEGER iseed( 4 ), iseedy( 4 )
214 REAL result( ntests )
232 COMMON / infoc / infot, nunit, ok, lerr
233 COMMON / srnamc / srnamt
239 DATA iseedy / 1988, 1989, 1990, 1991 /
240 DATA uplos /
'U',
'L' /
246 path( 1: 1 ) =
'Single precision'
252 iseed( i ) = iseedy( i )
258 $ CALL
serrpo( path, nout )
273 DO 110 imat = 1, nimat
277 IF( .NOT.dotype( imat ) )
282 zerot = imat.GE.3 .AND. imat.LE.5
283 IF( zerot .AND. n.LT.imat-2 )
289 uplo = uplos( iuplo )
294 CALL
slatb4( path, imat, n, n, type, kl, ku, anorm, mode,
298 CALL
slatms( n, n, dist, iseed, type, rwork, mode,
299 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
305 CALL
alaerh( path,
'SLATMS', info, 0, uplo, n, n, -1,
306 $ -1, -1, imat, nfail, nerrs, nout )
316 ELSE IF( imat.EQ.4 )
THEN
321 ioff = ( izero-1 )*lda
325 IF( iuplo.EQ.1 )
THEN
326 DO 20 i = 1, izero - 1
336 DO 40 i = 1, izero - 1
357 CALL
slacpy( uplo, n, n, a, lda, afac, lda )
359 CALL
spotrf( uplo, n, afac, lda, info )
363 IF( info.NE.izero )
THEN
364 CALL
alaerh( path,
'SPOTRF', info, izero, uplo, n,
365 $ n, -1, -1, nb, imat, nfail, nerrs,
378 CALL
slacpy( uplo, n, n, afac, lda, ainv, lda )
379 CALL
spot01( uplo, n, a, lda, ainv, lda, rwork,
385 CALL
slacpy( uplo, n, n, afac, lda, ainv, lda )
387 CALL
spotri( uplo, n, ainv, lda, info )
392 $ CALL
alaerh( path,
'SPOTRI', info, 0, uplo, n, n,
393 $ -1, -1, -1, imat, nfail, nerrs, nout )
395 CALL
spot03( uplo, n, a, lda, ainv, lda, work, lda,
396 $ rwork, rcondc, result( 2 ) )
402 IF( result( k ).GE.thresh )
THEN
403 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
404 $ CALL
alahd( nout, path )
405 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
425 CALL
slarhs( path, xtype, uplo,
' ', n, n, kl, ku,
426 $ nrhs, a, lda, xact, lda,
b, lda,
428 CALL
slacpy(
'Full', n, nrhs,
b, lda, x, lda )
431 CALL
spotrs( uplo, n, nrhs, afac, lda, x, lda,
437 $ CALL
alaerh( path,
'SPOTRS', info, 0, uplo, n,
438 $ n, -1, -1, nrhs, imat, nfail,
441 CALL
slacpy(
'Full', n, nrhs,
b, lda, work, lda )
442 CALL
spot02( uplo, n, nrhs, a, lda, x, lda, work,
443 $ lda, rwork, result( 3 ) )
448 CALL
sget04( n, nrhs, x, lda, xact, lda, rcondc,
455 CALL
sporfs( uplo, n, nrhs, a, lda, afac, lda,
b,
456 $ lda, x, lda, rwork, rwork( nrhs+1 ),
457 $ work, iwork, info )
462 $ CALL
alaerh( path,
'SPORFS', info, 0, uplo, n,
463 $ n, -1, -1, nrhs, imat, nfail,
466 CALL
sget04( n, nrhs, x, lda, xact, lda, rcondc,
468 CALL
spot05( uplo, n, nrhs, a, lda,
b, lda, x, lda,
469 $ xact, lda, rwork, rwork( nrhs+1 ),
476 IF( result( k ).GE.thresh )
THEN
477 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
478 $ CALL
alahd( nout, path )
479 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
480 $ imat, k, result( k )
490 anorm =
slansy(
'1', uplo, n, a, lda, rwork )
492 CALL
spocon( uplo, n, afac, lda, anorm, rcond, work,
498 $ CALL
alaerh( path,
'SPOCON', info, 0, uplo, n, n,
499 $ -1, -1, -1, imat, nfail, nerrs, nout )
501 result( 8 ) =
sget06( rcond, rcondc )
505 IF( result( 8 ).GE.thresh )
THEN
506 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
507 $ CALL
alahd( nout, path )
508 WRITE( nout, fmt = 9997 )uplo, n, imat, 8,
520 CALL
alasum( path, nout, nfail, nrun, nerrs )
522 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
523 $ i2,
', test ', i2,
', ratio =', g12.5 )
524 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
525 $ i2,
', test(', i2,
') =', g12.5 )
526 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
527 $
', test(', i2,
') =', g12.5 )
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine spot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
SPOT05
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
subroutine spot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
SPOT02
subroutine spotri(UPLO, N, A, LDA, INFO)
SPOTRI
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
real function sget06(RCOND, RCONDC)
SGET06
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
subroutine schkpo(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKPO
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine sporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPORFS
subroutine serrpo(PATH, NUNIT)
SERRPO
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine spot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
SPOT01
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine spot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
SPOT03
subroutine spocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SPOCON
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
real function slansy(NORM, UPLO, N, A, LDA, WORK)
SLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.
subroutine spotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
SPOTRS
subroutine spotrf(UPLO, N, A, LDA, INFO)
SPOTRF
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4