156 SUBROUTINE cdrvhe( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
157 $ a, afac, ainv, b, x, xact, work, rwork, iwork,
167 INTEGER nmax, nn, nout, nrhs
172 INTEGER iwork( * ), nval( * )
174 COMPLEX a( * ), afac( * ), ainv( * ), b( * ),
175 $ work( * ), x( * ), xact( * )
182 parameter ( one = 1.0e+0, zero = 0.0e+0 )
183 INTEGER ntypes, ntests
184 parameter ( ntypes = 10, ntests = 6 )
186 parameter ( nfact = 2 )
190 CHARACTER dist, equed, fact,
TYPE, uplo, xtype
192 INTEGER i, i1, i2, ifact, imat, in, info, ioff, iuplo,
193 $ izero, j, k, k1, kl, ku, lda, lwork, mode, n,
194 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt,
196 REAL ainvnm, anorm, cndnum, rcond, rcondc,
200 CHARACTER facts( nfact ), uplos( 2 )
201 INTEGER iseed( 4 ), iseedy( 4 )
202 REAL result( ntests ), berr( nrhs ),
203 $ errbnds_n( nrhs, 3 ), errbnds_c( nrhs, 3 )
221 COMMON / infoc / infot, nunit, ok, lerr
222 COMMON / srnamc / srnamt
225 INTRINSIC cmplx, max, min
228 DATA iseedy / 1988, 1989, 1990, 1991 /
229 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
241 iseed( i ) = iseedy( i )
243 lwork = max( 2*nmax, nmax*nrhs )
248 $
CALL cerrvx( path, nout )
268 DO 170 imat = 1, nimat
272 IF( .NOT.dotype( imat ) )
277 zerot = imat.GE.3 .AND. imat.LE.6
278 IF( zerot .AND. n.LT.imat-2 )
284 uplo = uplos( iuplo )
289 CALL clatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
293 CALL clatms( n, n, dist, iseed,
TYPE, rwork, mode,
294 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
300 CALL alaerh( path,
'CLATMS', info, 0, uplo, n, n, -1,
301 $ -1, -1, imat, nfail, nerrs, nout )
311 ELSE IF( imat.EQ.4 )
THEN
321 IF( iuplo.EQ.1 )
THEN
322 ioff = ( izero-1 )*lda
323 DO 20 i = 1, izero - 1
333 DO 40 i = 1, izero - 1
344 IF( iuplo.EQ.1 )
THEN
374 CALL claipd( n, a, lda+1, 0 )
376 DO 150 ifact = 1, nfact
380 fact = facts( ifact )
390 ELSE IF( ifact.EQ.1 )
THEN
394 anorm =
clanhe(
'1', uplo, n, a, lda, rwork )
398 CALL clacpy( uplo, n, n, a, lda, afac, lda )
399 CALL chetrf( uplo, n, afac, lda, iwork, work,
404 CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
405 lwork = (n+nb+1)*(nb+3)
406 CALL chetri2( uplo, n, ainv, lda, iwork, work,
408 ainvnm =
clanhe(
'1', uplo, n, ainv, lda, rwork )
412 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
415 rcondc = ( one / anorm ) / ainvnm
422 CALL clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
423 $ nrhs, a, lda, xact, lda, b, lda, iseed,
429 IF( ifact.EQ.2 )
THEN
430 CALL clacpy( uplo, n, n, a, lda, afac, lda )
431 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
436 CALL chesv( uplo, n, nrhs, afac, lda, iwork, x,
437 $ lda, work, lwork, info )
445 IF( iwork( k ).LT.0 )
THEN
446 IF( iwork( k ).NE.-k )
THEN
450 ELSE IF( iwork( k ).NE.k )
THEN
459 CALL alaerh( path,
'CHESV ', info, k, uplo, n,
460 $ n, -1, -1, nrhs, imat, nfail,
463 ELSE IF( info.NE.0 )
THEN
470 CALL chet01( uplo, n, a, lda, afac, lda, iwork,
471 $ ainv, lda, rwork, result( 1 ) )
475 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
476 CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
477 $ lda, rwork, result( 2 ) )
481 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
489 IF( result( k ).GE.thresh )
THEN
490 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
491 $
CALL aladhd( nout, path )
492 WRITE( nout, fmt = 9999 )
'CHESV ', uplo, n,
493 $ imat, k, result( k )
504 $
CALL claset( uplo, n, n, cmplx( zero ),
505 $ cmplx( zero ), afac, lda )
506 CALL claset(
'Full', n, nrhs, cmplx( zero ),
507 $ cmplx( zero ), x, lda )
513 CALL chesvx( fact, uplo, n, nrhs, a, lda, afac, lda,
514 $ iwork, b, lda, x, lda, rcond, rwork,
515 $ rwork( nrhs+1 ), work, lwork,
516 $ rwork( 2*nrhs+1 ), info )
524 IF( iwork( k ).LT.0 )
THEN
525 IF( iwork( k ).NE.-k )
THEN
529 ELSE IF( iwork( k ).NE.k )
THEN
538 CALL alaerh( path,
'CHESVX', info, k, fact // uplo,
539 $ n, n, -1, -1, nrhs, imat, nfail,
545 IF( ifact.GE.2 )
THEN
550 CALL chet01( uplo, n, a, lda, afac, lda, iwork,
551 $ ainv, lda, rwork( 2*nrhs+1 ),
560 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
561 CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
562 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
566 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
571 CALL cpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
572 $ xact, lda, rwork, rwork( nrhs+1 ),
581 result( 6 ) =
sget06( rcond, rcondc )
587 IF( result( k ).GE.thresh )
THEN
588 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
589 $
CALL aladhd( nout, path )
590 WRITE( nout, fmt = 9998 )
'CHESVX', fact, uplo,
591 $ n, imat, k, result( k )
602 $
CALL claset( uplo, n, n, cmplx( zero ),
603 $ cmplx( zero ), afac, lda )
604 CALL claset(
'Full', n, nrhs, cmplx( zero ),
605 $ cmplx( zero ), x, lda )
613 CALL chesvxx( fact, uplo, n, nrhs, a, lda, afac,
614 $ lda, iwork, equed, work( n+1 ), b, lda, x,
615 $ lda, rcond, rpvgrw_svxx, berr, n_err_bnds,
616 $ errbnds_n, errbnds_c, 0, zero, work,
617 $ rwork(2*nrhs+1), info )
625 IF( iwork( k ).LT.0 )
THEN
626 IF( iwork( k ).NE.-k )
THEN
630 ELSE IF( iwork( k ).NE.k )
THEN
638 IF( info.NE.k .AND. info.LE.n )
THEN
639 CALL alaerh( path,
'CHESVXX', info, k,
640 $ fact // uplo, n, n, -1, -1, nrhs, imat, nfail,
646 IF( ifact.GE.2 )
THEN
651 CALL chet01( uplo, n, a, lda, afac, lda, iwork,
652 $ ainv, lda, rwork(2*nrhs+1),
661 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
662 CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
663 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
668 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
673 CALL cpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
674 $ xact, lda, rwork, rwork( nrhs+1 ),
683 result( 6 ) =
sget06( rcond, rcondc )
689 IF( result( k ).GE.thresh )
THEN
690 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
691 $
CALL aladhd( nout, path )
692 WRITE( nout, fmt = 9998 )
'CHESVXX',
693 $ fact, uplo, n, imat, k,
708 CALL alasvm( path, nout, nfail, nrun, nerrs )
715 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
716 $
', test ', i2,
', ratio =', g12.5 )
717 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
718 $
', type ', i2,
', test ', i2,
', ratio =', g12.5 )
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
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
subroutine chesvxx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, INFO)
CHESVXX computes the solution to system of linear equations A * X = B for HE matrices ...
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine cdrvhe(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CDRVHE
subroutine cebchvxx(THRESH, PATH)
CEBCHVXX
subroutine cerrvx(PATH, NUNIT)
CERRVX
subroutine chesv(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CHESV computes the solution to system of linear equations A * X = B for HE matrices ...
real function sget06(RCOND, RCONDC)
SGET06
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
subroutine chesvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, RWORK, INFO)
CHESVX computes the solution to system of linear equations A * X = B for HE matrices ...
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine aladhd(IOUNIT, PATH)
ALADHD
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 cpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPOT05
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