156 SUBROUTINE zdrvsy( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
157 $ a, afac, ainv,
b, x, xact, work, rwork, iwork,
167 INTEGER nmax, nn, nout, nrhs
168 DOUBLE PRECISION thresh
172 INTEGER iwork( * ), nval( * )
173 DOUBLE PRECISION rwork( * )
174 COMPLEX*16 a( * ), afac( * ), ainv( * ),
b( * ),
175 $ work( * ), x( * ), xact( * )
181 DOUBLE PRECISION one, zero
182 parameter( one = 1.0d+0, zero = 0.0d+0 )
183 INTEGER ntypes, ntests
184 parameter( ntypes = 11, 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 DOUBLE PRECISION ainvnm, anorm, cndnum, rcond, rcondc,
200 CHARACTER facts( nfact ), uplos( 2 )
201 INTEGER iseed( 4 ), iseedy( 4 )
202 DOUBLE PRECISION 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 dcmplx, max, min
228 DATA iseedy / 1988, 1989, 1990, 1991 /
229 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
235 path( 1: 1 ) =
'Zomplex precision'
241 iseed( i ) = iseedy( i )
243 lwork = max( 2*nmax, nmax*nrhs )
248 $ CALL
zerrvx( 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 )
286 IF( imat.NE.ntypes )
THEN
291 CALL
zlatb4( path, imat, n, n, type, kl, ku, anorm,
292 $ mode, cndnum, dist )
295 CALL
zlatms( n, n, dist, iseed, type, rwork, mode,
296 $ cndnum, anorm, kl, ku, uplo, a, lda,
302 CALL
alaerh( path,
'ZLATMS', info, 0, uplo, n, n,
303 $ -1, -1, -1, imat, nfail, nerrs, nout )
313 ELSE IF( imat.EQ.4 )
THEN
323 IF( iuplo.EQ.1 )
THEN
324 ioff = ( izero-1 )*lda
325 DO 20 i = 1, izero - 1
335 DO 40 i = 1, izero - 1
345 IF( iuplo.EQ.1 )
THEN
379 CALL
zlatsy( uplo, n, a, lda, iseed )
382 DO 150 ifact = 1, nfact
386 fact = facts( ifact )
396 ELSE IF( ifact.EQ.1 )
THEN
400 anorm =
zlansy(
'1', uplo, n, a, lda, rwork )
404 CALL
zlacpy( uplo, n, n, a, lda, afac, lda )
405 CALL
zsytrf( uplo, n, afac, lda, iwork, work,
410 CALL
zlacpy( uplo, n, n, afac, lda, ainv, lda )
411 lwork = (n+nb+1)*(nb+3)
412 CALL
zsytri2( uplo, n, ainv, lda, iwork, work,
414 ainvnm =
zlansy(
'1', uplo, n, ainv, lda, rwork )
418 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
421 rcondc = ( one / anorm ) / ainvnm
428 CALL
zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
429 $ nrhs, a, lda, xact, lda,
b, lda, iseed,
435 IF( ifact.EQ.2 )
THEN
436 CALL
zlacpy( uplo, n, n, a, lda, afac, lda )
437 CALL
zlacpy(
'Full', n, nrhs,
b, lda, x, lda )
442 CALL
zsysv( uplo, n, nrhs, afac, lda, iwork, x,
443 $ lda, work, lwork, info )
451 IF( iwork( k ).LT.0 )
THEN
452 IF( iwork( k ).NE.-k )
THEN
456 ELSE IF( iwork( k ).NE.k )
THEN
465 CALL
alaerh( path,
'ZSYSV ', info, k, uplo, n,
466 $ n, -1, -1, nrhs, imat, nfail,
469 ELSE IF( info.NE.0 )
THEN
476 CALL
zsyt01( uplo, n, a, lda, afac, lda, iwork,
477 $ ainv, lda, rwork, result( 1 ) )
481 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
482 CALL
zsyt02( uplo, n, nrhs, a, lda, x, lda, work,
483 $ lda, rwork, result( 2 ) )
487 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
495 IF( result( k ).GE.thresh )
THEN
496 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
497 $ CALL
aladhd( nout, path )
498 WRITE( nout, fmt = 9999 )
'ZSYSV ', uplo, n,
499 $ imat, k, result( k )
510 $ CALL
zlaset( uplo, n, n, dcmplx( zero ),
511 $ dcmplx( zero ), afac, lda )
512 CALL
zlaset(
'Full', n, nrhs, dcmplx( zero ),
513 $ dcmplx( zero ), x, lda )
519 CALL
zsysvx( fact, uplo, n, nrhs, a, lda, afac, lda,
520 $ iwork,
b, lda, x, lda, rcond, rwork,
521 $ rwork( nrhs+1 ), work, lwork,
522 $ rwork( 2*nrhs+1 ), info )
530 IF( iwork( k ).LT.0 )
THEN
531 IF( iwork( k ).NE.-k )
THEN
535 ELSE IF( iwork( k ).NE.k )
THEN
544 CALL
alaerh( path,
'ZSYSVX', info, k, fact // uplo,
545 $ n, n, -1, -1, nrhs, imat, nfail,
551 IF( ifact.GE.2 )
THEN
556 CALL
zsyt01( uplo, n, a, lda, afac, lda, iwork,
557 $ ainv, lda, rwork( 2*nrhs+1 ),
566 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
567 CALL
zsyt02( uplo, n, nrhs, a, lda, x, lda, work,
568 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
572 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
577 CALL
zpot05( uplo, n, nrhs, a, lda,
b, lda, x, lda,
578 $ xact, lda, rwork, rwork( nrhs+1 ),
587 result( 6 ) =
dget06( rcond, rcondc )
593 IF( result( k ).GE.thresh )
THEN
594 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
595 $ CALL
aladhd( nout, path )
596 WRITE( nout, fmt = 9998 )
'ZSYSVX', fact, uplo,
597 $ n, imat, k, result( k )
608 $ CALL
zlaset( uplo, n, n, cmplx( zero ),
609 $ cmplx( zero ), afac, lda )
610 CALL
zlaset(
'Full', n, nrhs, cmplx( zero ),
611 $ cmplx( zero ), x, lda )
619 CALL
zsysvxx( fact, uplo, n, nrhs, a, lda, afac,
620 $ lda, iwork, equed, work( n+1 ),
b, lda, x,
621 $ lda, rcond, rpvgrw_svxx, berr, n_err_bnds,
622 $ errbnds_n, errbnds_c, 0, zero, work,
631 IF( iwork( k ).LT.0 )
THEN
632 IF( iwork( k ).NE.-k )
THEN
636 ELSE IF( iwork( k ).NE.k )
THEN
644 IF( info.NE.k .AND. info.LE.n )
THEN
645 CALL
alaerh( path,
'ZSYSVXX', info, k,
646 $ fact // uplo, n, n, -1, -1, nrhs, imat, nfail,
652 IF( ifact.GE.2 )
THEN
657 CALL
zsyt01( uplo, n, a, lda, afac, lda, iwork,
658 $ ainv, lda, rwork(2*nrhs+1),
667 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
668 CALL
zsyt02( uplo, n, nrhs, a, lda, x, lda, work,
669 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
674 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
679 CALL
zpot05( uplo, n, nrhs, a, lda,
b, lda, x, lda,
680 $ xact, lda, rwork, rwork( nrhs+1 ),
689 result( 6 ) =
dget06( rcond, rcondc )
695 IF( result( k ).GE.thresh )
THEN
696 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
697 $ CALL
aladhd( nout, path )
698 WRITE( nout, fmt = 9998 )
'ZSYSVXX',
699 $ fact, uplo, n, imat, k,
714 CALL
alasvm( path, nout, nfail, nrun, nerrs )
721 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
722 $
', test ', i2,
', ratio =', g12.5 )
723 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
724 $
', type ', i2,
', test ', i2,
', ratio =', g12.5 )
subroutine zebchvxx(THRESH, PATH)
ZEBCHVXX
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
double precision function zlansy(NORM, UPLO, N, A, LDA, WORK)
ZLANSY 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 symmetric matrix.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine zsyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZSYT02
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine zdrvsy(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZDRVSY
subroutine zsysvxx(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)
ZSYSVXX computes the solution to system of linear equations A * X = B for SY matrices ...
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05
subroutine zlatsy(UPLO, N, X, LDX, ISEED)
ZLATSY
double precision function dget06(RCOND, RCONDC)
DGET06
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine zsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRI2
subroutine aladhd(IOUNIT, PATH)
ALADHD
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zerrvx(PATH, NUNIT)
ZERRVX
subroutine zsysv(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZSYSV computes the solution to system of linear equations A * X = B for SY matrices ...
subroutine zsyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZSYT01
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zsysvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, RWORK, INFO)
ZSYSVX computes the solution to system of linear equations A * X = B for SY matrices ...
subroutine zsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRF
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4