151 SUBROUTINE ddrvsy( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
152 $ a, afac, ainv, b, x, xact, work, rwork, iwork,
162 INTEGER NMAX, NN, NOUT, NRHS
163 DOUBLE PRECISION THRESH
167 INTEGER IWORK( * ), NVAL( * )
168 DOUBLE PRECISION A( * ), AFAC( * ), AINV( * ), B( * ),
169 $ rwork( * ), work( * ), x( * ), xact( * )
175 DOUBLE PRECISION ONE, ZERO
176 parameter ( one = 1.0d+0, zero = 0.0d+0 )
177 INTEGER NTYPES, NTESTS
178 parameter ( ntypes = 10, ntests = 6 )
180 parameter ( nfact = 2 )
184 CHARACTER DIST, FACT,
TYPE, UPLO, XTYPE
186 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
187 $ izero, j, k, k1, kl, ku, lda, lwork, mode, n,
188 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
189 DOUBLE PRECISION AINVNM, ANORM, CNDNUM, RCOND, RCONDC
192 CHARACTER FACTS( nfact ), UPLOS( 2 )
193 INTEGER ISEED( 4 ), ISEEDY( 4 )
194 DOUBLE PRECISION RESULT( ntests )
197 DOUBLE PRECISION DGET06, DLANSY
198 EXTERNAL dget06, dlansy
211 COMMON / infoc / infot, nunit, ok, lerr
212 COMMON / srnamc / srnamt
218 DATA iseedy / 1988, 1989, 1990, 1991 /
219 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
225 path( 1: 1 ) =
'Double precision'
231 iseed( i ) = iseedy( i )
233 lwork = max( 2*nmax, nmax*nrhs )
238 $
CALL derrvx( 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 )
279 CALL dlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
283 CALL dlatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
284 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
290 CALL alaerh( path,
'DLATMS', info, 0, uplo, n, n, -1,
291 $ -1, -1, imat, nfail, nerrs, nout )
301 ELSE IF( imat.EQ.4 )
THEN
311 IF( iuplo.EQ.1 )
THEN
312 ioff = ( izero-1 )*lda
313 DO 20 i = 1, izero - 1
323 DO 40 i = 1, izero - 1
334 IF( iuplo.EQ.1 )
THEN
362 DO 150 ifact = 1, nfact
366 fact = facts( ifact )
376 ELSE IF( ifact.EQ.1 )
THEN
380 anorm = dlansy(
'1', uplo, n, a, lda, rwork )
384 CALL dlacpy( uplo, n, n, a, lda, afac, lda )
385 CALL dsytrf( uplo, n, afac, lda, iwork, work,
390 CALL dlacpy( uplo, n, n, afac, lda, ainv, lda )
391 lwork = (n+nb+1)*(nb+3)
392 CALL dsytri2( uplo, n, ainv, lda, iwork, work,
394 ainvnm = dlansy(
'1', uplo, n, ainv, lda, rwork )
398 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
401 rcondc = ( one / anorm ) / ainvnm
408 CALL dlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
409 $ nrhs, a, lda, xact, lda, b, lda, iseed,
415 IF( ifact.EQ.2 )
THEN
416 CALL dlacpy( uplo, n, n, a, lda, afac, lda )
417 CALL dlacpy(
'Full', n, nrhs, b, lda, x, lda )
422 CALL dsysv( uplo, n, nrhs, afac, lda, iwork, x,
423 $ lda, work, lwork, info )
431 IF( iwork( k ).LT.0 )
THEN
432 IF( iwork( k ).NE.-k )
THEN
436 ELSE IF( iwork( k ).NE.k )
THEN
445 CALL alaerh( path,
'DSYSV ', info, k, uplo, n,
446 $ n, -1, -1, nrhs, imat, nfail,
449 ELSE IF( info.NE.0 )
THEN
456 CALL dsyt01( uplo, n, a, lda, afac, lda, iwork,
457 $ ainv, lda, rwork, result( 1 ) )
461 CALL dlacpy(
'Full', n, nrhs, b, lda, work, lda )
462 CALL dpot02( uplo, n, nrhs, a, lda, x, lda, work,
463 $ lda, rwork, result( 2 ) )
467 CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
475 IF( result( k ).GE.thresh )
THEN
476 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
477 $
CALL aladhd( nout, path )
478 WRITE( nout, fmt = 9999 )
'DSYSV ', uplo, n,
479 $ imat, k, result( k )
490 $
CALL dlaset( uplo, n, n, zero, zero, afac, lda )
491 CALL dlaset(
'Full', n, nrhs, zero, zero, x, lda )
497 CALL dsysvx( fact, uplo, n, nrhs, a, lda, afac, lda,
498 $ iwork, b, lda, x, lda, rcond, rwork,
499 $ rwork( nrhs+1 ), work, lwork,
500 $ iwork( n+1 ), info )
508 IF( iwork( k ).LT.0 )
THEN
509 IF( iwork( k ).NE.-k )
THEN
513 ELSE IF( iwork( k ).NE.k )
THEN
522 CALL alaerh( path,
'DSYSVX', info, k, fact // uplo,
523 $ n, n, -1, -1, nrhs, imat, nfail,
529 IF( ifact.GE.2 )
THEN
534 CALL dsyt01( uplo, n, a, lda, afac, lda, iwork,
535 $ ainv, lda, rwork( 2*nrhs+1 ),
544 CALL dlacpy(
'Full', n, nrhs, b, lda, work, lda )
545 CALL dpot02( uplo, n, nrhs, a, lda, x, lda, work,
546 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
550 CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
555 CALL dpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
556 $ xact, lda, rwork, rwork( nrhs+1 ),
565 result( 6 ) = dget06( rcond, rcondc )
571 IF( result( k ).GE.thresh )
THEN
572 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
573 $
CALL aladhd( nout, path )
574 WRITE( nout, fmt = 9998 )
'DSYSVX', fact, uplo,
575 $ n, imat, k, result( k )
589 CALL alasvm( path, nout, nfail, nrun, nerrs )
591 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
592 $
', test ', i2,
', ratio =', g12.5 )
593 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
594 $
', type ', i2,
', test ', i2,
', ratio =', g12.5 )
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
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 dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
subroutine dsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRI2
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine dsyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
DSYT01
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine derrvx(PATH, NUNIT)
DERRVX
subroutine dsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF
subroutine dsysvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, IWORK, INFO)
DSYSVX computes the solution to system of linear equations A * X = B for SY matrices ...
subroutine ddrvsy(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
DDRVSY
subroutine dpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DPOT05
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine dpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DPOT02
subroutine dsysv(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
DSYSV computes the solution to system of linear equations A * X = B for SY matrices ...