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 )
207 EXTERNAL clanhe, sget06
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 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 clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
subroutine chetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
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 chetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRI2
subroutine cpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPOT05
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 ...
subroutine chet01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CHET01
subroutine cdrvhe(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CDRVHE
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
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine cebchvxx(THRESH, PATH)
CEBCHVXX
subroutine cerrvx(PATH, NUNIT)
CERRVX
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 cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04