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 )
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 ) ) +
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 zpttrf(N, D, E, INFO)
ZPTTRF
subroutine zptt02(UPLO, N, NRHS, D, E, X, LDX, B, LDB, RESID)
ZPTT02
subroutine zpttrs(UPLO, N, NRHS, D, E, B, LDB, INFO)
ZPTTRS
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zdrvpt(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
ZDRVPT
double precision function zlanht(NORM, N, D, E)
ZLANHT returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian tridiagonal matrix.
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 dlarnv(IDIST, ISEED, N, X)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine zptt01(N, D, E, DF, EF, WORK, RESID)
ZPTT01
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine dscal(N, DA, DX, INCX)
DSCAL
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 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 zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
double precision function dget06(RCOND, RCONDC)
DGET06
double precision function dzasum(N, ZX, INCX)
DZASUM
subroutine aladhd(IOUNIT, PATH)
ALADHD
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zerrvx(PATH, NUNIT)
ZERRVX
subroutine zptt05(N, NRHS, D, E, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPTT05
integer function idamax(N, DX, INCX)
IDAMAX
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zlaptm(UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB)
ZLAPTM
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 zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4