166 INTEGER nmax, nn, nout, nrhs
171 INTEGER iwork( * ), nval( * )
172 REAL a( * ), afac( * ), ainv( * ), b( * ), e( * ),
173 $ rwork( * ), work( * ), x( * ), xact( * )
180 parameter ( one = 1.0e+0, zero = 0.0e+0 )
181 INTEGER ntypes, ntests
182 parameter ( ntypes = 10, ntests = 3 )
184 parameter ( nfact = 2 )
188 CHARACTER dist, fact,
TYPE, uplo, xtype
189 CHARACTER*3 path, matpath
190 INTEGER i, i1, i2, ifact, imat, in, info, ioff, iuplo,
191 $ izero, j, k, kl, ku, lda, lwork, mode, n,
192 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
193 REAL ainvnm, anorm, cndnum, rcondc
196 CHARACTER facts( nfact ), uplos( 2 )
197 INTEGER iseed( 4 ), iseedy( 4 )
198 REAL result( ntests )
215 COMMON / infoc / infot, nunit, ok, lerr
216 COMMON / srnamc / srnamt
222 DATA iseedy / 1988, 1989, 1990, 1991 /
223 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
231 path( 1: 1 ) =
'Single precision'
236 matpath( 1: 1 ) =
'Single precision'
237 matpath( 2: 3 ) =
'SY'
243 iseed( i ) = iseedy( i )
245 lwork = max( 2*nmax, nmax*nrhs )
250 $
CALL serrvx( path, nout )
271 DO 170 imat = 1, nimat
275 IF( .NOT.dotype( imat ) )
280 zerot = imat.GE.3 .AND. imat.LE.6
281 IF( zerot .AND. n.LT.imat-2 )
287 uplo = uplos( iuplo )
294 CALL slatb4( matpath, imat, n, n,
TYPE, kl, ku, anorm,
295 $ mode, cndnum, dist )
300 CALL slatms( n, n, dist, iseed,
TYPE, rwork, mode,
301 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
307 CALL alaerh( path,
'SLATMS', info, 0, uplo, n, n, -1,
308 $ -1, -1, imat, nfail, nerrs, nout )
321 ELSE IF( imat.EQ.4 )
THEN
331 IF( iuplo.EQ.1 )
THEN
332 ioff = ( izero-1 )*lda
333 DO 20 i = 1, izero - 1
343 DO 40 i = 1, izero - 1
354 IF( iuplo.EQ.1 )
THEN
384 DO 150 ifact = 1, nfact
388 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 )
406 CALL ssytrf_rk( uplo, n, afac, lda, e, iwork, work,
411 CALL slacpy( uplo, n, n, afac, lda, ainv, lda )
412 lwork = (n+nb+1)*(nb+3)
417 CALL ssytri_3( uplo, n, ainv, lda, e, iwork,
418 $ work, lwork, info )
419 ainvnm =
slansy(
'1', uplo, n, ainv, lda, rwork )
423 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
426 rcondc = ( one / anorm ) / ainvnm
433 CALL slarhs( matpath, xtype, uplo,
' ', n, n, kl, ku,
434 $ nrhs, a, lda, xact, lda, b, lda, iseed,
440 IF( ifact.EQ.2 )
THEN
441 CALL slacpy( uplo, n, n, a, lda, afac, lda )
442 CALL slacpy(
'Full', n, nrhs, b, lda, x, lda )
448 CALL ssysv_rk( uplo, n, nrhs, afac, lda, e, iwork,
449 $ x, lda, work, lwork, info )
457 IF( iwork( k ).LT.0 )
THEN
458 IF( iwork( k ).NE.-k )
THEN
462 ELSE IF( iwork( k ).NE.k )
THEN
471 CALL alaerh( path,
'SSYSV_RK', info, k, uplo,
472 $ n, n, -1, -1, nrhs, imat, nfail,
475 ELSE IF( info.NE.0 )
THEN
482 CALL ssyt01_3( uplo, n, a, lda, afac, lda, e,
483 $ iwork, ainv, lda, rwork,
488 CALL slacpy(
'Full', n, nrhs, b, lda, work, lda )
489 CALL spot02( uplo, n, nrhs, a, lda, x, lda, work,
490 $ lda, rwork, result( 2 ) )
495 CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
503 IF( result( k ).GE.thresh )
THEN
504 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
505 $
CALL aladhd( nout, path )
506 WRITE( nout, fmt = 9999 )
'SSYSV_RK', uplo,
507 $ n, imat, k, result( k )
523 CALL alasvm( path, nout, nfail, nrun, nerrs )
525 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
526 $
', test ', i2,
', ratio =', g12.5 )
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
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 ssytrf_rk(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
SSYTRF_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Ka...
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 ssytri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
SSYTRI_3
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine ssysv_rk(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, LWORK, INFO)
SSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices ...
subroutine serrvx(PATH, NUNIT)
SERRVX
subroutine ssyt01_3(UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C, LDC, RWORK, RESID)
SSYT01_3
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.
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.