172 $ thresh, tsterr, nmax, a, afac, ainv,
b,
x,
173 $ xact, work, rwork, iwork, nout )
182 INTEGER nmax, nn, nnb, nns, nout
187 INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
189 COMPLEX a( * ), afac( * ), ainv( * ),
b( * ),
190 $ work( * ),
x( * ), xact( * )
197 parameter( zero = 0.0e+0, one = 1.0e+0 )
199 parameter( onehalf = 0.5e+0 )
201 parameter( eight = 8.0e+0, sevten = 17.0e+0 )
203 parameter( czero = ( 0.0e+0, 0.0e+0 ) )
205 parameter( ntypes = 10 )
207 parameter( ntests = 7 )
210 LOGICAL trfcon, zerot
211 CHARACTER dist, type, uplo, xtype
212 CHARACTER*3 path, matpath
213 INTEGER i, i1, i2, imat, in, inb, info, ioff, irhs,
214 $ itemp, itemp2, iuplo, izero,
j, k, kl, ku, lda,
215 $ lwork, mode, n, nb, nerrs, nfail, nimat, nrhs,
217 REAL alpha, anorm, cndnum, const, lam_max, lam_min,
218 $ rcond, rcondc, stemp
222 INTEGER iseed( 4 ), iseedy( 4 ), idummy( 1 )
223 REAL result( ntests )
237 INTRINSIC abs, max, min, sqrt
245 COMMON / infoc / infot, nunit, ok, lerr
246 COMMON / srnamc / srnamt
249 DATA iseedy / 1988, 1989, 1990, 1991 /
250 DATA uplos /
'U',
'L' /
256 alpha = ( one+sqrt( sevten ) ) / eight
260 path( 1: 1 ) =
'Complex precision'
265 matpath( 1: 1 ) =
'Complex precision'
266 matpath( 2: 3 ) =
'HE'
272 iseed( i ) = iseedy( i )
278 $ CALL
cerrhe( path, nout )
300 DO 260 imat = 1, nimat
304 IF( .NOT.dotype( imat ) )
309 zerot = imat.GE.3 .AND. imat.LE.6
310 IF( zerot .AND. n.LT.imat-2 )
316 uplo = uplos( iuplo )
323 CALL
clatb4( matpath, imat, n, n, type, kl, ku, anorm,
324 $ mode, cndnum, dist )
329 CALL
clatms( n, n, dist, iseed, type, rwork, mode,
330 $ cndnum, anorm, kl, ku, uplo, a, lda,
336 CALL
alaerh( path,
'CLATMS', info, 0, uplo, n, n,
337 $ -1, -1, -1, imat, nfail, nerrs, nout )
351 ELSE IF( imat.EQ.4 )
THEN
361 IF( iuplo.EQ.1 )
THEN
362 ioff = ( izero-1 )*lda
363 DO 20 i = 1, izero - 1
373 DO 40 i = 1, izero - 1
383 IF( iuplo.EQ.1 )
THEN
430 CALL
clacpy( uplo, n, n, a, lda, afac, lda )
437 lwork = max( 2, nb )*lda
438 srnamt =
'CHETRF_ROOK'
448 IF( iwork( k ).LT.0 )
THEN
449 IF( iwork( k ).NE.-k )
THEN
453 ELSE IF( iwork( k ).NE.k )
THEN
462 $ CALL
alaerh( path,
'CHETRF_ROOK', info, k,
463 $ uplo, n, n, -1, -1, nb, imat,
464 $ nfail, nerrs, nout )
477 CALL
chet01_rook( uplo, n, a, lda, afac, lda, iwork,
478 $ ainv, lda, rwork, result( 1 ) )
487 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN
488 CALL
clacpy( uplo, n, n, afac, lda, ainv, lda )
489 srnamt =
'CHETRI_ROOK'
496 $ CALL
alaerh( path,
'CHETRI_ROOK', info, -1,
497 $ uplo, n, n, -1, -1, -1, imat,
498 $ nfail, nerrs, nout )
503 CALL
cpot03( uplo, n, a, lda, ainv, lda, work, lda,
504 $ rwork, rcondc, result( 2 ) )
512 IF( result( k ).GE.thresh )
THEN
513 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
514 $ CALL
alahd( nout, path )
515 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
528 const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) ) /
531 IF( iuplo.EQ.1 )
THEN
540 IF( iwork( k ).GT.zero )
THEN
545 stemp =
clange(
'M', k-1, 1,
546 $ afac( ( k-1 )*lda+1 ), lda, rwork )
552 stemp =
clange(
'M', k-2, 2,
553 $ afac( ( k-2 )*lda+1 ), lda, rwork )
560 stemp = stemp - const + thresh
561 IF( stemp.GT.result( 3 ) )
562 $ result( 3 ) = stemp
578 IF( iwork( k ).GT.zero )
THEN
583 stemp =
clange(
'M', n-k, 1,
584 $ afac( ( k-1 )*lda+k+1 ), lda, rwork )
590 stemp =
clange(
'M', n-k-1, 2,
591 $ afac( ( k-1 )*lda+k+2 ), lda, rwork )
598 stemp = stemp - const + thresh
599 IF( stemp.GT.result( 3 ) )
600 $ result( 3 ) = stemp
615 const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) )*
616 $ ( ( one + alpha ) / ( one - alpha ) )
617 CALL
clacpy( uplo, n, n, afac, lda, ainv, lda )
619 IF( iuplo.EQ.1 )
THEN
628 IF( iwork( k ).LT.zero )
THEN
633 CALL
cheevx(
'N',
'A', uplo, 2,
634 $ ainv( ( k-2 )*lda+k-1 ), lda,stemp,
635 $ stemp, itemp, itemp, zero, itemp,
636 $ rwork, cdummy, 1, work, 16,
637 $ rwork( 3 ), iwork( n+1 ), idummy,
640 lam_max = max( abs( rwork( 1 ) ),
641 $ abs( rwork( 2 ) ) )
642 lam_min = min( abs( rwork( 1 ) ),
643 $ abs( rwork( 2 ) ) )
645 stemp = lam_max / lam_min
649 stemp = abs( stemp ) - const + thresh
650 IF( stemp.GT.result( 4 ) )
651 $ result( 4 ) = stemp
670 IF( iwork( k ).LT.zero )
THEN
675 CALL
cheevx(
'N',
'A', uplo, 2,
676 $ ainv( ( k-1 )*lda+k ), lda, stemp,
677 $ stemp, itemp, itemp, zero, itemp,
678 $ rwork, cdummy, 1, work, 16,
679 $ rwork( 3 ), iwork( n+1 ), idummy,
682 lam_max = max( abs( rwork( 1 ) ),
683 $ abs( rwork( 2 ) ) )
684 lam_min = min( abs( rwork( 1 ) ),
685 $ abs( rwork( 2 ) ) )
687 stemp = lam_max / lam_min
691 stemp = abs( stemp ) - const + thresh
692 IF( stemp.GT.result( 4 ) )
693 $ result( 4 ) = stemp
708 IF( result( k ).GE.thresh )
THEN
709 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
710 $ CALL
alahd( nout, path )
711 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
746 CALL
clarhs( matpath, xtype, uplo,
' ', n, n,
747 $ kl, ku, nrhs, a, lda, xact, lda,
748 $
b, lda, iseed, info )
749 CALL
clacpy(
'Full', n, nrhs,
b, lda,
x, lda )
751 srnamt =
'CHETRS_ROOK'
758 $ CALL
alaerh( path,
'CHETRS_ROOK', info, 0,
759 $ uplo, n, n, -1, -1, nrhs, imat,
760 $ nfail, nerrs, nout )
762 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
766 CALL
cpot02( uplo, n, nrhs, a, lda,
x, lda, work,
767 $ lda, rwork, result( 5 ) )
772 CALL
cget04( n, nrhs,
x, lda, xact, lda, rcondc,
779 IF( result( k ).GE.thresh )
THEN
780 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
781 $ CALL
alahd( nout, path )
782 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
783 $ imat, k, result( k )
797 anorm =
clanhe(
'1', uplo, n, a, lda, rwork )
798 srnamt =
'CHECON_ROOK'
799 CALL
checon_rook( uplo, n, afac, lda, iwork, anorm,
800 $ rcond, work, info )
805 $ CALL
alaerh( path,
'CHECON_ROOK', info, 0,
806 $ uplo, n, n, -1, -1, -1, imat,
807 $ nfail, nerrs, nout )
811 result( 7 ) =
sget06( rcond, rcondc )
816 IF( result( 7 ).GE.thresh )
THEN
817 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
818 $ CALL
alahd( nout, path )
819 WRITE( nout, fmt = 9997 )uplo, n, imat, 7,
832 CALL
alasum( path, nout, nfail, nrun, nerrs )
834 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
835 $ i2,
', test ', i2,
', ratio =', g12.5 )
836 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
837 $ i2,
', test ', i2,
', ratio =', g12.5 )
838 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10
x,
' type ', i2,
839 $
', test ', i2,
', ratio =', 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 checon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization obt...
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 chet01_rook(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CHET01_ROOK
subroutine cchkhe_rook(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CCHKHE_ROOK
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
REAL function sget06(RCOND, RCONDC)
SGET06
subroutine chetrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using fac...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine chetrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
subroutine cpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
CPOT03
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
REAL function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
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 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 cheevx(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK, IWORK, IFAIL, INFO)
CHEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices ...
subroutine chetri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
CHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch...
subroutine cerrhe(PATH, NUNIT)
CERRHE
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04