152 $ nmax, a, afac, ainv,
b,
x, xact, work,
153 $ rwork, iwork, nout )
162 INTEGER nmax, nn, nout, nrhs
163 DOUBLE PRECISION thresh
167 INTEGER iwork( * ), nval( * )
168 DOUBLE PRECISION a( * ), afac( * ), ainv( * ),
b( * ),
169 $ rwork( * ), work( * ),
x( * ), xact( * )
175 DOUBLE PRECISION one, zero
176 parameter( one = 1.0d+0, zero = 0.0d+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 path, matpath
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
189 DOUBLE PRECISION ainvnm, anorm, cndnum, rcondc
192 CHARACTER facts( nfact ), uplos( 2 )
193 INTEGER iseed( 4 ), iseedy( 4 )
194 DOUBLE PRECISION result( ntests )
213 COMMON / infoc / infot, nunit, ok, lerr
214 COMMON / srnamc / srnamt
220 DATA iseedy / 1988, 1989, 1990, 1991 /
221 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
229 path( 1: 1 ) =
'Double precision'
234 matpath( 1: 1 ) =
'Double precision'
235 matpath( 2: 3 ) =
'SY'
241 iseed( i ) = iseedy( i )
243 lwork = max( 2*nmax, nmax*nrhs )
248 $ CALL
derrvx( path, nout )
269 DO 170 imat = 1, nimat
273 IF( .NOT.dotype( imat ) )
278 zerot = imat.GE.3 .AND. imat.LE.6
279 IF( zerot .AND. n.LT.imat-2 )
285 uplo = uplos( iuplo )
292 CALL
dlatb4( matpath, imat, n, n, type, kl, ku, anorm,
293 $ mode, cndnum, dist )
298 CALL
dlatms( n, n, dist, iseed, type, rwork, mode,
299 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
305 CALL
alaerh( path,
'DLATMS', info, 0, uplo, n, n, -1,
306 $ -1, -1, imat, nfail, nerrs, nout )
319 ELSE IF( imat.EQ.4 )
THEN
329 IF( iuplo.EQ.1 )
THEN
330 ioff = ( izero-1 )*lda
331 DO 20 i = 1, izero - 1
341 DO 40 i = 1, izero - 1
352 IF( iuplo.EQ.1 )
THEN
382 DO 150 ifact = 1, nfact
386 fact = facts( ifact )
396 ELSE IF( ifact.EQ.1 )
THEN
400 anorm =
dlansy(
'1', uplo, n, a, lda, rwork )
404 CALL
dlacpy( uplo, n, n, a, lda, afac, lda )
410 CALL
dlacpy( uplo, n, n, afac, lda, ainv, lda )
411 lwork = (n+nb+1)*(nb+3)
414 ainvnm =
dlansy(
'1', uplo, n, ainv, lda, rwork )
418 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
421 rcondc = ( one / anorm ) / ainvnm
428 CALL
dlarhs( matpath, xtype, uplo,
' ', n, n, kl, ku,
429 $ nrhs, a, lda, xact, lda,
b, lda, iseed,
435 IF( ifact.EQ.2 )
THEN
436 CALL
dlacpy( uplo, n, n, a, lda, afac, lda )
437 CALL
dlacpy(
'Full', n, nrhs,
b, lda,
x, lda )
442 srnamt =
'DSYSV_ROOK'
443 CALL
dsysv_rook( uplo, n, nrhs, afac, lda, iwork,
444 $
x, lda, work, lwork, info )
452 IF( iwork( k ).LT.0 )
THEN
453 IF( iwork( k ).NE.-k )
THEN
457 ELSE IF( iwork( k ).NE.k )
THEN
466 CALL
alaerh( path,
'DSYSV_ROOK', info, k, uplo,
467 $ n, n, -1, -1, nrhs, imat, nfail,
470 ELSE IF( info.NE.0 )
THEN
478 $ iwork, ainv, lda, rwork,
483 CALL
dlacpy(
'Full', n, nrhs,
b, lda, work, lda )
484 CALL
dpot02( uplo, n, nrhs, a, lda,
x, lda, work,
485 $ lda, rwork, result( 2 ) )
490 CALL
dget04( n, nrhs,
x, lda, xact, lda, rcondc,
498 IF( result( k ).GE.thresh )
THEN
499 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
500 $ CALL
aladhd( nout, path )
501 WRITE( nout, fmt = 9999 )
'DSYSV_ROOK', uplo,
502 $ n, imat, k, result( k )
518 CALL
alasvm( path, nout, nfail, nrun, nerrs )
520 9999
FORMAT( 1
x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
521 $
', test ', i2,
', ratio =', g12.5 )
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine dpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DPOT02
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine dpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DPOT05
DOUBLE PRECISION function dlansy(NORM, UPLO, N, A, LDA, WORK)
DLANSY 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 derrvx(PATH, NUNIT)
DERRVX
subroutine dsytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF_ROOK
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine ddrvsy_rook(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
DDRVSY_ROOK
subroutine dsysv_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
DSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices ...
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine dsyt01_rook(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
DSYT01_ROOK
subroutine aladhd(IOUNIT, PATH)
ALADHD
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
subroutine dsytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
DSYTRI_ROOK
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...