158 SUBROUTINE cchkpp( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
159 $ nmax, a, afac, ainv,
b,
x, xact, work, rwork,
169 INTEGER nmax, nn, nns, nout
174 INTEGER nsval( * ), nval( * )
176 COMPLEX a( * ), afac( * ), ainv( * ),
b( * ),
177 $ work( * ),
x( * ), xact( * )
184 parameter( zero = 0.0e+0 )
186 parameter( ntypes = 9 )
188 parameter( ntests = 8 )
192 CHARACTER dist, packit, type, uplo, xtype
194 INTEGER i, imat, in, info, ioff, irhs, iuplo, izero, k,
195 $ kl, ku, lda, mode, n, nerrs, nfail, nimat, npp,
197 REAL anorm, cndnum, rcond, rcondc
200 CHARACTER packs( 2 ), uplos( 2 )
201 INTEGER iseed( 4 ), iseedy( 4 )
202 REAL result( ntests )
220 COMMON / infoc / infot, nunit, ok, lerr
221 COMMON / srnamc / srnamt
227 DATA iseedy / 1988, 1989, 1990, 1991 /
228 DATA uplos /
'U',
'L' / , packs /
'C',
'R' /
234 path( 1: 1 ) =
'Complex precision'
240 iseed( i ) = iseedy( i )
246 $ CALL
cerrpo( path, nout )
259 DO 100 imat = 1, nimat
263 IF( .NOT.dotype( imat ) )
268 zerot = imat.GE.3 .AND. imat.LE.5
269 IF( zerot .AND. n.LT.imat-2 )
275 uplo = uplos( iuplo )
276 packit = packs( iuplo )
281 CALL
clatb4( path, imat, n, n, type, kl, ku, anorm, mode,
285 CALL
clatms( n, n, dist, iseed, type, rwork, mode,
286 $ cndnum, anorm, kl, ku, packit, a, lda, work,
292 CALL
alaerh( path,
'CLATMS', info, 0, uplo, n, n, -1,
293 $ -1, -1, imat, nfail, nerrs, nout )
303 ELSE IF( imat.EQ.4 )
THEN
311 IF( iuplo.EQ.1 )
THEN
312 ioff = ( izero-1 )*izero / 2
313 DO 20 i = 1, izero - 1
323 DO 40 i = 1, izero - 1
338 IF( iuplo.EQ.1 )
THEN
341 CALL
claipd( n, a, n, -1 )
347 CALL
ccopy( npp, a, 1, afac, 1 )
349 CALL
cpptrf( uplo, n, afac, info )
353 IF( info.NE.izero )
THEN
354 CALL
alaerh( path,
'CPPTRF', info, izero, uplo, n, n,
355 $ -1, -1, -1, imat, nfail, nerrs, nout )
367 CALL
ccopy( npp, afac, 1, ainv, 1 )
368 CALL
cppt01( uplo, n, a, ainv, rwork, result( 1 ) )
373 CALL
ccopy( npp, afac, 1, ainv, 1 )
375 CALL
cpptri( uplo, n, ainv, info )
380 $ CALL
alaerh( path,
'CPPTRI', info, 0, uplo, n, n, -1,
381 $ -1, -1, imat, nfail, nerrs, nout )
383 CALL
cppt03( uplo, n, a, ainv, work, lda, rwork, rcondc,
390 IF( result( k ).GE.thresh )
THEN
391 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
392 $ CALL
alahd( nout, path )
393 WRITE( nout, fmt = 9999 )uplo, n, imat, k,
407 CALL
clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
408 $ nrhs, a, lda, xact, lda,
b, lda, iseed,
410 CALL
clacpy(
'Full', n, nrhs,
b, lda,
x, lda )
413 CALL
cpptrs( uplo, n, nrhs, afac,
x, lda, info )
418 $ CALL
alaerh( path,
'CPPTRS', info, 0, uplo, n, n,
419 $ -1, -1, nrhs, imat, nfail, nerrs,
422 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
423 CALL
cppt02( uplo, n, nrhs, a,
x, lda, work, lda,
424 $ rwork, result( 3 ) )
429 CALL
cget04( n, nrhs,
x, lda, xact, lda, rcondc,
436 CALL
cpprfs( uplo, n, nrhs, a, afac,
b, lda,
x, lda,
437 $ rwork, rwork( nrhs+1 ), work,
438 $ rwork( 2*nrhs+1 ), info )
443 $ CALL
alaerh( path,
'CPPRFS', info, 0, uplo, n, n,
444 $ -1, -1, nrhs, imat, nfail, nerrs,
447 CALL
cget04( n, nrhs,
x, lda, xact, lda, rcondc,
449 CALL
cppt05( uplo, n, nrhs, a,
b, lda,
x, lda, xact,
450 $ lda, rwork, rwork( nrhs+1 ),
457 IF( result( k ).GE.thresh )
THEN
458 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
459 $ CALL
alahd( nout, path )
460 WRITE( nout, fmt = 9998 )uplo, n, nrhs, imat,
471 anorm =
clanhp(
'1', uplo, n, a, rwork )
473 CALL
cppcon( uplo, n, afac, anorm, rcond, work, rwork,
479 $ CALL
alaerh( path,
'CPPCON', info, 0, uplo, n, n, -1,
480 $ -1, -1, imat, nfail, nerrs, nout )
482 result( 8 ) =
sget06( rcond, rcondc )
486 IF( result( 8 ).GE.thresh )
THEN
487 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
488 $ CALL
alahd( nout, path )
489 WRITE( nout, fmt = 9999 )uplo, n, imat, 8,
501 CALL
alasum( path, nout, nfail, nrun, nerrs )
503 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', type ', i2,
', test ',
504 $ i2,
', ratio =', g12.5 )
505 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
506 $ i2,
', test(', i2,
') =', g12.5 )
subroutine cerrpo(PATH, NUNIT)
CERRPO
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 cpptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
CPPTRS
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
REAL function sget06(RCOND, RCONDC)
SGET06
subroutine cppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPPT05
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine cpptrf(UPLO, N, AP, INFO)
CPPTRF
subroutine cpptri(UPLO, N, AP, INFO)
CPPTRI
subroutine cppt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
CPPT02
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cchkpp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, NOUT)
CCHKPP
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine cppcon(UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO)
CPPCON
subroutine cppt03(UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
CPPT03
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cppt01(UPLO, N, A, AFAC, RWORK, RESID)
CPPT01
REAL function clanhp(NORM, UPLO, N, AP, WORK)
CLANHP 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 matrix supplied in packed form.
subroutine cpprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPPRFS
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04