147 SUBROUTINE cchkpt( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
148 $ a, d, e,
b, x, xact, work, rwork, nout )
157 INTEGER nn, nns, nout
162 INTEGER nsval( * ), nval( * )
163 REAL d( * ), rwork( * )
164 COMPLEX a( * ),
b( * ), e( * ), work( * ), x( * ),
172 parameter( one = 1.0e+0, zero = 0.0e+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 REAL ainvnm, anorm, cond, dmax, rcond, rcondc
189 INTEGER iseed( 4 ), iseedy( 4 )
190 REAL result( ntests )
205 INTRINSIC abs, max, real
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 ) =
'Complex precision'
227 iseed( i ) = iseedy( i )
233 $ CALL
cerrgt( path, nout )
246 DO 110 imat = 1, nimat
250 IF( n.GT.0 .AND. .NOT.dotype( imat ) )
255 CALL
clatb4( path, imat, n, n, type, kl, ku, anorm, mode,
258 zerot = imat.GE.8 .AND. imat.LE.10
265 CALL
clatms( n, n, dist, iseed, type, rwork, mode, cond,
266 $ anorm, kl, ku,
'B', a, 2, work, info )
271 CALL
alaerh( path,
'CLATMS', info, 0,
' ', n, n, kl,
272 $ ku, -1, imat, nfail, nerrs, nout )
281 d( i ) =
REAL( A( IA ) )
286 $ d( n ) =
REAL( A( IA ) )
292 IF( .NOT.zerot .OR. .NOT.dotype( 7 ) )
THEN
296 CALL
slarnv( 2, iseed, n, d )
297 CALL
clarnv( 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
sscal( n, anorm / dmax, d, 1 )
317 CALL
csscal( 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
scopy( n, d, 1, d( n+1 ), 1 )
373 $ CALL
ccopy( n-1, e, 1, e( n+1 ), 1 )
379 CALL
cpttrf( n, d( n+1 ), e( n+1 ), info )
383 IF( info.NE.izero )
THEN
384 CALL
alaerh( path,
'CPTTRF', info, izero,
' ', n, n, -1,
385 $ -1, -1, imat, nfail, nerrs, nout )
394 CALL
cptt01( 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 =
clanht(
'1', n, d, e )
422 CALL
cpttrs(
'Lower', n, 1, d( n+1 ), e( n+1 ), x, lda,
424 ainvnm = max( ainvnm,
scasum( n, x, 1 ) )
426 rcondc = one / max( one, anorm*ainvnm )
435 CALL
clarnv( 2, iseed, n, xact( ix ) )
443 uplo = uplos( iuplo )
447 CALL
claptm( uplo, n, nrhs, one, d, e, xact, lda,
453 CALL
clacpy(
'Full', n, nrhs,
b, lda, x, lda )
454 CALL
cpttrs( uplo, n, nrhs, d( n+1 ), e( n+1 ), x,
460 $ CALL
alaerh( path,
'CPTTRS', info, 0, uplo, n, n,
461 $ -1, -1, nrhs, imat, nfail, nerrs,
464 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
465 CALL
cptt02( uplo, n, nrhs, d, e, x, lda, work, lda,
471 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
478 CALL
cptrfs( 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,
'CPTRFS', info, 0, uplo, n, n,
486 $ -1, -1, nrhs, imat, nfail, nerrs,
489 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
491 CALL
cptt05( 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
cptcon( n, d( n+1 ), e( n+1 ), anorm, rcond, rwork,
523 $ CALL
alaerh( path,
'CPTCON', info, 0,
' ', n, n, -1, -1,
524 $ -1, imat, nfail, nerrs, nout )
526 result( 7 ) =
sget06( 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 claptm(UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB)
CLAPTM
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine cpttrs(UPLO, N, NRHS, D, E, B, LDB, INFO)
CPTTRS
integer function isamax(N, SX, INCX)
ISAMAX
subroutine cptcon(N, D, E, ANORM, RCOND, RWORK, INFO)
CPTCON
real function sget06(RCOND, RCONDC)
SGET06
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
real function scasum(N, CX, INCX)
SCASUM
real function clanht(NORM, N, D, E)
CLANHT 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 cptt01(N, D, E, DF, EF, WORK, RESID)
CPTT01
subroutine cptt05(N, NRHS, D, E, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPTT05
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine cpttrf(N, D, E, INFO)
CPTTRF
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine cptt02(UPLO, N, NRHS, D, E, X, LDX, B, LDB, RESID)
CPTT02
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine cchkpt(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
CCHKPT
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine slarnv(IDIST, ISEED, N, X)
SLARNV 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 cerrgt(PATH, NUNIT)
CERRGT
subroutine cptrfs(UPLO, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPTRFS
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine csscal(N, SA, CX, INCX)
CSSCAL
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
subroutine sscal(N, SA, SX, INCX)
SSCAL