239 SUBROUTINE ddrvrfp( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL,
240 + thresh, a, asav, afac, ainv, b,
241 + bsav, xact, x, arf, arfinv,
242 + d_work_dlatms, d_work_dpot01, d_temp_dpot02,
243 + d_temp_dpot03, d_work_dlansy,
244 + d_work_dpot02, d_work_dpot03 )
252 INTEGER NN, NNS, NNT, NOUT
253 DOUBLE PRECISION THRESH
256 INTEGER NVAL( nn ), NSVAL( nns ), NTVAL( nnt )
257 DOUBLE PRECISION A( * )
258 DOUBLE PRECISION AINV( * )
259 DOUBLE PRECISION ASAV( * )
260 DOUBLE PRECISION B( * )
261 DOUBLE PRECISION BSAV( * )
262 DOUBLE PRECISION AFAC( * )
263 DOUBLE PRECISION ARF( * )
264 DOUBLE PRECISION ARFINV( * )
265 DOUBLE PRECISION XACT( * )
266 DOUBLE PRECISION X( * )
267 DOUBLE PRECISION D_WORK_DLATMS( * )
268 DOUBLE PRECISION D_WORK_DPOT01( * )
269 DOUBLE PRECISION D_TEMP_DPOT02( * )
270 DOUBLE PRECISION D_TEMP_DPOT03( * )
271 DOUBLE PRECISION D_WORK_DLANSY( * )
272 DOUBLE PRECISION D_WORK_DPOT02( * )
273 DOUBLE PRECISION D_WORK_DPOT03( * )
279 DOUBLE PRECISION ONE, ZERO
280 parameter ( one = 1.0d+0, zero = 0.0d+0 )
282 parameter ( ntests = 4 )
286 INTEGER I, INFO, IUPLO, LDA, LDB, IMAT, NERRS, NFAIL,
287 + nrhs, nrun, izero, ioff, k, nt, n, iform, iin,
289 CHARACTER DIST, CTYPE, UPLO, CFORM
291 DOUBLE PRECISION ANORM, AINVNM, CNDNUM, RCONDC
294 CHARACTER UPLOS( 2 ), FORMS( 2 )
295 INTEGER ISEED( 4 ), ISEEDY( 4 )
296 DOUBLE PRECISION RESULT( ntests )
299 DOUBLE PRECISION DLANSY
311 COMMON / srnamc / srnamt
314 DATA iseedy / 1988, 1989, 1990, 1991 /
315 DATA uplos /
'U',
'L' /
316 DATA forms /
'N',
'T' /
326 iseed( i ) = iseedy( i )
345 IF( n.EQ.0 .AND. iit.GE.1 )
GO TO 120
349 IF( imat.EQ.4 .AND. n.LE.1 )
GO TO 120
350 IF( imat.EQ.5 .AND. n.LE.2 )
GO TO 120
355 uplo = uplos( iuplo )
360 cform = forms( iform )
365 CALL dlatb4(
'DPO', imat, n, n, ctype, kl, ku,
366 + anorm, mode, cndnum, dist )
369 CALL dlatms( n, n, dist, iseed, ctype,
371 + mode, cndnum, anorm, kl, ku, uplo, a,
372 + lda, d_work_dlatms, info )
377 CALL alaerh(
'DPF',
'DLATMS', info, 0, uplo, n,
378 + n, -1, -1, -1, iit, nfail, nerrs,
386 zerot = imat.GE.3 .AND. imat.LE.5
390 ELSE IF( iit.EQ.4 )
THEN
395 ioff = ( izero-1 )*lda
399 IF( iuplo.EQ.1 )
THEN
400 DO 20 i = 1, izero - 1
410 DO 40 i = 1, izero - 1
425 CALL dlacpy( uplo, n, n, a, lda, asav, lda )
435 anorm = dlansy(
'1', uplo, n, a, lda,
440 CALL dpotrf( uplo, n, a, lda, info )
444 CALL dpotri( uplo, n, a, lda, info )
451 ainvnm = dlansy(
'1', uplo, n, a, lda,
453 rcondc = ( one / anorm ) / ainvnm
457 CALL dlacpy( uplo, n, n, asav, lda, a, lda )
465 CALL dlarhs(
'DPO',
'N', uplo,
' ', n, n, kl, ku,
466 + nrhs, a, lda, xact, lda, b, lda,
468 CALL dlacpy(
'Full', n, nrhs, b, lda, bsav, lda )
473 CALL dlacpy( uplo, n, n, a, lda, afac, lda )
474 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldb )
477 CALL dtrttf( cform, uplo, n, afac, lda, arf, info )
479 CALL dpftrf( cform, uplo, n, arf, info )
483 IF( info.NE.izero )
THEN
489 CALL alaerh(
'DPF',
'DPFSV ', info, izero,
490 + uplo, n, n, -1, -1, nrhs, iit,
491 + nfail, nerrs, nout )
502 CALL dpftrs( cform, uplo, n, nrhs, arf, x, ldb,
506 CALL dtfttr( cform, uplo, n, arf, afac, lda, info )
511 CALL dlacpy( uplo, n, n, afac, lda, asav, lda )
512 CALL dpot01( uplo, n, a, lda, afac, lda,
513 + d_work_dpot01, result( 1 ) )
514 CALL dlacpy( uplo, n, n, asav, lda, afac, lda )
518 IF(mod(n,2).EQ.0)
THEN
519 CALL dlacpy(
'A', n+1, n/2, arf, n+1, arfinv,
522 CALL dlacpy(
'A', n, (n+1)/2, arf, n, arfinv,
527 CALL dpftri( cform, uplo, n, arfinv , info )
530 CALL dtfttr( cform, uplo, n, arfinv, ainv, lda,
536 +
CALL alaerh(
'DPO',
'DPFTRI', info, 0, uplo, n,
537 + n, -1, -1, -1, imat, nfail, nerrs,
540 CALL dpot03( uplo, n, a, lda, ainv, lda,
541 + d_temp_dpot03, lda, d_work_dpot03,
542 + rcondc, result( 2 ) )
546 CALL dlacpy(
'Full', n, nrhs, b, lda,
547 + d_temp_dpot02, lda )
548 CALL dpot02( uplo, n, nrhs, a, lda, x, lda,
549 + d_temp_dpot02, lda, d_work_dpot02,
554 CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
562 IF( result( k ).GE.thresh )
THEN
563 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
564 +
CALL aladhd( nout,
'DPF' )
565 WRITE( nout, fmt = 9999 )
'DPFSV ', uplo,
566 + n, iit, k, result( k )
579 CALL alasvm(
'DPF', nout, nfail, nrun, nerrs )
581 9999
FORMAT( 1x, a6,
', UPLO=''', a1,
''', N =', i5,
', type ', i1,
582 +
', test(', i1,
')=', g12.5 )
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 dpotrf(UPLO, N, A, LDA, INFO)
DPOTRF
subroutine dpftri(TRANSR, UPLO, N, A, INFO)
DPFTRI
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 dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
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 dpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
DPOT03
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 dpftrf(TRANSR, UPLO, N, A, INFO)
DPFTRF
subroutine dpot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
DPOT01
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...
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine dpftrs(TRANSR, UPLO, N, NRHS, A, B, LDB, INFO)
DPFTRS
subroutine dpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DPOT02
subroutine dpotri(UPLO, N, A, LDA, INFO)
DPOTRI