147 INTEGER NN, NOUT, NRHS
148 DOUBLE PRECISION THRESH
153 DOUBLE PRECISION D( * ), RWORK( * )
154 COMPLEX*16 A( * ), B( * ), E( * ), WORK( * ), X( * ),
161 DOUBLE PRECISION ONE, ZERO
162 parameter( one = 1.0d+0, zero = 0.0d+0 )
164 parameter( ntypes = 12 )
166 parameter( ntests = 6 )
170 CHARACTER DIST, FACT, TYPE
172 INTEGER I, IA, IFACT, IMAT, IN, INFO, IX, IZERO, J, K,
173 $ K1, KL, KU, LDA, MODE, N, NERRS, NFAIL, NIMAT,
175 DOUBLE PRECISION AINVNM, ANORM, COND, DMAX, RCOND, RCONDC
178 INTEGER ISEED( 4 ), ISEEDY( 4 )
179 DOUBLE PRECISION RESULT( NTESTS ), Z( 3 )
183 DOUBLE PRECISION DGET06, DZASUM, ZLANHT
193 INTRINSIC abs, dcmplx, max
201 COMMON / infoc / infot, nunit, ok, lerr
202 COMMON / srnamc / srnamt
205 DATA iseedy / 0, 0, 0, 1 /
209 path( 1: 1 ) =
'Zomplex precision'
215 iseed( i ) = iseedy( i )
221 $
CALL zerrvx( path, nout )
234 DO 110 imat = 1, nimat
238 IF( n.GT.0 .AND. .NOT.dotype( imat ) )
243 CALL zlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
246 zerot = imat.GE.8 .AND. imat.LE.10
253 CALL zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE, COND,
254 $ ANORM, KL, KU,
'B', A, 2, WORK, INFO )
259 CALL alaerh( path,
'ZLATMS', info, 0,
' ', n, n, kl,
260 $ ku, -1, imat, nfail, nerrs, nout )
280 IF( .NOT.zerot .OR. .NOT.dotype( 7 ) )
THEN
284 CALL dlarnv( 2, iseed, n, d )
285 CALL zlarnv( 2, iseed, n-1, e )
290 d( 1 ) = abs( d( 1 ) )
292 d( 1 ) = abs( d( 1 ) ) + abs( e( 1 ) )
293 d( n ) = abs( d( n ) ) + abs( e( n-1 ) )
295 d( i ) = abs( d( i ) ) + abs( e( i ) ) +
304 CALL dscal( n, anorm / dmax, d, 1 )
306 $
CALL zdscal( n-1, anorm / dmax, e, 1 )
308 ELSE IF( izero.GT.0 )
THEN
313 IF( izero.EQ.1 )
THEN
317 ELSE IF( izero.EQ.n )
THEN
321 e( izero-1 ) = z( 1 )
339 ELSE IF( imat.EQ.9 )
THEN
347 ELSE IF( imat.EQ.10 )
THEN
349 IF( izero.GT.1 )
THEN
350 z( 1 ) = e( izero-1 )
364 CALL zlarnv( 2, iseed, n, xact( ix ) )
370 CALL zlaptm(
'Lower', n, nrhs, one, d, e, xact, lda, zero,
374 IF( ifact.EQ.1 )
THEN
388 ELSE IF( ifact.EQ.1 )
THEN
392 anorm =
zlanht(
'1', n, d, e )
394 CALL dcopy( n, d, 1, d( n+1 ), 1 )
396 $
CALL zcopy( n-1, e, 1, e( n+1 ), 1 )
400 CALL zpttrf( n, d( n+1 ), e( n+1 ), info )
411 CALL zpttrs(
'Lower', n, 1, d( n+1 ), e( n+1 ), x,
413 ainvnm = max( ainvnm,
dzasum( n, x, 1 ) )
418 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
421 rcondc = ( one / anorm ) / ainvnm
425 IF( ifact.EQ.2 )
THEN
429 CALL dcopy( n, d, 1, d( n+1 ), 1 )
431 $
CALL zcopy( n-1, e, 1, e( n+1 ), 1 )
432 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
437 CALL zptsv( n, nrhs, d( n+1 ), e( n+1 ), x, lda,
443 $
CALL alaerh( path,
'ZPTSV ', info, izero,
' ', n,
444 $ n, 1, 1, nrhs, imat, nfail, nerrs,
447 IF( izero.EQ.0 )
THEN
452 CALL zptt01( n, d, e, d( n+1 ), e( n+1 ), work,
457 CALL zlacpy(
'Full', n, nrhs, b, lda, work, lda )
458 CALL zptt02(
'Lower', n, nrhs, d, e, x, lda, work,
463 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
472 IF( result( k ).GE.thresh )
THEN
473 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
474 $
CALL aladhd( nout, path )
475 WRITE( nout, fmt = 9999 )
'ZPTSV ', n, imat, k,
485 IF( ifact.GT.1 )
THEN
497 CALL zlaset(
'Full', n, nrhs, dcmplx( zero ),
498 $ dcmplx( zero ), x, lda )
504 CALL zptsvx( fact, n, nrhs, d, e, d( n+1 ), e( n+1 ), b,
505 $ lda, x, lda, rcond, rwork, rwork( nrhs+1 ),
506 $ work, rwork( 2*nrhs+1 ), info )
511 $
CALL alaerh( path,
'ZPTSVX', info, izero, fact, n, n,
512 $ 1, 1, nrhs, imat, nfail, nerrs, nout )
513 IF( izero.EQ.0 )
THEN
514 IF( ifact.EQ.2 )
THEN
520 CALL zptt01( n, d, e, d( n+1 ), e( n+1 ), work,
528 CALL zlacpy(
'Full', n, nrhs, b, lda, work, lda )
529 CALL zptt02(
'Lower', n, nrhs, d, e, x, lda, work,
534 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
539 CALL zptt05( n, nrhs, d, e, b, lda, x, lda, xact, lda,
540 $ rwork, rwork( nrhs+1 ), result( 4 ) )
547 result( 6 ) =
dget06( rcond, rcondc )
553 IF( result( k ).GE.thresh )
THEN
554 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
555 $
CALL aladhd( nout, path )
556 WRITE( nout, fmt = 9998 )
'ZPTSVX', fact, n, imat,
568 CALL alasvm( path, nout, nfail, nrun, nerrs )
570 9999
FORMAT( 1x, a,
', N =', i5,
', type ', i2,
', test ', i2,
571 $
', ratio = ', g12.5 )
572 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', N =', i5,
', type ', i2,
573 $
', test ', i2,
', ratio = ', g12.5 )
subroutine dlarnv(IDIST, ISEED, N, X)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
integer function idamax(N, DX, INCX)
IDAMAX
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zerrvx(PATH, NUNIT)
ZERRVX
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zptt01(N, D, E, DF, EF, WORK, RESID)
ZPTT01
subroutine zptt02(UPLO, N, NRHS, D, E, X, LDX, B, LDB, RESID)
ZPTT02
subroutine zptt05(N, NRHS, D, E, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPTT05
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
subroutine zlaptm(UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB)
ZLAPTM
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
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 zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
double precision function zlanht(NORM, N, D, E)
ZLANHT returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
subroutine zpttrs(UPLO, N, NRHS, D, E, B, LDB, INFO)
ZPTTRS
subroutine zpttrf(N, D, E, INFO)
ZPTTRF
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 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 dcopy(N, DX, INCX, DY, INCY)
DCOPY
double precision function dzasum(N, ZX, INCX)
DZASUM
subroutine dscal(N, DA, DX, INCX)
DSCAL
double precision function dget06(RCOND, RCONDC)
DGET06