153 $ nmax, a, afac, ainv,
b,
x, xact, work,
154 $ rwork, iwork, nout )
163 INTEGER nmax, nn, nout, nrhs
168 INTEGER iwork( * ), nval( * )
169 REAL a( * ), afac( * ), ainv( * ),
b( * ),
170 $ rwork( * ), work( * ),
x( * ), xact( * )
177 parameter( one = 1.0e+0, zero = 0.0e+0 )
178 INTEGER ntypes, ntests
179 parameter( ntypes = 10, ntests = 3 )
181 parameter( nfact = 2 )
185 CHARACTER dist, fact, type, uplo, xtype
186 CHARACTER*3 path, matpath
187 INTEGER i, i1, i2, ifact, imat, in, info, ioff, iuplo,
188 $ izero,
j, k, kl, ku, lda, lwork, mode, n,
189 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
190 REAL ainvnm, anorm, cndnum, rcondc
193 CHARACTER facts( nfact ), uplos( 2 )
194 INTEGER iseed( 4 ), iseedy( 4 )
195 REAL result( ntests )
214 COMMON / infoc / infot, nunit, ok, lerr
215 COMMON / srnamc / srnamt
221 DATA iseedy / 1988, 1989, 1990, 1991 /
222 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
230 path( 1: 1 ) =
'Single precision'
235 matpath( 1: 1 ) =
'Single precision'
236 matpath( 2: 3 ) =
'SY'
242 iseed( i ) = iseedy( i )
244 lwork = max( 2*nmax, nmax*nrhs )
249 $ CALL
serrvx( path, nout )
270 DO 170 imat = 1, nimat
274 IF( .NOT.dotype( imat ) )
279 zerot = imat.GE.3 .AND. imat.LE.6
280 IF( zerot .AND. n.LT.imat-2 )
286 uplo = uplos( iuplo )
293 CALL
slatb4( matpath, imat, n, n, type, kl, ku, anorm,
294 $ mode, cndnum, dist )
299 CALL
slatms( n, n, dist, iseed, type, rwork, mode,
300 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
306 CALL
alaerh( path,
'SLATMS', info, 0, uplo, n, n, -1,
307 $ -1, -1, imat, nfail, nerrs, nout )
320 ELSE IF( imat.EQ.4 )
THEN
330 IF( iuplo.EQ.1 )
THEN
331 ioff = ( izero-1 )*lda
332 DO 20 i = 1, izero - 1
342 DO 40 i = 1, izero - 1
353 IF( iuplo.EQ.1 )
THEN
383 DO 150 ifact = 1, nfact
387 fact = facts( ifact )
397 ELSE IF( ifact.EQ.1 )
THEN
401 anorm =
slansy(
'1', uplo, n, a, lda, rwork )
405 CALL
slacpy( uplo, n, n, a, lda, afac, lda )
411 CALL
slacpy( uplo, n, n, afac, lda, ainv, lda )
412 lwork = (n+nb+1)*(nb+3)
415 ainvnm =
slansy(
'1', uplo, n, ainv, lda, rwork )
419 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
422 rcondc = ( one / anorm ) / ainvnm
429 CALL
slarhs( matpath, xtype, uplo,
' ', n, n, kl, ku,
430 $ nrhs, a, lda, xact, lda,
b, lda, iseed,
436 IF( ifact.EQ.2 )
THEN
437 CALL
slacpy( uplo, n, n, a, lda, afac, lda )
438 CALL
slacpy(
'Full', n, nrhs,
b, lda,
x, lda )
443 srnamt =
'SSYSV_ROOK'
444 CALL
ssysv_rook( uplo, n, nrhs, afac, lda, iwork,
445 $
x, lda, work, lwork, info )
453 IF( iwork( k ).LT.0 )
THEN
454 IF( iwork( k ).NE.-k )
THEN
458 ELSE IF( iwork( k ).NE.k )
THEN
467 CALL
alaerh( path,
'SSYSV_ROOK', info, k, uplo,
468 $ n, n, -1, -1, nrhs, imat, nfail,
471 ELSE IF( info.NE.0 )
THEN
479 $ iwork, ainv, lda, rwork,
484 CALL
slacpy(
'Full', n, nrhs,
b, lda, work, lda )
485 CALL
spot02( uplo, n, nrhs, a, lda,
x, lda, work,
486 $ lda, rwork, result( 2 ) )
491 CALL
sget04( n, nrhs,
x, lda, xact, lda, rcondc,
499 IF( result( k ).GE.thresh )
THEN
500 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
501 $ CALL
aladhd( nout, path )
502 WRITE( nout, fmt = 9999 )
'SSYSV_ROOK', uplo,
503 $ n, imat, k, result( k )
519 CALL
alasvm( path, nout, nfail, nrun, nerrs )
521 9999
FORMAT( 1
x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
522 $
', test ', i2,
', ratio =', g12.5 )
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
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 ssytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF_ROOK
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
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 sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine sdrvsy_rook(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SDRVSY_ROOK
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine ssyt01_rook(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
SSYT01_ROOK
subroutine aladhd(IOUNIT, PATH)
ALADHD
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine serrvx(PATH, NUNIT)
SERRVX
subroutine ssysv_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
SSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices ...
subroutine ssytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
SSYTRI_ROOK
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4