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 )
215 DOUBLE PRECISION DGET06, DLANSY
216 EXTERNAL dget06, dlansy
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 dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine alahd(IOUNIT, PATH)
ALAHD
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 dsyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSYRFS
subroutine dsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRI2
subroutine dsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine dpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
DPOT03
subroutine dsyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
DSYT01
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
subroutine dsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS
subroutine dsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF
subroutine derrsy(PATH, NUNIT)
DERRSY
subroutine dsytrs2(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO)
DSYTRS2
subroutine dpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DPOT05
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 alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM