156 SUBROUTINE cdrvhp( 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, fact, packit, type, uplo, xtype
192 INTEGER i, i1, i2, ifact, imat, in, info, ioff, iuplo,
193 $ izero,
j, k, k1, kl, ku, lda, mode, n, nb,
194 $ nbmin, nerrs, nfail, nimat, npp, nrun, nt
195 REAL ainvnm, anorm, cndnum, rcond, rcondc
198 CHARACTER facts( nfact )
199 INTEGER iseed( 4 ), iseedy( 4 )
200 REAL result( ntests )
218 COMMON / infoc / infot, nunit, ok, lerr
219 COMMON / srnamc / srnamt
222 INTRINSIC cmplx, max, min
225 DATA iseedy / 1988, 1989, 1990, 1991 /
226 DATA facts /
'F',
'N' /
238 iseed( i ) = iseedy( i )
244 $ CALL
cerrvx( path, nout )
265 DO 170 imat = 1, nimat
269 IF( .NOT.dotype( imat ) )
274 zerot = imat.GE.3 .AND. imat.LE.6
275 IF( zerot .AND. n.LT.imat-2 )
281 IF( iuplo.EQ.1 )
THEN
292 CALL
clatb4( path, imat, n, n, type, kl, ku, anorm, mode,
296 CALL
clatms( n, n, dist, iseed, type, rwork, mode,
297 $ cndnum, anorm, kl, ku, packit, a, lda, work,
303 CALL
alaerh( path,
'CLATMS', info, 0, uplo, n, n, -1,
304 $ -1, -1, imat, nfail, nerrs, nout )
314 ELSE IF( imat.EQ.4 )
THEN
324 IF( iuplo.EQ.1 )
THEN
325 ioff = ( izero-1 )*izero / 2
326 DO 20 i = 1, izero - 1
336 DO 40 i = 1, izero - 1
347 IF( iuplo.EQ.1 )
THEN
377 IF( iuplo.EQ.1 )
THEN
380 CALL
claipd( n, a, n, -1 )
383 DO 150 ifact = 1, nfact
387 fact = facts( ifact )
397 ELSE IF( ifact.EQ.1 )
THEN
401 anorm =
clanhp(
'1', uplo, n, a, rwork )
405 CALL
ccopy( npp, a, 1, afac, 1 )
406 CALL
chptrf( uplo, n, afac, iwork, info )
410 CALL
ccopy( npp, afac, 1, ainv, 1 )
411 CALL
chptri( uplo, n, ainv, iwork, work, info )
412 ainvnm =
clanhp(
'1', uplo, n, ainv, rwork )
416 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
419 rcondc = ( one / anorm ) / ainvnm
426 CALL
clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
427 $ nrhs, a, lda, xact, lda,
b, lda, iseed,
433 IF( ifact.EQ.2 )
THEN
434 CALL
ccopy( npp, a, 1, afac, 1 )
435 CALL
clacpy(
'Full', n, nrhs,
b, lda, x, lda )
440 CALL
chpsv( uplo, n, nrhs, afac, iwork, x, lda,
449 IF( iwork( k ).LT.0 )
THEN
450 IF( iwork( k ).NE.-k )
THEN
454 ELSE IF( iwork( k ).NE.k )
THEN
463 CALL
alaerh( path,
'CHPSV ', info, k, uplo, n,
464 $ n, -1, -1, nrhs, imat, nfail,
467 ELSE IF( info.NE.0 )
THEN
474 CALL
chpt01( uplo, n, a, afac, iwork, ainv, lda,
475 $ rwork, result( 1 ) )
479 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
480 CALL
cppt02( uplo, n, nrhs, a, x, lda, work, lda,
481 $ rwork, result( 2 ) )
485 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
493 IF( result( k ).GE.thresh )
THEN
494 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
495 $ CALL
aladhd( nout, path )
496 WRITE( nout, fmt = 9999 )
'CHPSV ', uplo, n,
497 $ imat, k, result( k )
507 IF( ifact.EQ.2 .AND. npp.GT.0 )
508 $ CALL
claset(
'Full', npp, 1, cmplx( zero ),
509 $ cmplx( zero ), afac, npp )
510 CALL
claset(
'Full', n, nrhs, cmplx( zero ),
511 $ cmplx( zero ), x, lda )
517 CALL
chpsvx( fact, uplo, n, nrhs, a, afac, iwork,
b,
518 $ lda, x, lda, rcond, rwork,
519 $ rwork( nrhs+1 ), work, rwork( 2*nrhs+1 ),
528 IF( iwork( k ).LT.0 )
THEN
529 IF( iwork( k ).NE.-k )
THEN
533 ELSE IF( iwork( k ).NE.k )
THEN
542 CALL
alaerh( path,
'CHPSVX', info, k, fact // uplo,
543 $ n, n, -1, -1, nrhs, imat, nfail,
549 IF( ifact.GE.2 )
THEN
554 CALL
chpt01( uplo, n, a, afac, iwork, ainv, lda,
555 $ rwork( 2*nrhs+1 ), result( 1 ) )
563 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
564 CALL
cppt02( uplo, n, nrhs, a, x, lda, work, lda,
565 $ rwork( 2*nrhs+1 ), result( 2 ) )
569 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
574 CALL
cppt05( uplo, n, nrhs, a,
b, lda, x, lda,
575 $ xact, lda, rwork, rwork( nrhs+1 ),
584 result( 6 ) =
sget06( rcond, rcondc )
590 IF( result( k ).GE.thresh )
THEN
591 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
592 $ CALL
aladhd( nout, path )
593 WRITE( nout, fmt = 9998 )
'CHPSVX', fact, uplo,
594 $ n, imat, k, result( k )
608 CALL
alasvm( path, nout, nfail, nrun, nerrs )
610 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
611 $
', test ', i2,
', ratio =', g12.5 )
612 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
613 $
', type ', i2,
', test ', i2,
', ratio =', g12.5 )
subroutine chpsv(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CHPSV computes the solution to system of linear equations A * X = B for OTHER 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 cdrvhp(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CDRVHP
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
real function clanhp(NORM, UPLO, N, AP, WORK)
CLANHP 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 supplied in packed form.
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
subroutine chptri(UPLO, N, AP, IPIV, WORK, INFO)
CHPTRI
real function sget06(RCOND, RCONDC)
SGET06
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine cppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPPT05
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine chpt01(UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
CHPT01
subroutine cppt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
CPPT02
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine chpsvx(FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CHPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
subroutine cerrvx(PATH, NUNIT)
CERRVX
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine chptrf(UPLO, N, AP, IPIV, INFO)
CHPTRF
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04