162 SUBROUTINE dchksp( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
163 $ nmax, a, afac, ainv, b, x, xact, work, rwork,
173 INTEGER NMAX, NN, NNS, NOUT
174 DOUBLE PRECISION THRESH
178 INTEGER IWORK( * ), NSVAL( * ), NVAL( * )
179 DOUBLE PRECISION A( * ), AFAC( * ), AINV( * ), B( * ),
180 $ rwork( * ), work( * ), x( * ), xact( * )
186 DOUBLE PRECISION ZERO
187 parameter( zero = 0.0d+0 )
189 parameter( ntypes = 10 )
191 parameter( ntests = 8 )
194 LOGICAL TRFCON, ZEROT
195 CHARACTER DIST, PACKIT,
TYPE, UPLO, XTYPE
197 INTEGER I, I1, I2, IMAT, IN, INFO, IOFF, IRHS, IUPLO,
198 $ izero, j, k, kl, ku, lda, mode, n, nerrs,
199 $ nfail, nimat, npp, nrhs, nrun, nt
200 DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC
204 INTEGER ISEED( 4 ), ISEEDY( 4 )
205 DOUBLE PRECISION RESULT( ntests )
209 DOUBLE PRECISION DGET06, DLANSP
210 EXTERNAL lsame, dget06, dlansp
227 COMMON / infoc / infot, nunit, ok, lerr
228 COMMON / srnamc / srnamt
231 DATA iseedy / 1988, 1989, 1990, 1991 /
232 DATA uplos /
'U',
'L' /
238 path( 1: 1 ) =
'Double precision'
244 iseed( i ) = iseedy( i )
250 $ CALL
derrsy( path, nout )
264 DO 160 imat = 1, nimat
268 IF( .NOT.dotype( imat ) )
273 zerot = imat.GE.3 .AND. imat.LE.6
274 IF( zerot .AND. n.LT.imat-2 )
280 uplo = uplos( iuplo )
281 IF( lsame( uplo,
'U' ) )
THEN
290 CALL
dlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
294 CALL
dlatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
295 $ cndnum, anorm, kl, ku, packit, a, lda, work,
301 CALL
alaerh( path,
'DLATMS', info, 0, uplo, n, n, -1,
302 $ -1, -1, imat, nfail, nerrs, nout )
312 ELSE IF( imat.EQ.4 )
THEN
322 IF( iuplo.EQ.1 )
THEN
323 ioff = ( izero-1 )*izero / 2
324 DO 20 i = 1, izero - 1
334 DO 40 i = 1, izero - 1
345 IF( iuplo.EQ.1 )
THEN
376 CALL
dcopy( npp, a, 1, afac, 1 )
378 CALL
dsptrf( uplo, n, afac, iwork, info )
386 IF( iwork( k ).LT.0 )
THEN
387 IF( iwork( k ).NE.-k )
THEN
391 ELSE IF( iwork( k ).NE.k )
THEN
400 $ CALL
alaerh( path,
'DSPTRF', info, k, uplo, n, n, -1,
401 $ -1, -1, imat, nfail, nerrs, nout )
411 CALL
dspt01( uplo, n, a, afac, iwork, ainv, lda, rwork,
418 IF( .NOT.trfcon )
THEN
419 CALL
dcopy( npp, afac, 1, ainv, 1 )
421 CALL
dsptri( uplo, n, ainv, iwork, work, info )
426 $ CALL
alaerh( path,
'DSPTRI', info, 0, uplo, n, n,
427 $ -1, -1, -1, imat, nfail, nerrs, nout )
429 CALL
dppt03( uplo, n, a, ainv, work, lda, rwork,
430 $ rcondc, result( 2 ) )
438 IF( result( k ).GE.thresh )
THEN
439 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
440 $ CALL
alahd( nout, path )
441 WRITE( nout, fmt = 9999 )uplo, n, imat, k,
462 CALL
dlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
463 $ nrhs, a, lda, xact, lda, b, lda, iseed,
465 CALL
dlacpy(
'Full', n, nrhs, b, lda, x, lda )
468 CALL
dsptrs( uplo, n, nrhs, afac, iwork, x, lda,
474 $ CALL
alaerh( path,
'DSPTRS', info, 0, uplo, n, n,
475 $ -1, -1, nrhs, imat, nfail, nerrs,
478 CALL
dlacpy(
'Full', n, nrhs, b, lda, work, lda )
479 CALL
dppt02( uplo, n, nrhs, a, x, lda, work, lda,
480 $ rwork, result( 3 ) )
485 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
492 CALL
dsprfs( uplo, n, nrhs, a, afac, iwork, b, lda, x,
493 $ lda, rwork, rwork( nrhs+1 ), work,
494 $ iwork( n+1 ), info )
499 $ CALL
alaerh( path,
'DSPRFS', info, 0, uplo, n, n,
500 $ -1, -1, nrhs, imat, nfail, nerrs,
503 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
505 CALL
dppt05( uplo, n, nrhs, a, b, lda, x, lda, xact,
506 $ lda, rwork, rwork( nrhs+1 ),
513 IF( result( k ).GE.thresh )
THEN
514 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
515 $ CALL
alahd( nout, path )
516 WRITE( nout, fmt = 9998 )uplo, n, nrhs, imat,
528 anorm = dlansp(
'1', uplo, n, a, rwork )
530 CALL
dspcon( uplo, n, afac, iwork, anorm, rcond, work,
531 $ iwork( n+1 ), info )
536 $ CALL
alaerh( path,
'DSPCON', info, 0, uplo, n, n, -1,
537 $ -1, -1, imat, nfail, nerrs, nout )
539 result( 8 ) = dget06( rcond, rcondc )
543 IF( result( 8 ).GE.thresh )
THEN
544 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
545 $ CALL
alahd( nout, path )
546 WRITE( nout, fmt = 9999 )uplo, n, imat, 8,
557 CALL
alasum( path, nout, nfail, nrun, nerrs )
559 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', type ', i2,
', test ',
560 $ i2,
', ratio =', g12.5 )
561 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
562 $ i2,
', test(', i2,
') =', g12.5 )
subroutine dppt03(UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
DPPT03
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine dsptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
DSPTRS
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine dchksp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
DCHKSP
subroutine derrsy(PATH, NUNIT)
DERRSY
subroutine dspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSPCON
subroutine dspt01(UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
DSPT01
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
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 dppt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
DPPT02
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine dsprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSPRFS
subroutine dsptri(UPLO, N, AP, IPIV, WORK, INFO)
DSPTRI
subroutine dsptrf(UPLO, N, AP, IPIV, INFO)
DSPTRF
subroutine dppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DPPT05
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