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,
',', 10x,
' type ', i2,
677 $
', test(', i2,
') =', g12.5 )
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
subroutine chetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRI2
real function sget06(RCOND, RCONDC)
SGET06
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine cherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CHERFS
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
subroutine cerrhe(PATH, NUNIT)
CERRHE
subroutine chetrs2(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO)
CHETRS2
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine chet01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CHET01
subroutine chetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS
subroutine cpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPOT05
subroutine cpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
CPOT03
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
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 chetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
subroutine checon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CHECON
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM