232 SUBROUTINE ddrvrfp( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL,
233 + THRESH, A, ASAV, AFAC, AINV, B,
234 + BSAV, XACT, X, ARF, ARFINV,
235 + D_WORK_DLATMS, D_WORK_DPOT01, D_TEMP_DPOT02,
236 + D_TEMP_DPOT03, D_WORK_DLANSY,
237 + D_WORK_DPOT02, D_WORK_DPOT03 )
244 INTEGER NN, NNS, NNT, NOUT
245 DOUBLE PRECISION THRESH
248 INTEGER NVAL( NN ), NSVAL( NNS ), NTVAL( NNT )
249 DOUBLE PRECISION A( * )
250 DOUBLE PRECISION AINV( * )
251 DOUBLE PRECISION ASAV( * )
252 DOUBLE PRECISION B( * )
253 DOUBLE PRECISION BSAV( * )
254 DOUBLE PRECISION AFAC( * )
255 DOUBLE PRECISION ARF( * )
256 DOUBLE PRECISION ARFINV( * )
257 DOUBLE PRECISION XACT( * )
258 DOUBLE PRECISION X( * )
259 DOUBLE PRECISION D_WORK_DLATMS( * )
260 DOUBLE PRECISION D_WORK_DPOT01( * )
261 DOUBLE PRECISION D_TEMP_DPOT02( * )
262 DOUBLE PRECISION D_TEMP_DPOT03( * )
263 DOUBLE PRECISION D_WORK_DLANSY( * )
264 DOUBLE PRECISION D_WORK_DPOT02( * )
265 DOUBLE PRECISION D_WORK_DPOT03( * )
271 DOUBLE PRECISION ONE, ZERO
272 PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
274 PARAMETER ( NTESTS = 4 )
278 INTEGER I, INFO, IUPLO, LDA, LDB, IMAT, NERRS, NFAIL,
279 + nrhs, nrun, izero, ioff, k, nt, n, iform, iin,
281 CHARACTER DIST, CTYPE, UPLO, CFORM
283 DOUBLE PRECISION ANORM, AINVNM, CNDNUM, RCONDC
286 CHARACTER UPLOS( 2 ), FORMS( 2 )
287 INTEGER ISEED( 4 ), ISEEDY( 4 )
288 DOUBLE PRECISION RESULT( NTESTS )
291 DOUBLE PRECISION DLANSY
303 COMMON / SRNAMC / SRNAMT
306 DATA iseedy / 1988, 1989, 1990, 1991 /
307 DATA uplos /
'U',
'L' /
308 DATA forms /
'N',
'T' /
318 iseed( i ) = iseedy( i )
337 IF( n.EQ.0 .AND. iit.GE.1 )
GO TO 120
341 IF( imat.EQ.4 .AND. n.LE.1 )
GO TO 120
342 IF( imat.EQ.5 .AND. n.LE.2 )
GO TO 120
347 uplo = uplos( iuplo )
352 cform = forms( iform )
357 CALL dlatb4(
'DPO', imat, n, n, ctype, kl, ku,
358 + anorm, mode, cndnum, dist )
361 CALL dlatms( n, n, dist, iseed, ctype,
363 + mode, cndnum, anorm, kl, ku, uplo, a,
364 + lda, d_work_dlatms, info )
369 CALL alaerh(
'DPF',
'DLATMS', info, 0, uplo, n,
370 + n, -1, -1, -1, iit, nfail, nerrs,
378 zerot = imat.GE.3 .AND. imat.LE.5
382 ELSE IF( iit.EQ.4 )
THEN
387 ioff = ( izero-1 )*lda
391 IF( iuplo.EQ.1 )
THEN
392 DO 20 i = 1, izero - 1
402 DO 40 i = 1, izero - 1
417 CALL dlacpy( uplo, n, n, a, lda, asav, lda )
427 anorm = dlansy(
'1', uplo, n, a, lda,
432 CALL dpotrf( uplo, n, a, lda, info )
436 CALL dpotri( uplo, n, a, lda, info )
442 ainvnm = dlansy(
'1', uplo, n, a, lda,
444 rcondc = ( one / anorm ) / ainvnm
448 CALL dlacpy( uplo, n, n, asav, lda, a, lda )
456 CALL dlarhs(
'DPO',
'N', uplo,
' ', n, n, kl, ku,
457 + nrhs, a, lda, xact, lda, b, lda,
459 CALL dlacpy(
'Full', n, nrhs, b, lda, bsav, lda )
464 CALL dlacpy( uplo, n, n, a, lda, afac, lda )
465 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldb )
468 CALL dtrttf( cform, uplo, n, afac, lda, arf, info )
470 CALL dpftrf( cform, uplo, n, arf, info )
474 IF( info.NE.izero )
THEN
480 CALL alaerh(
'DPF',
'DPFSV ', info, izero,
481 + uplo, n, n, -1, -1, nrhs, iit,
482 + nfail, nerrs, nout )
493 CALL dpftrs( cform, uplo, n, nrhs, arf, x, ldb,
497 CALL dtfttr( cform, uplo, n, arf, afac, lda, info )
502 CALL dlacpy( uplo, n, n, afac, lda, asav, lda )
503 CALL dpot01( uplo, n, a, lda, afac, lda,
504 + d_work_dpot01, result( 1 ) )
505 CALL dlacpy( uplo, n, n, asav, lda, afac, lda )
509 IF(mod(n,2).EQ.0)
THEN
510 CALL dlacpy(
'A', n+1, n/2, arf, n+1, arfinv,
513 CALL dlacpy(
'A', n, (n+1)/2, arf, n, arfinv,
518 CALL dpftri( cform, uplo, n, arfinv , info )
521 CALL dtfttr( cform, uplo, n, arfinv, ainv, lda,
527 +
CALL alaerh(
'DPO',
'DPFTRI', info, 0, uplo, n,
528 + n, -1, -1, -1, imat, nfail, nerrs,
531 CALL dpot03( uplo, n, a, lda, ainv, lda,
532 + d_temp_dpot03, lda, d_work_dpot03,
533 + rcondc, result( 2 ) )
537 CALL dlacpy(
'Full', n, nrhs, b, lda,
538 + d_temp_dpot02, lda )
539 CALL dpot02( uplo, n, nrhs, a, lda, x, lda,
540 + d_temp_dpot02, lda, d_work_dpot02,
545 CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
553 IF( result( k ).GE.thresh )
THEN
554 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
555 +
CALL aladhd( nout,
'DPF' )
556 WRITE( nout, fmt = 9999 )
'DPFSV ', uplo,
557 + n, iit, k, result( k )
570 CALL alasvm(
'DPF', nout, nfail, nrun, nerrs )
572 9999
FORMAT( 1x, a6,
', UPLO=''', a1,
''', N =', i5,
', type ', i1,
573 +
', test(', i1,
')=', 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 aladhd(iounit, path)
ALADHD
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
subroutine ddrvrfp(nout, nn, nval, nns, nsval, nnt, ntval, thresh, a, asav, afac, ainv, b, bsav, xact, x, arf, arfinv, d_work_dlatms, d_work_dpot01, d_temp_dpot02, d_temp_dpot03, d_work_dlansy, d_work_dpot02, d_work_dpot03)
DDRVRFP
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 dpot01(uplo, n, a, lda, afac, ldafac, rwork, resid)
DPOT01
subroutine dpot02(uplo, n, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
DPOT02
subroutine dpot03(uplo, n, a, lda, ainv, ldainv, work, ldwork, rwork, rcond, resid)
DPOT03
subroutine dlacpy(uplo, m, n, a, lda, b, ldb)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dpftrf(transr, uplo, n, a, info)
DPFTRF
subroutine dpftri(transr, uplo, n, a, info)
DPFTRI
subroutine dpftrs(transr, uplo, n, nrhs, a, b, ldb, info)
DPFTRS
subroutine dpotrf(uplo, n, a, lda, info)
DPOTRF
subroutine dpotri(uplo, n, a, lda, info)
DPOTRI
subroutine dtfttr(transr, uplo, n, arf, a, lda, info)
DTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
subroutine dtrttf(transr, uplo, n, a, lda, arf, info)
DTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...