170 SUBROUTINE cchkhe( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
171 $ thresh, tsterr, nmax, a, afac, ainv,
b,
x,
172 $ xact, work, rwork, iwork, nout )
181 INTEGER nmax, nn, nnb, nns, nout
186 INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
188 COMPLEX a( * ), afac( * ), ainv( * ),
b( * ),
189 $ work( * ),
x( * ), xact( * )
196 parameter( zero = 0.0e+0 )
198 parameter( czero = ( 0.0e+0, 0.0e+0 ) )
200 parameter( ntypes = 10 )
202 parameter( ntests = 9 )
205 LOGICAL trfcon, zerot
206 CHARACTER dist, type, uplo, xtype
208 INTEGER i, i1, i2, imat, in, inb, info, ioff, irhs,
209 $ iuplo, izero,
j, k, kl, ku, lda, lwork, mode,
210 $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
211 REAL anorm, cndnum, rcond, rcondc
215 INTEGER iseed( 4 ), iseedy( 4 )
216 REAL result( ntests )
237 COMMON / infoc / infot, nunit, ok, lerr
238 COMMON / srnamc / srnamt
241 DATA iseedy / 1988, 1989, 1990, 1991 /
242 DATA uplos /
'U',
'L' /
248 path( 1: 1 ) =
'Complex precision'
254 iseed( i ) = iseedy( i )
260 $ CALL
cerrhe( path, nout )
282 DO 170 imat = 1, nimat
286 IF( .NOT.dotype( imat ) )
291 zerot = imat.GE.3 .AND. imat.LE.6
292 IF( zerot .AND. n.LT.imat-2 )
298 uplo = uplos( iuplo )
306 CALL
clatb4( path, imat, n, n, type, kl, ku, anorm, mode,
312 CALL
clatms( n, n, dist, iseed, type, rwork, mode,
313 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
319 CALL
alaerh( path,
'CLATMS', info, 0, uplo, n, n, -1,
320 $ -1, -1, imat, nfail, nerrs, nout )
334 ELSE IF( imat.EQ.4 )
THEN
344 IF( iuplo.EQ.1 )
THEN
345 ioff = ( izero-1 )*lda
346 DO 20 i = 1, izero - 1
356 DO 40 i = 1, izero - 1
366 IF( iuplo.EQ.1 )
THEN
398 CALL
claipd( n, a, lda+1, 0 )
417 CALL
clacpy( uplo, n, n, a, lda, afac, lda )
424 lwork = max( 2, nb )*lda
426 CALL
chetrf( uplo, n, afac, lda, iwork, ainv, lwork,
435 IF( iwork( k ).LT.0 )
THEN
436 IF( iwork( k ).NE.-k )
THEN
440 ELSE IF( iwork( k ).NE.k )
THEN
449 $ CALL
alaerh( path,
'CHETRF', info, k, uplo, n, n,
450 $ -1, -1, nb, imat, nfail, nerrs, nout )
463 CALL
chet01( uplo, n, a, lda, afac, lda, iwork, ainv,
464 $ lda, rwork, result( 1 ) )
473 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN
474 CALL
clacpy( uplo, n, n, afac, lda, ainv, lda )
476 lwork = (n+nb+1)*(nb+3)
477 CALL
chetri2( uplo, n, ainv, lda, iwork, work,
483 $ CALL
alaerh( path,
'CHETRI2', info, -1, uplo, n,
484 $ n, -1, -1, -1, imat, nfail, nerrs,
490 CALL
cpot03( uplo, n, a, lda, ainv, lda, work, lda,
491 $ rwork, rcondc, result( 2 ) )
499 IF( result( k ).GE.thresh )
THEN
500 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
501 $ CALL
alahd( nout, path )
502 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
534 CALL
clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
535 $ nrhs, a, lda, xact, lda,
b, lda,
537 CALL
clacpy(
'Full', n, nrhs,
b, lda,
x, lda )
540 CALL
chetrs( uplo, n, nrhs, afac, lda, iwork,
x,
546 $ CALL
alaerh( path,
'CHETRS', info, 0, uplo, n,
547 $ n, -1, -1, nrhs, imat, nfail,
550 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
554 CALL
cpot02( uplo, n, nrhs, a, lda,
x, lda, work,
555 $ lda, rwork, result( 3 ) )
564 CALL
clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
565 $ nrhs, a, lda, xact, lda,
b, lda,
567 CALL
clacpy(
'Full', n, nrhs,
b, lda,
x, lda )
570 CALL
chetrs2( uplo, n, nrhs, afac, lda, iwork,
x,
576 $ CALL
alaerh( path,
'CHETRS2', info, 0, uplo, n,
577 $ n, -1, -1, nrhs, imat, nfail,
580 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
584 CALL
cpot02( uplo, n, nrhs, a, lda,
x, lda, work,
585 $ lda, rwork, result( 4 ) )
590 CALL
cget04( n, nrhs,
x, lda, xact, lda, rcondc,
597 CALL
cherfs( uplo, n, nrhs, a, lda, afac, lda,
598 $ iwork,
b, lda,
x, lda, rwork,
599 $ rwork( nrhs+1 ), work,
600 $ rwork( 2*nrhs+1 ), info )
605 $ CALL
alaerh( path,
'CHERFS', info, 0, uplo, n,
606 $ n, -1, -1, nrhs, imat, nfail,
609 CALL
cget04( n, nrhs,
x, lda, xact, lda, rcondc,
611 CALL
cpot05( uplo, n, nrhs, a, lda,
b, lda,
x, lda,
612 $ xact, lda, rwork, rwork( nrhs+1 ),
619 IF( result( k ).GE.thresh )
THEN
620 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
621 $ CALL
alahd( nout, path )
622 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
623 $ imat, k, result( k )
637 anorm =
clanhe(
'1', uplo, n, a, lda, rwork )
639 CALL
checon( uplo, n, afac, lda, iwork, anorm, rcond,
645 $ CALL
alaerh( path,
'CHECON', info, 0, uplo, n, n,
646 $ -1, -1, -1, imat, nfail, nerrs, nout )
650 result( 9 ) =
sget06( rcond, rcondc )
655 IF( result( 9 ).GE.thresh )
THEN
656 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
657 $ CALL
alahd( nout, path )
658 WRITE( nout, fmt = 9997 )uplo, n, imat, 8,
670 CALL
alasum( path, nout, nfail, nrun, nerrs )
672 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
673 $ i2,
', test ', i2,
', ratio =', g12.5 )
674 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
675 $ i2,
', test(', i2,
') =', g12.5 )
676 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10
x,
' type ', i2,
677 $
', test(', i2,
') =', g12.5 )
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 chetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS
REAL function clanhe(NORM, UPLO, N, A, LDA, WORK)
CLANHE 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.
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
subroutine chetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine checon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CHECON
subroutine chetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRI2
subroutine cpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPOT05
REAL function sget06(RCOND, RCONDC)
SGET06
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine cpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
CPOT03
subroutine cchkhe(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CCHKHE
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine chet01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CHET01
subroutine chetrs2(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO)
CHETRS2
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine cherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CHERFS
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cerrhe(PATH, NUNIT)
CERRHE
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04