169 SUBROUTINE schksy( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
170 $ thresh, tsterr, nmax, a, afac, ainv, b, x,
171 $ xact, work, rwork, iwork, nout )
180 INTEGER NMAX, NN, NNB, NNS, NOUT
185 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
186 REAL A( * ), AFAC( * ), AINV( * ), B( * ),
187 $ rwork( * ), work( * ), x( * ), xact( * )
194 parameter( zero = 0.0e+0 )
196 parameter( ntypes = 10 )
198 parameter( ntests = 9 )
201 LOGICAL TRFCON, ZEROT
202 CHARACTER DIST,
TYPE, UPLO, XTYPE
204 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
205 $ iuplo, izero, j, k, kl, ku, lda, lwork, mode,
206 $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
207 REAL ANORM, CNDNUM, RCOND, RCONDC
211 INTEGER ISEED( 4 ), ISEEDY( 4 )
212 REAL RESULT( ntests )
216 EXTERNAL sget06, slansy
233 COMMON / infoc / infot, nunit, ok, lerr
234 COMMON / srnamc / srnamt
237 DATA iseedy / 1988, 1989, 1990, 1991 /
238 DATA uplos /
'U',
'L' /
244 path( 1: 1 ) =
'Single precision'
250 iseed( i ) = iseedy( i )
256 $ CALL
serrsy( path, nout )
278 DO 170 imat = 1, nimat
282 IF( .NOT.dotype( imat ) )
287 zerot = imat.GE.3 .AND. imat.LE.6
288 IF( zerot .AND. n.LT.imat-2 )
294 uplo = uplos( iuplo )
301 CALL
slatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
307 CALL
slatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
308 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
314 CALL
alaerh( path,
'SLATMS', info, 0, uplo, n, n, -1,
315 $ -1, -1, imat, nfail, nerrs, nout )
329 ELSE IF( imat.EQ.4 )
THEN
339 IF( iuplo.EQ.1 )
THEN
340 ioff = ( izero-1 )*lda
341 DO 20 i = 1, izero - 1
351 DO 40 i = 1, izero - 1
361 IF( iuplo.EQ.1 )
THEN
408 CALL
slacpy( uplo, n, n, a, lda, afac, lda )
415 lwork = max( 2, nb )*lda
417 CALL
ssytrf( uplo, n, afac, lda, iwork, ainv, lwork,
426 IF( iwork( k ).LT.0 )
THEN
427 IF( iwork( k ).NE.-k )
THEN
431 ELSE IF( iwork( k ).NE.k )
THEN
440 $ CALL
alaerh( path,
'SSYTRF', info, k, uplo, n, n,
441 $ -1, -1, nb, imat, nfail, nerrs, nout )
454 CALL
ssyt01( uplo, n, a, lda, afac, lda, iwork, ainv,
455 $ lda, rwork, result( 1 ) )
464 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN
465 CALL
slacpy( uplo, n, n, afac, lda, ainv, lda )
467 lwork = (n+nb+1)*(nb+3)
468 CALL
ssytri2( uplo, n, ainv, lda, iwork, work,
474 $ CALL
alaerh( path,
'SSYTRI2', info, -1, uplo, n,
475 $ n, -1, -1, -1, imat, nfail, nerrs,
481 CALL
spot03( uplo, n, a, lda, ainv, lda, work, lda,
482 $ rwork, rcondc, result( 2 ) )
490 IF( result( k ).GE.thresh )
THEN
491 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
492 $ CALL
alahd( nout, path )
493 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
525 CALL
slarhs( path, xtype, uplo,
' ', n, n, kl, ku,
526 $ nrhs, a, lda, xact, lda, b, lda,
528 CALL
slacpy(
'Full', n, nrhs, b, lda, x, lda )
531 CALL
ssytrs( uplo, n, nrhs, afac, lda, iwork, x,
537 $ CALL
alaerh( path,
'SSYTRS', info, 0, uplo, n,
538 $ n, -1, -1, nrhs, imat, nfail,
541 CALL
slacpy(
'Full', n, nrhs, b, lda, work, lda )
545 CALL
spot02( uplo, n, nrhs, a, lda, x, lda, work,
546 $ lda, rwork, result( 3 ) )
555 CALL
slarhs( path, xtype, uplo,
' ', n, n, kl, ku,
556 $ nrhs, a, lda, xact, lda, b, lda,
558 CALL
slacpy(
'Full', n, nrhs, b, lda, x, lda )
561 CALL
ssytrs2( uplo, n, nrhs, afac, lda, iwork, x,
567 $ CALL
alaerh( path,
'SSYTRS2', info, 0, uplo, n,
568 $ n, -1, -1, nrhs, imat, nfail,
571 CALL
slacpy(
'Full', n, nrhs, b, lda, work, lda )
575 CALL
spot02( uplo, n, nrhs, a, lda, x, lda, work,
576 $ lda, rwork, result( 4 ) )
581 CALL
sget04( n, nrhs, x, lda, xact, lda, rcondc,
588 CALL
ssyrfs( uplo, n, nrhs, a, lda, afac, lda,
589 $ iwork, b, lda, x, lda, rwork,
590 $ rwork( nrhs+1 ), work, iwork( n+1 ),
596 $ CALL
alaerh( path,
'SSYRFS', info, 0, uplo, n,
597 $ n, -1, -1, nrhs, imat, nfail,
600 CALL
sget04( n, nrhs, x, lda, xact, lda, rcondc,
602 CALL
spot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
603 $ xact, lda, rwork, rwork( nrhs+1 ),
610 IF( result( k ).GE.thresh )
THEN
611 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
612 $ CALL
alahd( nout, path )
613 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
614 $ imat, k, result( k )
628 anorm = slansy(
'1', uplo, n, a, lda, rwork )
630 CALL
ssycon( uplo, n, afac, lda, iwork, anorm, rcond,
631 $ work, iwork( n+1 ), info )
636 $ CALL
alaerh( path,
'SSYCON', info, 0, uplo, n, n,
637 $ -1, -1, -1, imat, nfail, nerrs, nout )
641 result( 9 ) = sget06( rcond, rcondc )
646 IF( result( 9 ).GE.thresh )
THEN
647 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
648 $ CALL
alahd( nout, path )
649 WRITE( nout, fmt = 9997 )uplo, n, imat, 9,
662 CALL
alasum( path, nout, nfail, nrun, nerrs )
664 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
665 $ i2,
', test ', i2,
', ratio =', g12.5 )
666 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
667 $ i2,
', test(', i2,
') =', g12.5 )
668 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
669 $
', test(', i2,
') =', g12.5 )
subroutine ssyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
SSYT01
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 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 ssyconv(UPLO, WAY, N, A, LDA, IPIV, WORK, INFO)
SSYCONV
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine serrsy(PATH, NUNIT)
SERRSY
subroutine ssyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SSYRFS
subroutine schksy(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKSY
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 ssytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF
subroutine ssytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine ssytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRI2
subroutine ssycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON
subroutine ssytrs2(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO)
SSYTRS2
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4