152 $ DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
153 $ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
154 $ RWORK, IWORK, NOUT )
162 INTEGER NMAX, NN, NOUT, NRHS
163 DOUBLE PRECISION THRESH
167 INTEGER IWORK( * ), NVAL( * )
168 DOUBLE PRECISION RWORK( * )
169 DOUBLE PRECISION A( * ), AFAC( * ), AINV( * ), B( * ),
170 $ work( * ), x( * ), xact( * )
176 DOUBLE PRECISION ONE, ZERO
177 PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
178 INTEGER NTYPES, NTESTS
179 parameter( ntypes = 10, ntests = 3 )
181 parameter( nfact = 2 )
185 CHARACTER DIST, FACT,
TYPE, UPLO, XTYPE
186 CHARACTER*3 MATPATH, PATH
187 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
188 $ izero, j, k, kl, ku, lda, lwork, mode, n,
189 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
190 DOUBLE PRECISION ANORM, CNDNUM
193 CHARACTER FACTS( NFACT ), UPLOS( 2 )
194 INTEGER ISEED( 4 ), ISEEDY( 4 )
195 DOUBLE PRECISION RESULT( NTESTS )
198 DOUBLE PRECISION DLANSY, SGET06
199 EXTERNAL DLANSY, SGET06
213 COMMON / infoc / infot, nunit, ok, lerr
214 COMMON / srnamc / srnamt
217 INTRINSIC cmplx, max, min
220 DATA iseedy / 1988, 1989, 1990, 1991 /
221 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
229 path( 1: 1 ) =
'Double precision'
234 matpath( 1: 1 ) =
'Double precision'
235 matpath( 2: 3 ) =
'SY'
241 iseed( i ) = iseedy( i )
247 $
CALL derrvx( path, nout )
267 DO 170 imat = 1, nimat
271 IF( .NOT.dotype( imat ) )
276 zerot = imat.GE.3 .AND. imat.LE.6
277 IF( zerot .AND. n.LT.imat-2 )
283 uplo = uplos( iuplo )
290 CALL dlatb4( matpath, imat, n, n,
TYPE, kl, ku, anorm,
291 $ mode, cndnum, dist )
296 CALL dlatms( n, n, dist, iseed,
TYPE, rwork, mode,
297 $ cndnum, anorm, kl, ku, uplo, a, lda,
303 CALL alaerh( path,
'DLATMS', info, 0, uplo, n, n,
304 $ -1, -1, -1, imat, nfail, nerrs, nout )
314 ELSE IF( imat.EQ.4 )
THEN
324 IF( iuplo.EQ.1 )
THEN
325 ioff = ( izero-1 )*lda
326 DO 20 i = 1, izero - 1
336 DO 40 i = 1, izero - 1
347 IF( iuplo.EQ.1 )
THEN
380 DO 150 ifact = 1, nfact
384 fact = facts( ifact )
389 CALL dlarhs( matpath, xtype, uplo,
' ', n, n, kl, ku,
390 $ nrhs, a, lda, xact, lda, b, lda, iseed,
396 IF( ifact.EQ.2 )
THEN
397 CALL dlacpy( uplo, n, n, a, lda, afac, lda )
398 CALL dlacpy(
'Full', n, nrhs, b, lda, x, lda )
402 srnamt =
'DSYSV_AA_2STAGE '
403 lwork = min(n*nb, 3*nmax*nmax)
406 $ iwork, iwork( 1+n ),
407 $ x, lda, work, lwork, info )
412 IF( izero.GT.0 )
THEN
418 ELSE IF( iwork( j ).EQ.k )
THEN
432 CALL alaerh( path,
'DSYSV_AA', info, k,
433 $ uplo, n, n, -1, -1, nrhs,
434 $ imat, nfail, nerrs, nout )
436 ELSE IF( info.NE.0 )
THEN
442 CALL dlacpy(
'Full', n, nrhs, b, lda, work, lda )
443 CALL dpot02( uplo, n, nrhs, a, lda, x, lda, work,
444 $ lda, rwork, result( 1 ) )
459 IF( result( k ).GE.thresh )
THEN
460 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
461 $
CALL aladhd( nout, path )
462 WRITE( nout, fmt = 9999 )
'DSYSV_AA ',
463 $ uplo, n, imat, k, result( k )
479 CALL alasvm( path, nout, nfail, nrun, nerrs )
481 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
482 $
', test ', i2,
', ratio =', g12.5 )
subroutine alasvm(type, nout, nfail, nrun, nerrs)
ALASVM
subroutine dlarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
DLARHS
subroutine xlaenv(ispec, nvalue)
XLAENV
subroutine aladhd(iounit, path)
ALADHD
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
subroutine ddrvsy_aa_2stage(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
DDRVSY_AA_2STAGE
subroutine derrvx(path, nunit)
DERRVX
subroutine dget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
DGET04
subroutine dlatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
DLATB4
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_aa_2stage(uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, work, lwork, info)
DSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices
subroutine dsytrf_aa_2stage(uplo, n, a, lda, tb, ltb, ipiv, ipiv2, work, lwork, info)
DSYTRF_AA_2STAGE
subroutine dlacpy(uplo, m, n, a, lda, b, ldb)
DLACPY copies all or part of one two-dimensional array to another.