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 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 zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
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 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 zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRI2
subroutine zsyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZSYT01
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine zsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRF
subroutine zlatsy(UPLO, N, X, LDX, ISEED)
ZLATSY
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 zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
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 zebchvxx(THRESH, PATH)
ZEBCHVXX
subroutine aladhd(IOUNIT, PATH)
ALADHD
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 zsyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZSYT02
double precision function dget06(RCOND, RCONDC)
DGET06
subroutine zerrvx(PATH, NUNIT)
ZERRVX
subroutine zdrvsy(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZDRVSY
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05