140 SUBROUTINE zdrvpt( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, D,
141 $ e, b, x, xact, work, rwork, nout )
150 INTEGER NN, NOUT, NRHS
151 DOUBLE PRECISION THRESH
156 DOUBLE PRECISION D( * ), RWORK( * )
157 COMPLEX*16 A( * ), B( * ), E( * ), WORK( * ), X( * ),
164 DOUBLE PRECISION ONE, ZERO
165 parameter ( one = 1.0d+0, zero = 0.0d+0 )
167 parameter ( ntypes = 12 )
169 parameter ( ntests = 6 )
173 CHARACTER DIST, FACT, TYPE
175 INTEGER I, IA, IFACT, IMAT, IN, INFO, IX, IZERO, J, K,
176 $ k1, kl, ku, lda, mode, n, nerrs, nfail, nimat,
178 DOUBLE PRECISION AINVNM, ANORM, COND, DMAX, RCOND, RCONDC
181 INTEGER ISEED( 4 ), ISEEDY( 4 )
182 DOUBLE PRECISION RESULT( ntests ), Z( 3 )
186 DOUBLE PRECISION DGET06, DZASUM, ZLANHT
187 EXTERNAL idamax, dget06, dzasum, zlanht
196 INTRINSIC abs, dcmplx, max
204 COMMON / infoc / infot, nunit, ok, lerr
205 COMMON / srnamc / srnamt
208 DATA iseedy / 0, 0, 0, 1 /
212 path( 1: 1 ) =
'Zomplex precision'
218 iseed( i ) = iseedy( i )
224 $
CALL zerrvx( path, nout )
237 DO 110 imat = 1, nimat
241 IF( n.GT.0 .AND. .NOT.dotype( imat ) )
246 CALL zlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
249 zerot = imat.GE.8 .AND. imat.LE.10
256 CALL zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE, COND,
257 $ anorm, kl, ku,
'B', a, 2, work, info )
262 CALL alaerh( path,
'ZLATMS', info, 0,
' ', n, n, kl,
263 $ ku, -1, imat, nfail, nerrs, nout )
283 IF( .NOT.zerot .OR. .NOT.dotype( 7 ) )
THEN
287 CALL dlarnv( 2, iseed, n, d )
288 CALL zlarnv( 2, iseed, n-1, e )
293 d( 1 ) = abs( d( 1 ) )
295 d( 1 ) = abs( d( 1 ) ) + abs( e( 1 ) )
296 d( n ) = abs( d( n ) ) + abs( e( n-1 ) )
298 d( i ) = abs( d( i ) ) + abs( e( i ) ) +
305 ix = idamax( n, d, 1 )
307 CALL dscal( n, anorm / dmax, d, 1 )
309 $
CALL zdscal( n-1, anorm / dmax, e, 1 )
311 ELSE IF( izero.GT.0 )
THEN
316 IF( izero.EQ.1 )
THEN
320 ELSE IF( izero.EQ.n )
THEN
324 e( izero-1 ) = z( 1 )
342 ELSE IF( imat.EQ.9 )
THEN
350 ELSE IF( imat.EQ.10 )
THEN
352 IF( izero.GT.1 )
THEN
353 z( 1 ) = e( izero-1 )
367 CALL zlarnv( 2, iseed, n, xact( ix ) )
373 CALL zlaptm(
'Lower', n, nrhs, one, d, e, xact, lda, zero,
377 IF( ifact.EQ.1 )
THEN
391 ELSE IF( ifact.EQ.1 )
THEN
395 anorm = zlanht(
'1', n, d, e )
397 CALL dcopy( n, d, 1, d( n+1 ), 1 )
399 $
CALL zcopy( n-1, e, 1, e( n+1 ), 1 )
403 CALL zpttrf( n, d( n+1 ), e( n+1 ), info )
414 CALL zpttrs(
'Lower', n, 1, d( n+1 ), e( n+1 ), x,
416 ainvnm = max( ainvnm, dzasum( n, x, 1 ) )
421 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
424 rcondc = ( one / anorm ) / ainvnm
428 IF( ifact.EQ.2 )
THEN
432 CALL dcopy( n, d, 1, d( n+1 ), 1 )
434 $
CALL zcopy( n-1, e, 1, e( n+1 ), 1 )
435 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
440 CALL zptsv( n, nrhs, d( n+1 ), e( n+1 ), x, lda,
446 $
CALL alaerh( path,
'ZPTSV ', info, izero,
' ', n,
447 $ n, 1, 1, nrhs, imat, nfail, nerrs,
450 IF( izero.EQ.0 )
THEN
455 CALL zptt01( n, d, e, d( n+1 ), e( n+1 ), work,
460 CALL zlacpy(
'Full', n, nrhs, b, lda, work, lda )
461 CALL zptt02(
'Lower', n, nrhs, d, e, x, lda, work,
466 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
475 IF( result( k ).GE.thresh )
THEN
476 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
477 $
CALL aladhd( nout, path )
478 WRITE( nout, fmt = 9999 )
'ZPTSV ', n, imat, k,
488 IF( ifact.GT.1 )
THEN
500 CALL zlaset(
'Full', n, nrhs, dcmplx( zero ),
501 $ dcmplx( zero ), x, lda )
507 CALL zptsvx( fact, n, nrhs, d, e, d( n+1 ), e( n+1 ), b,
508 $ lda, x, lda, rcond, rwork, rwork( nrhs+1 ),
509 $ work, rwork( 2*nrhs+1 ), info )
514 $
CALL alaerh( path,
'ZPTSVX', info, izero, fact, n, n,
515 $ 1, 1, nrhs, imat, nfail, nerrs, nout )
516 IF( izero.EQ.0 )
THEN
517 IF( ifact.EQ.2 )
THEN
523 CALL zptt01( n, d, e, d( n+1 ), e( n+1 ), work,
531 CALL zlacpy(
'Full', n, nrhs, b, lda, work, lda )
532 CALL zptt02(
'Lower', n, nrhs, d, e, x, lda, work,
537 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
542 CALL zptt05( n, nrhs, d, e, b, lda, x, lda, xact, lda,
543 $ rwork, rwork( nrhs+1 ), result( 4 ) )
550 result( 6 ) = dget06( rcond, rcondc )
556 IF( result( k ).GE.thresh )
THEN
557 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
558 $
CALL aladhd( nout, path )
559 WRITE( nout, fmt = 9998 )
'ZPTSVX', fact, n, imat,
571 CALL alasvm( path, nout, nfail, nrun, nerrs )
573 9999
FORMAT( 1x, a,
', N =', i5,
', type ', i2,
', test ', i2,
574 $
', ratio = ', g12.5 )
575 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', N =', i5,
', type ', i2,
576 $
', test ', i2,
', ratio = ', g12.5 )
subroutine zpttrs(UPLO, N, NRHS, D, E, B, LDB, INFO)
ZPTTRS
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zlaptm(UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB)
ZLAPTM
subroutine zpttrf(N, D, E, INFO)
ZPTTRF
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
subroutine zdrvpt(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
ZDRVPT
subroutine zptt01(N, D, E, DF, EF, WORK, RESID)
ZPTT01
subroutine zptsvx(FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZPTSVX computes the solution to system of linear equations A * X = B for PT matrices ...
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine zptt05(N, NRHS, D, E, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPTT05
subroutine zerrvx(PATH, NUNIT)
ZERRVX
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine dlarnv(IDIST, ISEED, N, X)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine zptsv(N, NRHS, D, E, B, LDB, INFO)
ZPTSV computes the solution to system of linear equations A * X = B for PT matrices ...
subroutine zptt02(UPLO, N, NRHS, D, E, X, LDX, B, LDB, RESID)
ZPTT02