150 SUBROUTINE zdrvsy( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
151 $ A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
160 INTEGER NMAX, NN, NOUT, NRHS
161 DOUBLE PRECISION THRESH
165 INTEGER IWORK( * ), NVAL( * )
166 DOUBLE PRECISION RWORK( * )
167 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
168 $ work( * ), x( * ), xact( * )
174 DOUBLE PRECISION ONE, ZERO
175 PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
177 parameter( ntypes = 11, ntests = 6 )
179 parameter( nfact = 2 )
183 CHARACTER DIST, FACT,
TYPE, UPLO, XTYPE
185 INTEGER , I1, I2, IFACT, IMAT, IN, , IOFF, IUPLO,
186 $ izero, j, k, k1, kl, ku, lda, lwork, mode, n,
187 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
188 DOUBLE PRECISION AINVNM, ANORM, CNDNUM, RCOND, RCONDC
191 CHARACTER FACTS( NFACT ), UPLOS( 2 )
193DOUBLE PRECISION RESULT( NTESTS )
196 DOUBLE PRECISION DGET06, ZLANSY
197 EXTERNAL DGET06, ZLANSY
211 COMMON / infoc / infot, nunit, ok, lerr
212 COMMON / srnamc / srnamt
215 INTRINSIC dcmplx,
max,
min
218 DATA iseedy / 1988, 1989, 1990, 1991 /
219 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
225 path( 1: 1 ) =
'Zomplex precision'
231 iseed( i ) = iseedy( i )
233 lwork =
max( 2*nmax, nmax*nrhs )
238 $
CALL zerrvx( path, nout )
258 DO 170 imat = 1, nimat
262 IF( .NOT.dotype( imat ) )
267 zerot = imat.GE.3 .AND. imat.LE.6
268 IF( zerot .AND. n.LT.imat-2 )
274 uplo = uplos( iuplo )
276 IF( imat.NE.ntypes )
THEN
281 CALL zlatb4( path, imat, n, n,
TYPE, kl, ku, anorm,
282 $ mode, cndnum, dist )
285 CALL zlatms( n, n, dist, iseed,
TYPE, rwork, mode,
286 $ cndnum, anorm, kl, ku, uplo, a, lda,
292 CALL alaerh( path,
'ZLATMS', info, 0, uplo, n, n,
293 $ -1, -1, -1, imat, nfail, nerrs, nout )
303 ELSE IF( imat.EQ.4 )
THEN
313 IF( iuplo.EQ.1 )
THEN
314 ioff = ( izero-1 )*lda
315 DO 20 i = 1, izero - 1
325 DO 40 i = 1, izero - 1
335 IF( iuplo.EQ.1 )
THEN
369 CALL zlatsy( uplo, n, a, lda, iseed )
372 DO 150 ifact = 1, nfact
376 fact = facts( ifact )
386 ELSE IF( ifact.EQ.1 )
THEN
390 anorm = zlansy(
'1', uplo, n, a, lda, rwork )
394 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
395 CALL zsytrf( uplo, n, afac, lda, iwork, work,
400 CALL zlacpy( uplo, n, n, afac, lda, ainv, lda )
401 lwork = (n+nb+1)*(nb+3)
402 CALL zsytri2( uplo, n, ainv, lda, iwork, work,
404 ainvnm = zlansy(
'1', uplo, n, ainv, lda, rwork )
408 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
411 rcondc = ( one / anorm ) / ainvnm
418 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
419 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
425.EQ.
IF( IFACT2 ) THEN
426 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
427 CALL ZLACPY( 'full
', N, NRHS, B, LDA, X, LDA )
432 CALL ZSYSV( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
433 $ LDA, WORK, LWORK, INFO )
441.LT.
IF( IWORK( K )0 ) THEN
442.NE.
IF( IWORK( K )-K ) THEN
446.NE.
ELSE IF( IWORK( K )K ) THEN
455 CALL ALAERH( PATH, 'zsysv ', INFO, K, UPLO, N,
456 $ N, -1, -1, NRHS, IMAT, NFAIL,
459.NE.
ELSE IF( INFO0 ) THEN
466 CALL ZSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
467 $ AINV, LDA, RWORK, RESULT( 1 ) )
471 CALL ZLACPY( 'full
', N, NRHS, B, LDA, WORK, LDA )
472 CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
473 $ LDA, RWORK, RESULT( 2 ) )
477 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
485.GE.
IF( RESULT( K )THRESH ) THEN
486.EQ..AND..EQ.
IF( NFAIL0 NERRS0 )
487 $ CALL ALADHD( NOUT, PATH )
488 WRITE( NOUT, FMT = 9999 )'zsysv ', UPLO, N,
489 $ IMAT, K, RESULT( K )
500 $ CALL ZLASET( UPLO, N, N, DCMPLX( ZERO ),
501 $ DCMPLX( ZERO ), AFAC, LDA )
502 CALL ZLASET( 'full
', N, NRHS, DCMPLX( ZERO ),
503 $ DCMPLX( ZERO ), X, LDA )
509 CALL ZSYSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, LDA,
510 $ IWORK, B, LDA, X, LDA, RCOND, RWORK,
511 $ RWORK( NRHS+1 ), WORK, LWORK,
512 $ RWORK( 2*NRHS+1 ), INFO )
520.LT.
IF( IWORK( K )0 ) THEN
521.NE.
IF( IWORK( K )-K ) THEN
525.NE.
ELSE IF( IWORK( K )K ) THEN
534 CALL ALAERH( PATH, 'zsysvx', INFO, K, FACT // UPLO,
535 $ N, N, -1, -1, NRHS, IMAT, NFAIL,
541.GE.
IF( IFACT2 ) THEN
546 CALL ZSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
547 $ AINV, LDA, RWORK( 2*NRHS+1 ),
556 CALL ZLACPY( 'full
', N, NRHS, B, LDA, WORK, LDA )
557 CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
558 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
562 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
567 CALL ZPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
568 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
577 RESULT( 6 ) = DGET06( RCOND, RCONDC )
583.GE.
IF( RESULT( K )THRESH ) THEN
584.EQ..AND..EQ.
IF( NFAIL0 NERRS0 )
585 $ CALL ALADHD( NOUT, PATH )
586 WRITE( NOUT, FMT = 9998 )'zsysvx', FACT, UPLO,
587 $ N, IMAT, K, RESULT( K )
601 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
603 9999 FORMAT( 1X, A, ', uplo=
''', A1, ''', n =
', I5, ',
type ', I2,
604 $ ', test ', i2,
', ratio =', g12.5 )
605 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
606 $
', type ', i2,
', test ', i2,
', ratio =', g12.5 )
subroutine xlaenv(ispec, nvalue)
XLAENV
subroutine alasvm(type, nout, nfail, nrun, nerrs)
ALASVM
subroutine aladhd(iounit, path)
ALADHD
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
subroutine zlacpy(uplo, m, n, a, lda, b, ldb)
ZLACPY copies all or part of one two-dimensional array to another.
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 zsytrf(uplo, n, a, lda, ipiv, work, lwork, info)
ZSYTRF
subroutine zsytri2(uplo, n, a, lda, ipiv, work, lwork, info)
ZSYTRI2
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 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 zlarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
ZLARHS
subroutine zerrvx(path, nunit)
ZERRVX
subroutine zget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
ZGET04
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
subroutine zdrvsy(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZDRVSY
subroutine zsyt01(uplo, n, a, lda, afac, ldafac, ipiv, c, ldc, rwork, resid)
ZSYT01
subroutine zsyt02(uplo, n, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
ZSYT02
subroutine zlatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
ZLATB4
subroutine zlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
ZLATMS