172 $ thresh, tsterr, nmax, a, afac, ainv,
b,
x,
173 $ xact, work, rwork, iwork, nout )
182 INTEGER nmax, nn, nnb, nns, nout
183 DOUBLE PRECISION thresh
187 INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
188 DOUBLE PRECISION rwork( * )
189 COMPLEX*16 a( * ), afac( * ), ainv( * ),
b( * ),
190 $ work( * ),
x( * ), xact( * )
196 DOUBLE PRECISION zero, one
197 parameter( zero = 0.0d+0, one = 1.0d+0 )
198 DOUBLE PRECISION onehalf
199 parameter( onehalf = 0.5d+0 )
200 DOUBLE PRECISION eight, sevten
201 parameter( eight = 8.0d+0, sevten = 17.0d+0 )
203 parameter( czero = ( 0.0d+0, 0.0d+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 DOUBLE PRECISION alpha, anorm, cndnum, const, lam_max, lam_min,
218 $ rcond, rcondc, dtemp
222 INTEGER iseed( 4 ), iseedy( 4 ), idummy( 1 )
223 DOUBLE PRECISION result( ntests )
224 COMPLEX*16 cdummy( 1 )
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 ) =
'Zomplex precision'
265 matpath( 1: 1 ) =
'Zomplex precision'
266 matpath( 2: 3 ) =
'HE'
272 iseed( i ) = iseedy( i )
278 $ CALL
zerrhe( 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
zlatb4( matpath, imat, n, n, type, kl, ku, anorm,
324 $ mode, cndnum, dist )
329 CALL
zlatms( n, n, dist, iseed, type, rwork, mode,
330 $ cndnum, anorm, kl, ku, uplo, a, lda,
336 CALL
alaerh( path,
'ZLATMS', 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
zlacpy( uplo, n, n, a, lda, afac, lda )
437 lwork = max( 2, nb )*lda
438 srnamt =
'ZHETRF_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,
'ZHETRF_ROOK', info, k,
463 $ uplo, n, n, -1, -1, nb, imat,
464 $ nfail, nerrs, nout )
477 CALL
zhet01_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
zlacpy( uplo, n, n, afac, lda, ainv, lda )
489 srnamt =
'ZHETRI_ROOK'
496 $ CALL
alaerh( path,
'ZHETRI_ROOK', info, -1,
497 $ uplo, n, n, -1, -1, -1, imat,
498 $ nfail, nerrs, nout )
503 CALL
zpot03( 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 dtemp =
zlange(
'M', k-1, 1,
546 $ afac( ( k-1 )*lda+1 ), lda, rwork )
552 dtemp =
zlange(
'M', k-2, 2,
553 $ afac( ( k-2 )*lda+1 ), lda, rwork )
560 dtemp = dtemp - const + thresh
561 IF( dtemp.GT.result( 3 ) )
562 $ result( 3 ) = dtemp
578 IF( iwork( k ).GT.zero )
THEN
583 dtemp =
zlange(
'M', n-k, 1,
584 $ afac( ( k-1 )*lda+k+1 ), lda, rwork )
590 dtemp =
zlange(
'M', n-k-1, 2,
591 $ afac( ( k-1 )*lda+k+2 ), lda, rwork )
598 dtemp = dtemp - const + thresh
599 IF( dtemp.GT.result( 3 ) )
600 $ result( 3 ) = dtemp
615 const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) )*
616 $ ( ( one + alpha ) / ( one - alpha ) )
617 CALL
zlacpy( uplo, n, n, afac, lda, ainv, lda )
619 IF( iuplo.EQ.1 )
THEN
628 IF( iwork( k ).LT.zero )
THEN
633 CALL
zheevx(
'N',
'A', uplo, 2,
634 $ ainv( ( k-2 )*lda+k-1 ), lda,dtemp,
635 $ dtemp, 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 dtemp = lam_max / lam_min
649 dtemp = abs( dtemp ) - const + thresh
650 IF( dtemp.GT.result( 4 ) )
651 $ result( 4 ) = dtemp
670 IF( iwork( k ).LT.zero )
THEN
675 CALL
zheevx(
'N',
'A', uplo, 2,
676 $ ainv( ( k-1 )*lda+k ), lda, dtemp,
677 $ dtemp, 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 dtemp = lam_max / lam_min
691 dtemp = abs( dtemp ) - const + thresh
692 IF( dtemp.GT.result( 4 ) )
693 $ result( 4 ) = dtemp
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
zlarhs( matpath, xtype, uplo,
' ', n, n,
747 $ kl, ku, nrhs, a, lda, xact, lda,
748 $
b, lda, iseed, info )
749 CALL
zlacpy(
'Full', n, nrhs,
b, lda,
x, lda )
751 srnamt =
'ZHETRS_ROOK'
758 $ CALL
alaerh( path,
'ZHETRS_ROOK', info, 0,
759 $ uplo, n, n, -1, -1, nrhs, imat,
760 $ nfail, nerrs, nout )
762 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
766 CALL
zpot02( uplo, n, nrhs, a, lda,
x, lda, work,
767 $ lda, rwork, result( 5 ) )
772 CALL
zget04( 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 =
zlanhe(
'1', uplo, n, a, lda, rwork )
798 srnamt =
'ZHECON_ROOK'
799 CALL
zhecon_rook( uplo, n, afac, lda, iwork, anorm,
800 $ rcond, work, info )
805 $ CALL
alaerh( path,
'ZHECON_ROOK', info, 0,
806 $ uplo, n, n, -1, -1, -1, imat,
807 $ nfail, nerrs, nout )
811 result( 7 ) =
dget06( 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 zhetrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using fac...
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zchkhe_rook(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZCHKHE_ROOK
subroutine zerrhe(PATH, NUNIT)
ZERRHE
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
DOUBLE PRECISION function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zhetri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch...
subroutine zhet01_rook(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZHET01_ROOK
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zhetrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine zpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPOT03
DOUBLE PRECISION function dget06(RCOND, RCONDC)
DGET06
DOUBLE PRECISION function zlanhe(NORM, UPLO, N, A, LDA, WORK)
ZLANHE 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 xlaenv(ISPEC, NVALUE)
XLAENV
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zheevx(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK, IWORK, IFAIL, INFO)
ZHEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices ...
subroutine zhecon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization obt...
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4