157 SUBROUTINE zdrvsy_rk( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
158 $ nmax, a, afac, e, ainv, b, x, xact, work,
159 $ rwork, iwork, nout )
168 INTEGER NMAX, NN, NOUT, NRHS
169 DOUBLE PRECISION THRESH
173 INTEGER IWORK( * ), NVAL( * )
174 DOUBLE PRECISION RWORK( * )
175 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
176 $ work( * ), x( * ), xact( * )
182 DOUBLE PRECISION ONE, ZERO
183 parameter ( one = 1.0d+0, zero = 0.0d+0 )
184 INTEGER NTYPES, NTESTS
185 parameter ( ntypes = 11, ntests = 3 )
187 parameter ( nfact = 2 )
191 CHARACTER DIST, FACT,
TYPE, UPLO, XTYPE
192 CHARACTER*3 MATPATH, PATH
193 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
194 $ izero, j, k, kl, ku, lda, lwork, mode, n,
195 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
196 DOUBLE PRECISION AINVNM, ANORM, CNDNUM, RCONDC
199 CHARACTER FACTS( nfact ), UPLOS( 2 )
200 INTEGER ISEED( 4 ), ISEEDY( 4 )
201 DOUBLE PRECISION RESULT( ntests )
205 DOUBLE PRECISION ZLANSY
219 COMMON / infoc / infot, nunit, ok, lerr
220 COMMON / srnamc / srnamt
226 DATA iseedy / 1988, 1989, 1990, 1991 /
227 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
235 path( 1: 1 ) =
'Zomplex precision'
240 matpath( 1: 1 ) =
'Zomplex precision'
241 matpath( 2: 3 ) =
'SY'
247 iseed( i ) = iseedy( i )
249 lwork = max( 2*nmax, nmax*nrhs )
254 $
CALL zerrvx( path, nout )
275 DO 170 imat = 1, nimat
279 IF( .NOT.dotype( imat ) )
284 zerot = imat.GE.3 .AND. imat.LE.6
285 IF( zerot .AND. n.LT.imat-2 )
291 uplo = uplos( iuplo )
293 IF( imat.NE.ntypes )
THEN
300 CALL zlatb4( matpath, imat, n, n,
TYPE, KL, KU, ANORM,
301 $ mode, cndnum, dist )
306 CALL zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
307 $ cndnum, anorm, kl, ku, uplo, a, lda,
313 CALL alaerh( path,
'ZLATMS', info, 0, uplo, n, n,
314 $ -1, -1, -1, imat, nfail, nerrs, nout )
324 ELSE IF( imat.EQ.4 )
THEN
334 IF( iuplo.EQ.1 )
THEN
335 ioff = ( izero-1 )*lda
336 DO 20 i = 1, izero - 1
346 DO 40 i = 1, izero - 1
356 IF( iuplo.EQ.1 )
THEN
390 CALL zlatsy( uplo, n, a, lda, iseed )
393 DO 150 ifact = 1, nfact
397 fact = facts( ifact )
407 ELSE IF( ifact.EQ.1 )
THEN
411 anorm = zlansy(
'1', uplo, n, a, lda, rwork )
416 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
417 CALL zsytrf_rk( uplo, n, afac, lda, e, iwork, ainv,
422 CALL zlacpy( uplo, n, n, afac, lda, ainv, lda )
423 lwork = (n+nb+1)*(nb+3)
428 CALL zsytri_3( uplo, n, ainv, lda, e, iwork,
429 $ work, lwork, info )
430 ainvnm = zlansy(
'1', uplo, n, ainv, lda, rwork )
434 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
437 rcondc = ( one / anorm ) / ainvnm
444 CALL zlarhs( matpath, xtype, uplo,
' ', n, n, kl, ku,
445 $ nrhs, a, lda, xact, lda, b, lda, iseed,
451 IF( ifact.EQ.2 )
THEN
452 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
453 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
459 CALL zsysv_rk( uplo, n, nrhs, afac, lda, e, iwork,
460 $ x, lda, work, lwork, info )
468 IF( iwork( k ).LT.0 )
THEN
469 IF( iwork( k ).NE.-k )
THEN
473 ELSE IF( iwork( k ).NE.k )
THEN
482 CALL alaerh( path,
'ZSYSV_RK', info, k, uplo,
483 $ n, n, -1, -1, nrhs, imat, nfail,
486 ELSE IF( info.NE.0 )
THEN
493 CALL zsyt01_3( uplo, n, a, lda, afac, lda, e,
494 $ iwork, ainv, lda, rwork,
499 CALL zlacpy(
'Full', n, nrhs, b, lda, work, lda )
500 CALL zsyt02( uplo, n, nrhs, a, lda, x, lda, work,
501 $ lda, rwork, result( 2 ) )
506 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
514 IF( result( k ).GE.thresh )
THEN
515 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
516 $
CALL aladhd( nout, path )
517 WRITE( nout, fmt = 9999 )
'ZSYSV_RK', uplo,
518 $ n, imat, k, result( k )
534 CALL alasvm( path, nout, nfail, nrun, nerrs )
536 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
537 $
', test ', i2,
', ratio =', g12.5 )
subroutine zsysv_rk(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, LWORK, INFO)
ZSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices ...
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 zsytri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
ZSYTRI_3
subroutine zdrvsy_rk(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZDRVSY_RK
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 zsyt01_3(UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C, LDC, RWORK, RESID)
ZSYT01_3
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine zlatsy(UPLO, N, X, LDX, ISEED)
ZLATSY
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
subroutine zsytrf_rk(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
ZSYTRF_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch...
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine zsyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZSYT02
subroutine zerrvx(PATH, NUNIT)
ZERRVX
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS