146 SUBROUTINE dchkpt( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
147 $ a, d, e, b, x, xact, work, rwork, nout )
156 INTEGER NN, NNS, NOUT
157 DOUBLE PRECISION THRESH
161 INTEGER NSVAL( * ), NVAL( * )
162 DOUBLE PRECISION A( * ), B( * ), D( * ), E( * ), RWORK( * ),
163 $ work( * ), x( * ), xact( * )
169 DOUBLE PRECISION ONE, ZERO
170 parameter( one = 1.0d+0, zero = 0.0d+0 )
172 parameter( ntypes = 12 )
174 parameter( ntests = 7 )
180 INTEGER I, IA, IMAT, IN, INFO, IRHS, IX, IZERO, J, K,
181 $ kl, ku, lda, mode, n, nerrs, nfail, nimat,
183 DOUBLE PRECISION AINVNM, ANORM, COND, DMAX, RCOND, RCONDC
186 INTEGER ISEED( 4 ), ISEEDY( 4 )
187 DOUBLE PRECISION RESULT( ntests ), Z( 3 )
191 DOUBLE PRECISION DASUM, DGET06, DLANST
192 EXTERNAL idamax, dasum, dget06, dlanst
209 COMMON / infoc / infot, nunit, ok, lerr
210 COMMON / srnamc / srnamt
213 DATA iseedy / 0, 0, 0, 1 /
217 path( 1: 1 ) =
'Double precision'
223 iseed( i ) = iseedy( i )
229 $ CALL
derrgt( path, nout )
242 DO 100 imat = 1, nimat
246 IF( n.GT.0 .AND. .NOT.dotype( imat ) )
251 CALL
dlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
254 zerot = imat.GE.8 .AND. imat.LE.10
261 CALL
dlatms( n, n, dist, iseed,
TYPE, RWORK, MODE, COND,
262 $ anorm, kl, ku,
'B', a, 2, work, info )
267 CALL
alaerh( path,
'DLATMS', info, 0,
' ', n, n, kl,
268 $ ku, -1, imat, nfail, nerrs, nout )
288 IF( .NOT.zerot .OR. .NOT.dotype( 7 ) )
THEN
292 CALL
dlarnv( 2, iseed, n, d )
293 CALL
dlarnv( 2, iseed, n-1, e )
298 d( 1 ) = abs( d( 1 ) )
300 d( 1 ) = abs( d( 1 ) ) + abs( e( 1 ) )
301 d( n ) = abs( d( n ) ) + abs( e( n-1 ) )
303 d( i ) = abs( d( i ) ) + abs( e( i ) ) +
310 ix = idamax( n, d, 1 )
312 CALL
dscal( n, anorm / dmax, d, 1 )
313 CALL
dscal( n-1, anorm / dmax, e, 1 )
315 ELSE IF( izero.GT.0 )
THEN
320 IF( izero.EQ.1 )
THEN
324 ELSE IF( izero.EQ.n )
THEN
328 e( izero-1 ) = z( 1 )
346 ELSE IF( imat.EQ.9 )
THEN
354 ELSE IF( imat.EQ.10 )
THEN
356 IF( izero.GT.1 )
THEN
357 z( 1 ) = e( izero-1 )
367 CALL
dcopy( n, d, 1, d( n+1 ), 1 )
369 $ CALL
dcopy( n-1, e, 1, e( n+1 ), 1 )
375 CALL
dpttrf( n, d( n+1 ), e( n+1 ), info )
379 IF( info.NE.izero )
THEN
380 CALL
alaerh( path,
'DPTTRF', info, izero,
' ', n, n, -1,
381 $ -1, -1, imat, nfail, nerrs, nout )
390 CALL
dptt01( n, d, e, d( n+1 ), e( n+1 ), work,
395 IF( result( 1 ).GE.thresh )
THEN
396 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
397 $ CALL
alahd( nout, path )
398 WRITE( nout, fmt = 9999 )n, imat, 1, result( 1 )
407 anorm = dlanst(
'1', n, d, e )
418 CALL
dpttrs( n, 1, d( n+1 ), e( n+1 ), x, lda, info )
419 ainvnm = max( ainvnm, dasum( n, x, 1 ) )
421 rcondc = one / max( one, anorm*ainvnm )
430 CALL
dlarnv( 2, iseed, n, xact( ix ) )
436 CALL
dlaptm( n, nrhs, one, d, e, xact, lda, zero, b,
442 CALL
dlacpy(
'Full', n, nrhs, b, lda, x, lda )
443 CALL
dpttrs( n, nrhs, d( n+1 ), e( n+1 ), x, lda, info )
448 $ CALL
alaerh( path,
'DPTTRS', info, 0,
' ', n, n, -1,
449 $ -1, nrhs, imat, nfail, nerrs, nout )
451 CALL
dlacpy(
'Full', n, nrhs, b, lda, work, lda )
452 CALL
dptt02( n, nrhs, d, e, x, lda, work, lda,
458 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
465 CALL
dptrfs( n, nrhs, d, e, d( n+1 ), e( n+1 ), b, lda,
466 $ x, lda, rwork, rwork( nrhs+1 ), work, info )
471 $ CALL
alaerh( path,
'DPTRFS', info, 0,
' ', n, n, -1,
472 $ -1, nrhs, imat, nfail, nerrs, nout )
474 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
476 CALL
dptt05( n, nrhs, d, e, b, lda, x, lda, xact, lda,
477 $ rwork, rwork( nrhs+1 ), result( 5 ) )
483 IF( result( k ).GE.thresh )
THEN
484 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
485 $ CALL
alahd( nout, path )
486 WRITE( nout, fmt = 9998 )n, nrhs, imat, k,
500 CALL
dptcon( n, d( n+1 ), e( n+1 ), anorm, rcond, rwork,
506 $ CALL
alaerh( path,
'DPTCON', info, 0,
' ', n, n, -1, -1,
507 $ -1, imat, nfail, nerrs, nout )
509 result( 7 ) = dget06( rcond, rcondc )
513 IF( result( 7 ).GE.thresh )
THEN
514 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
515 $ CALL
alahd( nout, path )
516 WRITE( nout, fmt = 9999 )n, imat, 7, result( 7 )
525 CALL
alasum( path, nout, nfail, nrun, nerrs )
527 9999
FORMAT(
' N =', i5,
', type ', i2,
', test ', i2,
', ratio = ',
529 9998
FORMAT(
' N =', i5,
', NRHS=', i3,
', type ', i2,
', test(', i2,
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 dpttrf(N, D, E, INFO)
DPTTRF
subroutine dptrfs(N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, INFO)
DPTRFS
subroutine dptt01(N, D, E, DF, EF, WORK, RESID)
DPTT01
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine derrgt(PATH, NUNIT)
DERRGT
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine dlarnv(IDIST, ISEED, N, X)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine dptt02(N, NRHS, D, E, X, LDX, B, LDB, RESID)
DPTT02
subroutine dpttrs(N, NRHS, D, E, B, LDB, INFO)
DPTTRS
subroutine dptcon(N, D, E, ANORM, RCOND, WORK, INFO)
DPTCON
subroutine dptt05(N, NRHS, D, E, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DPTT05
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 dchkpt(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
DCHKPT
subroutine dlaptm(N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB)
DLAPTM