163 SUBROUTINE cchkhp( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
164 $ nmax, a, afac, ainv,
b,
x, xact, work, rwork,
174 INTEGER nmax, nn, nns, nout
179 INTEGER iwork( * ), nsval( * ), nval( * )
181 COMPLEX a( * ), afac( * ), ainv( * ),
b( * ),
182 $ work( * ),
x( * ), xact( * )
189 parameter( zero = 0.0e+0 )
191 parameter( ntypes = 10 )
193 parameter( ntests = 8 )
196 LOGICAL trfcon, zerot
197 CHARACTER dist, packit, type, uplo, xtype
199 INTEGER i, i1, i2, imat, in, info, ioff, irhs, iuplo,
200 $ izero,
j, k, kl, ku, lda, mode, n, nerrs,
201 $ nfail, nimat, npp, nrhs, nrun, nt
202 REAL anorm, cndnum, rcond, rcondc
206 INTEGER iseed( 4 ), iseedy( 4 )
207 REAL result( ntests )
229 COMMON / infoc / infot, nunit, ok, lerr
230 COMMON / srnamc / srnamt
233 DATA iseedy / 1988, 1989, 1990, 1991 /
234 DATA uplos /
'U',
'L' /
240 path( 1: 1 ) =
'Complex precision'
246 iseed( i ) = iseedy( i )
252 $ CALL
cerrsy( path, nout )
266 DO 160 imat = 1, nimat
270 IF( .NOT.dotype( imat ) )
275 zerot = imat.GE.3 .AND. imat.LE.6
276 IF( zerot .AND. n.LT.imat-2 )
282 uplo = uplos( iuplo )
283 IF(
lsame( uplo,
'U' ) )
THEN
292 CALL
clatb4( path, imat, n, n, type, kl, ku, anorm, mode,
296 CALL
clatms( n, n, dist, iseed, type, rwork, mode,
297 $ cndnum, anorm, kl, ku, packit, a, lda, work,
303 CALL
alaerh( path,
'CLATMS', info, 0, uplo, n, n, -1,
304 $ -1, -1, imat, nfail, nerrs, nout )
314 ELSE IF( imat.EQ.4 )
THEN
324 IF( iuplo.EQ.1 )
THEN
325 ioff = ( izero-1 )*izero / 2
326 DO 20 i = 1, izero - 1
336 DO 40 i = 1, izero - 1
347 IF( iuplo.EQ.1 )
THEN
377 IF( iuplo.EQ.1 )
THEN
380 CALL
claipd( n, a, n, -1 )
386 CALL
ccopy( npp, a, 1, afac, 1 )
388 CALL
chptrf( uplo, n, afac, iwork, info )
396 IF( iwork( k ).LT.0 )
THEN
397 IF( iwork( k ).NE.-k )
THEN
401 ELSE IF( iwork( k ).NE.k )
THEN
410 $ CALL
alaerh( path,
'CHPTRF', info, k, uplo, n, n, -1,
411 $ -1, -1, imat, nfail, nerrs, nout )
421 CALL
chpt01( uplo, n, a, afac, iwork, ainv, lda, rwork,
428 IF( .NOT.trfcon )
THEN
429 CALL
ccopy( npp, afac, 1, ainv, 1 )
431 CALL
chptri( uplo, n, ainv, iwork, work, info )
436 $ CALL
alaerh( path,
'CHPTRI', info, 0, uplo, n, n,
437 $ -1, -1, -1, imat, nfail, nerrs, nout )
439 CALL
cppt03( uplo, n, a, ainv, work, lda, rwork,
440 $ rcondc, result( 2 ) )
448 IF( result( k ).GE.thresh )
THEN
449 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
450 $ CALL
alahd( nout, path )
451 WRITE( nout, fmt = 9999 )uplo, n, imat, k,
472 CALL
clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
473 $ nrhs, a, lda, xact, lda,
b, lda, iseed,
476 CALL
clacpy(
'Full', n, nrhs,
b, lda,
x, lda )
479 CALL
chptrs( uplo, n, nrhs, afac, iwork,
x, lda,
485 $ CALL
alaerh( path,
'CHPTRS', info, 0, uplo, n, n,
486 $ -1, -1, nrhs, imat, nfail, nerrs,
489 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
490 CALL
cppt02( uplo, n, nrhs, a,
x, lda, work, lda,
491 $ rwork, result( 3 ) )
496 CALL
cget04( n, nrhs,
x, lda, xact, lda, rcondc,
503 CALL
chprfs( uplo, n, nrhs, a, afac, iwork,
b, lda,
x,
504 $ lda, rwork, rwork( nrhs+1 ), work,
505 $ rwork( 2*nrhs+1 ), info )
510 $ CALL
alaerh( path,
'CHPRFS', info, 0, uplo, n, n,
511 $ -1, -1, nrhs, imat, nfail, nerrs,
514 CALL
cget04( n, nrhs,
x, lda, xact, lda, rcondc,
516 CALL
cppt05( uplo, n, nrhs, a,
b, lda,
x, lda, xact,
517 $ lda, rwork, rwork( nrhs+1 ),
524 IF( result( k ).GE.thresh )
THEN
525 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
526 $ CALL
alahd( nout, path )
527 WRITE( nout, fmt = 9998 )uplo, n, nrhs, imat,
539 anorm =
clanhp(
'1', uplo, n, a, rwork )
541 CALL
chpcon( uplo, n, afac, iwork, anorm, rcond, work,
547 $ CALL
alaerh( path,
'CHPCON', info, 0, uplo, n, n, -1,
548 $ -1, -1, imat, nfail, nerrs, nout )
550 result( 8 ) =
sget06( rcond, rcondc )
554 IF( result( 8 ).GE.thresh )
THEN
555 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
556 $ CALL
alahd( nout, path )
557 WRITE( nout, fmt = 9999 )uplo, n, imat, 8,
568 CALL
alasum( path, nout, nfail, nrun, nerrs )
570 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', type ', i2,
', test ',
571 $ i2,
', ratio =', g12.5 )
572 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
573 $ i2,
', test(', i2,
') =', g12.5 )
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
LOGICAL function lsame(CA, CB)
LSAME
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
subroutine chptri(UPLO, N, AP, IPIV, WORK, INFO)
CHPTRI
subroutine cchkhp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CCHKHP
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
subroutine chprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CHPRFS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine chpt01(UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
CHPT01
subroutine chpcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
CHPCON
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
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 clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine cerrsy(PATH, NUNIT)
CERRSY
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cppt03(UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
CPPT03
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine chptrf(UPLO, N, AP, IPIV, INFO)
CHPTRF
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 chptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CHPTRS
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04