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 $ iuplo, izero, j, k, kl, ku, lda, lwork, mode,
215 $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
216 REAL alpha, anorm, cndnum, const, sing_max,
217 $ sing_min, rcond, rcondc, stemp
221 INTEGER iseed( 4 ), iseedy( 4 )
222 REAL result( ntests )
223 COMPLEX block( 2, 2 ), cdummy( 1 )
236 INTRINSIC conjg, max, min, sqrt
244 COMMON / infoc / infot, nunit, ok, lerr
245 COMMON / srnamc / srnamt
248 DATA iseedy / 1988, 1989, 1990, 1991 /
249 DATA uplos /
'U',
'L' /
255 alpha = ( one+sqrt( sevten ) ) / eight
259 path( 1: 1 ) =
'Complex precision' 264 matpath( 1: 1 ) =
'Complex precision' 265 matpath( 2: 3 ) =
'HE' 271 iseed( i ) = iseedy( i )
277 $
CALL cerrhe( path, nout )
299 DO 260 imat = 1, nimat
303 IF( .NOT.dotype( imat ) )
308 zerot = imat.GE.3 .AND. imat.LE.6
309 IF( zerot .AND. n.LT.imat-2 )
315 uplo = uplos( iuplo )
322 CALL clatb4( matpath, imat, n, n,
TYPE, kl, ku, anorm,
323 $ mode, cndnum, dist )
328 CALL clatms( n, n, dist, iseed,
TYPE, rwork, mode,
329 $ cndnum, anorm, kl, ku, uplo, a, lda,
335 CALL alaerh( path,
'CLATMS', info, 0, uplo, n, n,
336 $ -1, -1, -1, imat, nfail, nerrs, nout )
350 ELSE IF( imat.EQ.4 )
THEN 360 IF( iuplo.EQ.1 )
THEN 361 ioff = ( izero-1 )*lda
362 DO 20 i = 1, izero - 1
372 DO 40 i = 1, izero - 1
382 IF( iuplo.EQ.1 )
THEN 429 CALL clacpy( uplo, n, n, a, lda, afac, lda )
436 lwork = max( 2, nb )*lda
437 srnamt =
'CHETRF_ROOK' 447 IF( iwork( k ).LT.0 )
THEN 448 IF( iwork( k ).NE.-k )
THEN 452 ELSE IF( iwork( k ).NE.k )
THEN 461 $
CALL alaerh( path,
'CHETRF_ROOK', info, k,
462 $ uplo, n, n, -1, -1, nb, imat,
463 $ nfail, nerrs, nout )
476 CALL chet01_rook( uplo, n, a, lda, afac, lda, iwork,
477 $ ainv, lda, rwork, result( 1 ) )
486 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN 487 CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
488 srnamt =
'CHETRI_ROOK' 495 $
CALL alaerh( path,
'CHETRI_ROOK', info, -1,
496 $ uplo, n, n, -1, -1, -1, imat,
497 $ nfail, nerrs, nout )
502 CALL cpot03( uplo, n, a, lda, ainv, lda, work, lda,
503 $ rwork, rcondc, result( 2 ) )
511 IF( result( k ).GE.thresh )
THEN 512 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
513 $
CALL alahd( nout, path )
514 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
527 const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) ) /
530 IF( iuplo.EQ.1 )
THEN 539 IF( iwork( k ).GT.zero )
THEN 544 stemp =
clange(
'M', k-1, 1,
545 $ afac( ( k-1 )*lda+1 ), lda, rwork )
551 stemp =
clange(
'M', k-2, 2,
552 $ afac( ( k-2 )*lda+1 ), lda, rwork )
559 stemp = stemp - const + thresh
560 IF( stemp.GT.result( 3 ) )
561 $ result( 3 ) = stemp
577 IF( iwork( k ).GT.zero )
THEN 582 stemp =
clange(
'M', n-k, 1,
583 $ afac( ( k-1 )*lda+k+1 ), lda, rwork )
589 stemp =
clange(
'M', n-k-1, 2,
590 $ afac( ( k-1 )*lda+k+2 ), lda, rwork )
597 stemp = stemp - const + thresh
598 IF( stemp.GT.result( 3 ) )
599 $ 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 634 block( 1, 1 ) = afac( ( k-2 )*lda+k-1 )
635 block( 1, 2 ) = afac( (k-1)*lda+k-1 )
636 block( 2, 1 ) = conjg( block( 1, 2 ) )
637 block( 2, 2 ) = afac( (k-1)*lda+k )
639 CALL cgesvd(
'N',
'N', 2, 2, block, 2, rwork,
640 $ cdummy, 1, cdummy, 1,
641 $ work, 6, rwork( 3 ), info )
644 sing_max = rwork( 1 )
645 sing_min = rwork( 2 )
647 stemp = sing_max / sing_min
651 stemp = stemp - const + thresh
652 IF( stemp.GT.result( 4 ) )
653 $ result( 4 ) = stemp
672 IF( iwork( k ).LT.zero )
THEN 678 block( 1, 1 ) = afac( ( k-1 )*lda+k )
679 block( 2, 1 ) = afac( ( k-1 )*lda+k+1 )
680 block( 1, 2 ) = conjg( block( 2, 1 ) )
681 block( 2, 2 ) = afac( k*lda+k+1 )
683 CALL cgesvd(
'N',
'N', 2, 2, block, 2, rwork,
684 $ cdummy, 1, cdummy, 1,
685 $ work, 6, rwork(3), info )
687 sing_max = rwork( 1 )
688 sing_min = rwork( 2 )
690 stemp = sing_max / sing_min
694 stemp = stemp - const + thresh
695 IF( stemp.GT.result( 4 ) )
696 $ result( 4 ) = stemp
711 IF( result( k ).GE.thresh )
THEN 712 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
713 $
CALL alahd( nout, path )
714 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
749 CALL clarhs( matpath, xtype, uplo,
' ', n, n,
750 $ kl, ku, nrhs, a, lda, xact, lda,
751 $ b, lda, iseed, info )
752 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
754 srnamt =
'CHETRS_ROOK' 761 $
CALL alaerh( path,
'CHETRS_ROOK', info, 0,
762 $ uplo, n, n, -1, -1, nrhs, imat,
763 $ nfail, nerrs, nout )
765 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
769 CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
770 $ lda, rwork, result( 5 ) )
775 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
782 IF( result( k ).GE.thresh )
THEN 783 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
784 $
CALL alahd( nout, path )
785 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
786 $ imat, k, result( k )
800 anorm =
clanhe(
'1', uplo, n, a, lda, rwork )
801 srnamt =
'CHECON_ROOK' 802 CALL checon_rook( uplo, n, afac, lda, iwork, anorm,
803 $ rcond, work, info )
808 $
CALL alaerh( path,
'CHECON_ROOK', info, 0,
809 $ uplo, n, n, -1, -1, -1, imat,
810 $ nfail, nerrs, nout )
814 result( 7 ) =
sget06( rcond, rcondc )
819 IF( result( 7 ).GE.thresh )
THEN 820 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
821 $
CALL alahd( nout, path )
822 WRITE( nout, fmt = 9997 )uplo, n, imat, 7,
835 CALL alasum( path, nout, nfail, nrun, nerrs )
837 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
838 $ i2,
', test ', i2,
', ratio =', g12.5 )
839 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
840 $ i2,
', test ', i2,
', ratio =', g12.5 )
841 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
842 $
', test ', i2,
', ratio =', g12.5 )
subroutine alahd(IOUNIT, PATH)
ALAHD
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 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 alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
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...
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 ob...
real function sget06(RCOND, RCONDC)
SGET06
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 xlaenv(ISPEC, NVALUE)
XLAENV
subroutine cerrhe(PATH, NUNIT)
CERRHE
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine cgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, INFO)
CGESVD computes the singular value decomposition (SVD) for GE matrices
subroutine chet01_rook(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CHET01_ROOK
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 clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine cpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
CPOT03
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4