147 SUBROUTINE zchkpt( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
148 $ a, d, e,
b,
x, xact, work, rwork, nout )
157 INTEGER nn, nns, nout
158 DOUBLE PRECISION thresh
162 INTEGER nsval( * ), nval( * )
163 DOUBLE PRECISION d( * ), rwork( * )
164 COMPLEX*16 a( * ),
b( * ), e( * ), work( * ),
x( * ),
171 DOUBLE PRECISION one, zero
172 parameter( one = 1.0d+0, zero = 0.0d+0 )
174 parameter( ntypes = 12 )
176 parameter( ntests = 7 )
180 CHARACTER dist, type, uplo
182 INTEGER i, ia, imat, in, info, irhs, iuplo, ix, izero,
183 $
j, k, kl, ku, lda, mode, n, nerrs, nfail,
185 DOUBLE PRECISION ainvnm, anorm, cond, dmax, rcond, rcondc
189 INTEGER iseed( 4 ), iseedy( 4 )
190 DOUBLE PRECISION result( ntests )
205 INTRINSIC abs, dble, max
213 COMMON / infoc / infot, nunit, ok, lerr
214 COMMON / srnamc / srnamt
217 DATA iseedy / 0, 0, 0, 1 / , uplos /
'U',
'L' /
221 path( 1: 1 ) =
'Zomplex precision'
227 iseed( i ) = iseedy( i )
233 $ CALL
zerrgt( path, nout )
246 DO 110 imat = 1, nimat
250 IF( n.GT.0 .AND. .NOT.dotype( imat ) )
255 CALL
zlatb4( path, imat, n, n, type, kl, ku, anorm, mode,
258 zerot = imat.GE.8 .AND. imat.LE.10
265 CALL
zlatms( n, n, dist, iseed, type, rwork, mode, cond,
266 $ anorm, kl, ku,
'B', a, 2, work, info )
271 CALL
alaerh( path,
'ZLATMS', info, 0,
' ', n, n, kl,
272 $ ku, -1, imat, nfail, nerrs, nout )
281 d( i ) = dble( a( ia ) )
286 $ d( n ) = dble( a( ia ) )
292 IF( .NOT.zerot .OR. .NOT.dotype( 7 ) )
THEN
296 CALL
dlarnv( 2, iseed, n, d )
297 CALL
zlarnv( 2, iseed, n-1, e )
302 d( 1 ) = abs( d( 1 ) )
304 d( 1 ) = abs( d( 1 ) ) + abs( e( 1 ) )
305 d( n ) = abs( d( n ) ) + abs( e( n-1 ) )
307 d( i ) = abs( d( i ) ) + abs( e( i ) ) +
316 CALL
dscal( n, anorm / dmax, d, 1 )
317 CALL
zdscal( n-1, anorm / dmax, e, 1 )
319 ELSE IF( izero.GT.0 )
THEN
324 IF( izero.EQ.1 )
THEN
328 ELSE IF( izero.EQ.n )
THEN
332 e( izero-1 ) = z( 1 )
350 ELSE IF( imat.EQ.9 )
THEN
358 ELSE IF( imat.EQ.10 )
THEN
360 IF( izero.GT.1 )
THEN
361 z( 1 ) = e( izero-1 )
371 CALL
dcopy( n, d, 1, d( n+1 ), 1 )
373 $ CALL
zcopy( n-1, e, 1, e( n+1 ), 1 )
379 CALL
zpttrf( n, d( n+1 ), e( n+1 ), info )
383 IF( info.NE.izero )
THEN
384 CALL
alaerh( path,
'ZPTTRF', info, izero,
' ', n, n, -1,
385 $ -1, -1, imat, nfail, nerrs, nout )
394 CALL
zptt01( n, d, e, d( n+1 ), e( n+1 ), work,
399 IF( result( 1 ).GE.thresh )
THEN
400 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
401 $ CALL
alahd( nout, path )
402 WRITE( nout, fmt = 9999 )n, imat, 1, result( 1 )
411 anorm =
zlanht(
'1', n, d, e )
422 CALL
zpttrs(
'Lower', n, 1, d( n+1 ), e( n+1 ),
x, lda,
424 ainvnm = max( ainvnm,
dzasum( n,
x, 1 ) )
426 rcondc = one / max( one, anorm*ainvnm )
435 CALL
zlarnv( 2, iseed, n, xact( ix ) )
443 uplo = uplos( iuplo )
447 CALL
zlaptm( uplo, n, nrhs, one, d, e, xact, lda,
453 CALL
zlacpy(
'Full', n, nrhs,
b, lda,
x, lda )
454 CALL
zpttrs( uplo, n, nrhs, d( n+1 ), e( n+1 ),
x,
460 $ CALL
alaerh( path,
'ZPTTRS', info, 0, uplo, n, n,
461 $ -1, -1, nrhs, imat, nfail, nerrs,
464 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
465 CALL
zptt02( uplo, n, nrhs, d, e,
x, lda, work, lda,
471 CALL
zget04( n, nrhs,
x, lda, xact, lda, rcondc,
478 CALL
zptrfs( uplo, n, nrhs, d, e, d( n+1 ), e( n+1 ),
479 $
b, lda,
x, lda, rwork, rwork( nrhs+1 ),
480 $ work, rwork( 2*nrhs+1 ), info )
485 $ CALL
alaerh( path,
'ZPTRFS', info, 0, uplo, n, n,
486 $ -1, -1, nrhs, imat, nfail, nerrs,
489 CALL
zget04( n, nrhs,
x, lda, xact, lda, rcondc,
491 CALL
zptt05( n, nrhs, d, e,
b, lda,
x, lda, xact, lda,
492 $ rwork, rwork( nrhs+1 ), result( 5 ) )
498 IF( result( k ).GE.thresh )
THEN
499 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
500 $ CALL
alahd( nout, path )
501 WRITE( nout, fmt = 9998 )uplo, n, nrhs, imat,
517 CALL
zptcon( n, d( n+1 ), e( n+1 ), anorm, rcond, rwork,
523 $ CALL
alaerh( path,
'ZPTCON', info, 0,
' ', n, n, -1, -1,
524 $ -1, imat, nfail, nerrs, nout )
526 result( 7 ) =
dget06( rcond, rcondc )
530 IF( result( 7 ).GE.thresh )
THEN
531 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
532 $ CALL
alahd( nout, path )
533 WRITE( nout, fmt = 9999 )n, imat, 7, result( 7 )
542 CALL
alasum( path, nout, nfail, nrun, nerrs )
544 9999
FORMAT(
' N =', i5,
', type ', i2,
', test ', i2,
', ratio = ',
546 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS =', i3,
547 $
', type ', i2,
', 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 alahd(IOUNIT, PATH)
ALAHD
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 zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zchkpt(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
ZCHKPT
subroutine zptcon(N, D, E, ANORM, RCOND, RWORK, INFO)
ZPTCON
DOUBLE PRECISION function dzasum(N, ZX, INCX)
DZASUM
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 alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine zptrfs(UPLO, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPTRFS
DOUBLE PRECISION function dget06(RCOND, RCONDC)
DGET06
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zerrgt(PATH, NUNIT)
ZERRGT
subroutine zptt05(N, NRHS, D, E, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPTT05
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
INTEGER function idamax(N, DX, INCX)
IDAMAX
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4