152 SUBROUTINE cdrvhe( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
153 $ a, afac, ainv, b, x, xact, work, rwork, iwork,
163 INTEGER NMAX, NN, NOUT, NRHS
168 INTEGER IWORK( * ), NVAL( * )
170 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
171 $ work( * ), x( * ), xact( * )
178 parameter( one = 1.0e+0, zero = 0.0e+0 )
179 INTEGER NTYPES, NTESTS
180 parameter( ntypes = 10, ntests = 6 )
182 parameter( nfact = 2 )
186 CHARACTER DIST, FACT,
TYPE, UPLO, XTYPE
188 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
189 $ izero, j, k, k1, kl, ku, lda, lwork, mode, n,
190 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
191 REAL AINVNM, ANORM, CNDNUM, RCOND, RCONDC
194 CHARACTER FACTS( nfact ), UPLOS( 2 )
195 INTEGER ISEED( 4 ), ISEEDY( 4 )
196 REAL RESULT( ntests )
200 EXTERNAL clanhe, sget06
214 COMMON / infoc / infot, nunit, ok, lerr
215 COMMON / srnamc / srnamt
218 INTRINSIC cmplx, max, min
221 DATA iseedy / 1988, 1989, 1990, 1991 /
222 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
228 path( 1: 1 ) =
'Complex precision'
234 iseed( i ) = iseedy( i )
236 lwork = max( 2*nmax, nmax*nrhs )
241 $ CALL
cerrvx( path, nout )
261 DO 170 imat = 1, nimat
265 IF( .NOT.dotype( imat ) )
270 zerot = imat.GE.3 .AND. imat.LE.6
271 IF( zerot .AND. n.LT.imat-2 )
277 uplo = uplos( iuplo )
282 CALL
clatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
286 CALL
clatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
287 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
293 CALL
alaerh( path,
'CLATMS', info, 0, uplo, n, n, -1,
294 $ -1, -1, imat, nfail, nerrs, nout )
304 ELSE IF( imat.EQ.4 )
THEN
314 IF( iuplo.EQ.1 )
THEN
315 ioff = ( izero-1 )*lda
316 DO 20 i = 1, izero - 1
326 DO 40 i = 1, izero - 1
337 IF( iuplo.EQ.1 )
THEN
367 CALL
claipd( n, a, lda+1, 0 )
369 DO 150 ifact = 1, nfact
373 fact = facts( ifact )
383 ELSE IF( ifact.EQ.1 )
THEN
387 anorm = clanhe(
'1', uplo, n, a, lda, rwork )
391 CALL
clacpy( uplo, n, n, a, lda, afac, lda )
392 CALL
chetrf( uplo, n, afac, lda, iwork, work,
397 CALL
clacpy( uplo, n, n, afac, lda, ainv, lda )
398 lwork = (n+nb+1)*(nb+3)
399 CALL
chetri2( uplo, n, ainv, lda, iwork, work,
401 ainvnm = clanhe(
'1', uplo, n, ainv, lda, rwork )
405 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
408 rcondc = ( one / anorm ) / ainvnm
415 CALL
clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
416 $ nrhs, a, lda, xact, lda, b, lda, iseed,
422 IF( ifact.EQ.2 )
THEN
423 CALL
clacpy( uplo, n, n, a, lda, afac, lda )
424 CALL
clacpy(
'Full', n, nrhs, b, lda, x, lda )
429 CALL
chesv( uplo, n, nrhs, afac, lda, iwork, x,
430 $ lda, work, lwork, info )
438 IF( iwork( k ).LT.0 )
THEN
439 IF( iwork( k ).NE.-k )
THEN
443 ELSE IF( iwork( k ).NE.k )
THEN
452 CALL
alaerh( path,
'CHESV ', info, k, uplo, n,
453 $ n, -1, -1, nrhs, imat, nfail,
456 ELSE IF( info.NE.0 )
THEN
463 CALL
chet01( uplo, n, a, lda, afac, lda, iwork,
464 $ ainv, lda, rwork, result( 1 ) )
468 CALL
clacpy(
'Full', n, nrhs, b, lda, work, lda )
469 CALL
cpot02( uplo, n, nrhs, a, lda, x, lda, work,
470 $ lda, rwork, result( 2 ) )
474 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
482 IF( result( k ).GE.thresh )
THEN
483 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
484 $ CALL
aladhd( nout, path )
485 WRITE( nout, fmt = 9999 )
'CHESV ', uplo, n,
486 $ imat, k, result( k )
497 $ CALL
claset( uplo, n, n, cmplx( zero ),
498 $ cmplx( zero ), afac, lda )
499 CALL
claset(
'Full', n, nrhs, cmplx( zero ),
500 $ cmplx( zero ), x, lda )
506 CALL
chesvx( fact, uplo, n, nrhs, a, lda, afac, lda,
507 $ iwork, b, lda, x, lda, rcond, rwork,
508 $ rwork( nrhs+1 ), work, lwork,
509 $ rwork( 2*nrhs+1 ), info )
517 IF( iwork( k ).LT.0 )
THEN
518 IF( iwork( k ).NE.-k )
THEN
522 ELSE IF( iwork( k ).NE.k )
THEN
531 CALL
alaerh( path,
'CHESVX', info, k, fact // uplo,
532 $ n, n, -1, -1, nrhs, imat, nfail,
538 IF( ifact.GE.2 )
THEN
543 CALL
chet01( uplo, n, a, lda, afac, lda, iwork,
544 $ ainv, lda, rwork( 2*nrhs+1 ),
553 CALL
clacpy(
'Full', n, nrhs, b, lda, work, lda )
554 CALL
cpot02( uplo, n, nrhs, a, lda, x, lda, work,
555 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
559 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
564 CALL
cpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
565 $ xact, lda, rwork, rwork( nrhs+1 ),
574 result( 6 ) = sget06( rcond, rcondc )
580 IF( result( k ).GE.thresh )
THEN
581 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
582 $ CALL
aladhd( nout, path )
583 WRITE( nout, fmt = 9998 )
'CHESVX', fact, uplo,
584 $ n, imat, k, result( k )
598 CALL
alasvm( path, nout, nfail, nrun, nerrs )
600 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
601 $
', test ', i2,
', ratio =', g12.5 )
602 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
603 $
', 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 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 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