151 SUBROUTINE sdrvsy_aa( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
152 $ nmax, a, afac, ainv, b, x, xact, work,
153 $ rwork, iwork, nout )
162 INTEGER NMAX, NN, NOUT, NRHS
167 INTEGER IWORK( * ), NVAL( * )
168 REAL A( * ), AFAC( * ), AINV( * ), B( * ),
169 $ rwork( * ), work( * ), x( * ), xact( * )
176 parameter ( one = 1.0e+0, zero = 0.0e+0 )
177 INTEGER NTYPES, NTESTS
178 parameter ( ntypes = 10, ntests = 3 )
180 parameter ( nfact = 2 )
184 CHARACTER DIST, FACT,
TYPE, UPLO, XTYPE
185 CHARACTER*3 MATPATH, PATH
186 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
187 $ izero, j, k, kl, ku, lda, lwork, mode, n,
188 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
192 CHARACTER FACTS( nfact ), UPLOS( 2 )
193 INTEGER ISEED( 4 ), ISEEDY( 4 )
194 REAL RESULT( ntests )
198 EXTERNAL dget06, slansy
211 COMMON / infoc / infot, nunit, ok, lerr
212 COMMON / srnamc / srnamt
218 DATA iseedy / 1988, 1989, 1990, 1991 /
219 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
227 path( 1: 1 ) =
'Single precision'
232 matpath( 1: 1 ) =
'Single precision'
233 matpath( 2: 3 ) =
'SY'
239 iseed( i ) = iseedy( i )
241 lwork = max( 2*nmax, nmax*nrhs )
246 $
CALL serrvx( path, nout )
266 DO 170 imat = 1, nimat
270 IF( .NOT.dotype( imat ) )
275 zerot = imat.GE.3 .AND. imat.LE.6
276 IF( zerot .AND. n.LT.imat-2 )
282 uplo = uplos( iuplo )
287 CALL slatb4( matpath, imat, n, n,
TYPE, KL, KU, ANORM,
288 $ mode, cndnum, dist )
291 CALL slatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
292 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
298 CALL alaerh( path,
'SLATMS', info, 0, uplo, n, n, -1,
299 $ -1, -1, imat, nfail, nerrs, nout )
309 ELSE IF( imat.EQ.4 )
THEN
319 IF( iuplo.EQ.1 )
THEN
320 ioff = ( izero-1 )*lda
321 DO 20 i = 1, izero - 1
331 DO 40 i = 1, izero - 1
342 IF( iuplo.EQ.1 )
THEN
371 DO 150 ifact = 1, nfact
375 fact = facts( ifact )
380 CALL slarhs( matpath, xtype, uplo,
' ', n, n, kl, ku,
381 $ nrhs, a, lda, xact, lda, b, lda, iseed,
387 IF( ifact.EQ.2 )
THEN
388 CALL slacpy( uplo, n, n, a, lda, afac, lda )
389 CALL slacpy(
'Full', n, nrhs, b, lda, x, lda )
394 CALL ssysv_aa( uplo, n, nrhs, afac, lda, iwork,
395 $ x, lda, work, lwork, info )
400 IF( izero.GT.0 )
THEN
406 ELSE IF( iwork( j ).EQ.k )
THEN
420 CALL alaerh( path,
'SSYSV_AA ', info, k,
421 $ uplo, n, n, -1, -1, nrhs,
422 $ imat, nfail, nerrs, nout )
424 ELSE IF( info.NE.0 )
THEN
431 CALL ssyt01_aa( uplo, n, a, lda, afac, lda,
432 $ iwork, ainv, lda, rwork,
437 CALL slacpy(
'Full', n, nrhs, b, lda, work, lda )
438 CALL spot02( uplo, n, nrhs, a, lda, x, lda, work,
439 $ lda, rwork, result( 2 ) )
446 IF( result( k ).GE.thresh )
THEN
447 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
448 $
CALL aladhd( nout, path )
449 WRITE( nout, fmt = 9999 )
'SSYSV_AA ',
450 $ uplo, n, imat, k, result( k )
466 CALL alasvm( path, nout, nfail, nrun, nerrs )
468 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
469 $
', test ', i2,
', ratio =', g12.5 )
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine ssytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF_AA
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
subroutine sdrvsy_aa(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SDRVSY_AA
subroutine ssyt01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
SSYT01_AA
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
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 ssysv_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
SSYSV_AA computes the solution to system of linear equations A * X = B for SY matrices ...
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...
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine serrvx(PATH, NUNIT)
SERRVX
subroutine dpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DPOT05
subroutine spot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
SPOT02
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.