171 $ thresh, tsterr, nmax, a, afac, ainv,
b, x,
172 $ xact, work, rwork, iwork, nout )
181 INTEGER nmax, nn, nnb, nns, nout
186 INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
187 REAL a( * ), afac( * ), ainv( * ),
b( * ),
188 $ rwork( * ), work( * ), x( * ), xact( * )
195 parameter( zero = 0.0d+0, one = 1.0d+0 )
197 parameter( eight = 8.0d+0, sevten = 17.0d+0 )
199 parameter( ntypes = 10 )
201 parameter( ntests = 7 )
204 LOGICAL trfcon, zerot
205 CHARACTER dist, type, uplo, xtype
206 CHARACTER*3 path, matpath
207 INTEGER i, i1, i2, imat, in, inb, info, ioff, irhs,
208 $ itemp, iuplo, izero,
j, k, kl, ku, lda, lwork,
209 $ mode, n, nb, nerrs, nfail, nimat, nrhs, nrun,
211 REAL alpha, anorm, cndnum, const, lam_max, lam_min,
212 $ rcond, rcondc, stemp
216 INTEGER idummy( 1 ), iseed( 4 ), iseedy( 4 )
217 REAL result( ntests ), sdummy( 1 )
230 INTRINSIC abs, max, min, sqrt
238 COMMON / infoc / infot, nunit, ok, lerr
239 COMMON / srnamc / srnamt
242 DATA iseedy / 1988, 1989, 1990, 1991 /
243 DATA uplos /
'U',
'L' /
249 alpha = ( one+sqrt( sevten ) ) / eight
253 path( 1: 1 ) =
'Single precision'
258 matpath( 1: 1 ) =
'Single precision'
259 matpath( 2: 3 ) =
'SY'
265 iseed( i ) = iseedy( i )
271 $ CALL
serrsy( path, nout )
293 DO 260 imat = 1, nimat
297 IF( .NOT.dotype( imat ) )
302 zerot = imat.GE.3 .AND. imat.LE.6
303 IF( zerot .AND. n.LT.imat-2 )
309 uplo = uplos( iuplo )
316 CALL
slatb4( matpath, imat, n, n, type, kl, ku, anorm,
317 $ mode, cndnum, dist )
322 CALL
slatms( n, n, dist, iseed, type, rwork, mode,
323 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
329 CALL
alaerh( path,
'SLATMS', info, 0, uplo, n, n, -1,
330 $ -1, -1, imat, nfail, nerrs, nout )
344 ELSE IF( imat.EQ.4 )
THEN
354 IF( iuplo.EQ.1 )
THEN
355 ioff = ( izero-1 )*lda
356 DO 20 i = 1, izero - 1
366 DO 40 i = 1, izero - 1
376 IF( iuplo.EQ.1 )
THEN
423 CALL
slacpy( uplo, n, n, a, lda, afac, lda )
430 lwork = max( 2, nb )*lda
431 srnamt =
'SSYTRF_ROOK'
441 IF( iwork( k ).LT.0 )
THEN
442 IF( iwork( k ).NE.-k )
THEN
446 ELSE IF( iwork( k ).NE.k )
THEN
455 $ CALL
alaerh( path,
'SSYTRF_ROOK', info, k,
456 $ uplo, n, n, -1, -1, nb, imat,
457 $ nfail, nerrs, nout )
470 CALL
ssyt01_rook( uplo, n, a, lda, afac, lda, iwork,
471 $ ainv, lda, rwork, result( 1 ) )
480 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN
481 CALL
slacpy( uplo, n, n, afac, lda, ainv, lda )
482 srnamt =
'SSYTRI_ROOK'
489 $ CALL
alaerh( path,
'SSYTRI_ROOK', info, -1,
490 $ uplo, n, n, -1, -1, -1, imat,
491 $ nfail, nerrs, nout )
496 CALL
spot03( uplo, n, a, lda, ainv, lda, work, lda,
497 $ rwork, rcondc, result( 2 ) )
505 IF( result( k ).GE.thresh )
THEN
506 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
507 $ CALL
alahd( nout, path )
508 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
521 const = one / ( one-alpha )
523 IF( iuplo.EQ.1 )
THEN
532 IF( iwork( k ).GT.zero )
THEN
537 stemp =
slange(
'M', k-1, 1,
538 $ afac( ( k-1 )*lda+1 ), lda, rwork )
544 stemp =
slange(
'M', k-2, 2,
545 $ afac( ( k-2 )*lda+1 ), lda, rwork )
552 stemp = stemp - const + thresh
553 IF( stemp.GT.result( 3 ) )
554 $ result( 3 ) = stemp
570 IF( iwork( k ).GT.zero )
THEN
575 stemp =
slange(
'M', n-k, 1,
576 $ afac( ( k-1 )*lda+k+1 ), lda, rwork )
582 stemp =
slange(
'M', n-k-1, 2,
583 $ afac( ( k-1 )*lda+k+2 ), lda, rwork )
590 stemp = stemp - const + thresh
591 IF( stemp.GT.result( 3 ) )
592 $ result( 3 ) = stemp
607 const = ( one+alpha ) / ( one-alpha )
608 CALL
slacpy( uplo, n, n, afac, lda, ainv, lda )
610 IF( iuplo.EQ.1 )
THEN
619 IF( iwork( k ).LT.zero )
THEN
624 CALL
ssyevx(
'N',
'A', uplo, 2,
625 $ ainv( ( k-2 )*lda+k-1 ), lda, stemp,
626 $ stemp, itemp, itemp, zero, itemp,
627 $ rwork, sdummy, 1, work, 16,
628 $ iwork( n+1 ), idummy, info )
630 lam_max = max( abs( rwork( 1 ) ),
631 $ abs( rwork( 2 ) ) )
632 lam_min = min( abs( rwork( 1 ) ),
633 $ abs( rwork( 2 ) ) )
635 stemp = lam_max / lam_min
639 stemp = abs( stemp ) - const + thresh
640 IF( stemp.GT.result( 4 ) )
641 $ result( 4 ) = stemp
660 IF( iwork( k ).LT.zero )
THEN
665 CALL
ssyevx(
'N',
'A', uplo, 2,
666 $ ainv( ( k-1 )*lda+k ), lda, stemp,
667 $ stemp, itemp, itemp, zero, itemp,
668 $ rwork, sdummy, 1, work, 16,
669 $ iwork( n+1 ), idummy, info )
671 lam_max = max( abs( rwork( 1 ) ),
672 $ abs( rwork( 2 ) ) )
673 lam_min = min( abs( rwork( 1 ) ),
674 $ abs( rwork( 2 ) ) )
676 stemp = lam_max / lam_min
680 stemp = abs( stemp ) - const + thresh
681 IF( stemp.GT.result( 4 ) )
682 $ result( 4 ) = stemp
697 IF( result( k ).GE.thresh )
THEN
698 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
699 $ CALL
alahd( nout, path )
700 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
732 CALL
slarhs( matpath, xtype, uplo,
' ', n, n,
733 $ kl, ku, nrhs, a, lda, xact, lda,
734 $
b, lda, iseed, info )
735 CALL
slacpy(
'Full', n, nrhs,
b, lda, x, lda )
737 srnamt =
'SSYTRS_ROOK'
744 $ CALL
alaerh( path,
'SSYTRS_ROOK', info, 0,
745 $ uplo, n, n, -1, -1, nrhs, imat,
746 $ nfail, nerrs, nout )
748 CALL
slacpy(
'Full', n, nrhs,
b, lda, work, lda )
752 CALL
spot02( uplo, n, nrhs, a, lda, x, lda, work,
753 $ lda, rwork, result( 5 ) )
758 CALL
sget04( n, nrhs, x, lda, xact, lda, rcondc,
765 IF( result( k ).GE.thresh )
THEN
766 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
767 $ CALL
alahd( nout, path )
768 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
769 $ imat, k, result( k )
783 anorm =
slansy(
'1', uplo, n, a, lda, rwork )
784 srnamt =
'SSYCON_ROOK'
785 CALL
ssycon_rook( uplo, n, afac, lda, iwork, anorm,
786 $ rcond, work, iwork( n+1 ), info )
791 $ CALL
alaerh( path,
'SSYCON_ROOK', info, 0,
792 $ uplo, n, n, -1, -1, -1, imat,
793 $ nfail, nerrs, nout )
797 result( 7 ) =
sget06( rcond, rcondc )
802 IF( result( 7 ).GE.thresh )
THEN
803 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
804 $ CALL
alahd( nout, path )
805 WRITE( nout, fmt = 9997 )uplo, n, imat, 7,
818 CALL
alasum( path, nout, nfail, nrun, nerrs )
820 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
821 $ i2,
', test ', i2,
', ratio =', g12.5 )
822 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
823 $ i2,
', test(', i2,
') =', g12.5 )
824 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
825 $
', test(', i2,
') =', g12.5 )
subroutine ssytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF_ROOK
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine ssytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS_ROOK
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine ssycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON_ROOK
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
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine schksy_rook(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKSY_ROOK
subroutine ssyevx(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO)
SSYEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine serrsy(PATH, NUNIT)
SERRSY
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 xlaenv(ISPEC, NVALUE)
XLAENV
subroutine ssyt01_rook(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
SSYT01_ROOK
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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 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