171 SUBROUTINE dchksy_aa( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
172 $ thresh, tsterr, nmax, a, afac, ainv, b,
173 $ x, xact, work, rwork, iwork, nout )
184 INTEGER NN, NNB, NNS, NMAX, NOUT
185 DOUBLE PRECISION THRESH
189 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
190 DOUBLE PRECISION A( * ), AFAC( * ), AINV( * ), B( * ),
191 $ rwork( * ), work( * ), x( * ), xact( * )
197 DOUBLE PRECISION ZERO, ONE
198 parameter ( zero = 0.0d+0, one = 1.0d+0 )
200 parameter ( ntypes = 10 )
202 parameter ( ntests = 9 )
206 CHARACTER DIST,
TYPE, UPLO, XTYPE
207 CHARACTER*3 PATH, MATPATH
208 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
209 $ iuplo, izero, j, k, kl, ku, lda, lwork, mode,
210 $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
211 DOUBLE PRECISION ANORM, CNDNUM
215 INTEGER ISEED( 4 ), ISEEDY( 4 )
216 DOUBLE PRECISION RESULT( ntests )
219 DOUBLE PRECISION DGET06, DLANSY
220 EXTERNAL dget06, dlansy
237 COMMON / infoc / infot, nunit, ok, lerr
238 COMMON / srnamc / srnamt
241 DATA iseedy / 1988, 1989, 1990, 1991 /
242 DATA uplos /
'U',
'L' /
250 path( 1: 1 ) =
'Double precision'
255 matpath( 1: 1 ) =
'Double precision'
256 matpath( 2: 3 ) =
'SY'
261 iseed( i ) = iseedy( i )
267 $
CALL derrsy( path, nout )
279 IF( n .GT. nmax )
THEN
281 WRITE(nout, 9995)
'M ', n, nmax
294 DO 170 imat = 1, nimat
298 IF( .NOT.dotype( imat ) )
303 zerot = imat.GE.3 .AND. imat.LE.6
304 IF( zerot .AND. n.LT.imat-2 )
310 uplo = uplos( iuplo )
318 CALL dlatb4( matpath, imat, n, n,
TYPE, KL, KU,
319 $ anorm, mode, cndnum, dist )
324 CALL dlatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
325 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
331 CALL alaerh( path,
'DLATMS', info, 0, uplo, n, n, -1,
332 $ -1, -1, imat, nfail, nerrs, nout )
346 ELSE IF( imat.EQ.4 )
THEN
356 IF( iuplo.EQ.1 )
THEN
357 ioff = ( izero-1 )*lda
358 DO 20 i = 1, izero - 1
368 DO 40 i = 1, izero - 1
378 IF( iuplo.EQ.1 )
THEN
425 CALL dlacpy( uplo, n, n, a, lda, afac, lda )
433 lwork = max( 1, n*nb + n )
434 CALL dsytrf_aa( uplo, n, afac, lda, iwork, ainv,
440 IF( izero.GT.0 )
THEN
446 ELSE IF( iwork( j ).EQ.k )
THEN
460 CALL alaerh( path,
'DSYTRF_AA', info, k, uplo,
461 $ n, n, -1, -1, nb, imat, nfail, nerrs,
468 CALL dsyt01_aa( uplo, n, a, lda, afac, lda, iwork,
469 $ ainv, lda, rwork, result( 1 ) )
477 IF( result( k ).GE.thresh )
THEN
478 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
479 $
CALL alahd( nout, path )
480 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
505 CALL dlarhs( matpath, xtype, uplo,
' ', n, n,
506 $ kl, ku, nrhs, a, lda, xact, lda,
507 $ b, lda, iseed, info )
508 CALL dlacpy(
'Full', n, nrhs, b, lda, x, lda )
511 lwork = max( 1, 3*n-2 )
512 CALL dsytrs_aa( uplo, n, nrhs, afac, lda,
513 $ iwork, x, lda, work, lwork,
519 CALL alaerh( path,
'DSYTRS_AA', info, 0,
520 $ uplo, n, n, -1, -1, nrhs, imat,
521 $ nfail, nerrs, nout )
524 CALL dlacpy(
'Full', n, nrhs, b, lda, work, lda )
528 CALL dpot02( uplo, n, nrhs, a, lda, x, lda, work,
529 $ lda, rwork, result( 2 ) )
536 IF( result( k ).GE.thresh )
THEN
537 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
538 $
CALL alahd( nout, path )
539 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
540 $ imat, k, result( k )
557 CALL alasum( path, nout, nfail, nrun, nerrs )
559 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
560 $ i2,
', test ', i2,
', ratio =', g12.5 )
561 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
562 $ i2,
', test(', i2,
') =', g12.5 )
563 9995
FORMAT(
' Invalid input value: ', a4,
'=', i6,
'; must be <=',
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 dsyt01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
DSYT01
subroutine dpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
DPOT03
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 dsytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF_AA
subroutine derrsy(PATH, NUNIT)
DERRSY
subroutine dchksy_aa(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
DCHKSY_AA
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 dsytrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
DSYTRS_AA
subroutine dpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DPOT02
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM