169 SUBROUTINE dchksy( 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
181 DOUBLE PRECISION thresh
185 INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
186 DOUBLE PRECISION a( * ), afac( * ), ainv( * ),
b( * ),
187 $ rwork( * ), work( * ), x( * ), xact( * )
193 DOUBLE PRECISION zero
194 parameter( zero = 0.0d+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 DOUBLE PRECISION anorm, cndnum, rcond, rcondc
211 INTEGER iseed( 4 ), iseedy( 4 )
212 DOUBLE PRECISION result( ntests )
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 ) =
'Double precision'
250 iseed( i ) = iseedy( i )
256 $ CALL
derrsy( 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 )
302 CALL
dlatb4( path, imat, n, n, type, kl, ku, anorm, mode,
308 CALL
dlatms( n, n, dist, iseed, type, rwork, mode,
309 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
315 CALL
alaerh( path,
'DLATMS', info, 0, uplo, n, n, -1,
316 $ -1, -1, imat, nfail, nerrs, nout )
330 ELSE IF( imat.EQ.4 )
THEN
340 IF( iuplo.EQ.1 )
THEN
341 ioff = ( izero-1 )*lda
342 DO 20 i = 1, izero - 1
352 DO 40 i = 1, izero - 1
362 IF( iuplo.EQ.1 )
THEN
408 CALL
dlacpy( uplo, n, n, a, lda, afac, lda )
415 lwork = max( 2, nb )*lda
417 CALL
dsytrf( 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,
'DSYTRF', info, k, uplo, n, n,
441 $ -1, -1, nb, imat, nfail, nerrs, nout )
454 CALL
dsyt01( uplo, n, a, lda, afac, lda, iwork, ainv,
455 $ lda, rwork, result( 1 ) )
464 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN
465 CALL
dlacpy( uplo, n, n, afac, lda, ainv, lda )
467 lwork = (n+nb+1)*(nb+3)
468 CALL
dsytri2( uplo, n, ainv, lda, iwork, work,
474 $ CALL
alaerh( path,
'DSYTRI2', info, -1, uplo, n,
475 $ n, -1, -1, -1, imat, nfail, nerrs,
481 CALL
dpot03( 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
dlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
526 $ nrhs, a, lda, xact, lda,
b, lda,
528 CALL
dlacpy(
'Full', n, nrhs,
b, lda, x, lda )
531 CALL
dsytrs( uplo, n, nrhs, afac, lda, iwork, x,
537 $ CALL
alaerh( path,
'DSYTRS', info, 0, uplo, n,
538 $ n, -1, -1, nrhs, imat, nfail,
541 CALL
dlacpy(
'Full', n, nrhs,
b, lda, work, lda )
545 CALL
dpot02( uplo, n, nrhs, a, lda, x, lda, work,
546 $ lda, rwork, result( 3 ) )
556 CALL
dlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
557 $ nrhs, a, lda, xact, lda,
b, lda,
559 CALL
dlacpy(
'Full', n, nrhs,
b, lda, x, lda )
562 CALL
dsytrs2( uplo, n, nrhs, afac, lda, iwork, x,
568 $ CALL
alaerh( path,
'DSYTRS2', info, 0, uplo, n,
569 $ n, -1, -1, nrhs, imat, nfail,
572 CALL
dlacpy(
'Full', n, nrhs,
b, lda, work, lda )
576 CALL
dpot02( uplo, n, nrhs, a, lda, x, lda, work,
577 $ lda, rwork, result( 4 ) )
582 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
589 CALL
dsyrfs( uplo, n, nrhs, a, lda, afac, lda,
590 $ iwork,
b, lda, x, lda, rwork,
591 $ rwork( nrhs+1 ), work, iwork( n+1 ),
597 $ CALL
alaerh( path,
'DSYRFS', info, 0, uplo, n,
598 $ n, -1, -1, nrhs, imat, nfail,
601 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
603 CALL
dpot05( uplo, n, nrhs, a, lda,
b, lda, x, lda,
604 $ xact, lda, rwork, rwork( nrhs+1 ),
611 IF( result( k ).GE.thresh )
THEN
612 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
613 $ CALL
alahd( nout, path )
614 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
615 $ imat, k, result( k )
629 anorm =
dlansy(
'1', uplo, n, a, lda, rwork )
631 CALL
dsycon( uplo, n, afac, lda, iwork, anorm, rcond,
632 $ work, iwork( n+1 ), info )
637 $ CALL
alaerh( path,
'DSYCON', info, 0, uplo, n, n,
638 $ -1, -1, -1, imat, nfail, nerrs, nout )
642 result( 9 ) =
dget06( rcond, rcondc )
647 IF( result( 9 ).GE.thresh )
THEN
648 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
649 $ CALL
alahd( nout, path )
650 WRITE( nout, fmt = 9997 )uplo, n, imat, 9,
663 CALL
alasum( path, nout, nfail, nrun, nerrs )
665 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
666 $ i2,
', test ', i2,
', ratio =', g12.5 )
667 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
668 $ i2,
', test(', i2,
') =', g12.5 )
669 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
670 $
', test(', i2,
') =', g12.5 )
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine dchksy(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
DCHKSY
subroutine dpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DPOT02
subroutine dsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON
subroutine dsytrs2(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO)
DSYTRS2
subroutine derrsy(PATH, NUNIT)
DERRSY
subroutine dpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DPOT05
subroutine dsyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSYRFS
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 alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
double precision function dget06(RCOND, RCONDC)
DGET06
subroutine dpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
DPOT03
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRI2
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 dsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS
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 dsyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
DSYT01
subroutine dsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF