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 )
443 ainvnm = dlansy(
'1', uplo, n, a, lda,
445 rcondc = ( one / anorm ) / ainvnm
449 CALL dlacpy( uplo, n, n, asav, lda, a, lda )
457 CALL dlarhs(
'DPO',
'N', uplo,
' ', n, n, kl, ku,
458 + nrhs, a, lda, xact, lda, b, lda,
460 CALL dlacpy(
'Full', n, nrhs, b, lda, bsav, lda )
465 CALL dlacpy( uplo, n, n, a, lda, afac, lda )
466 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldb )
469 CALL dtrttf( cform, uplo, n, afac, lda, arf, info )
471 CALL dpftrf( cform, uplo, n, arf, info )
475 IF( info.NE.izero )
THEN
481 CALL alaerh(
'DPF',
'DPFSV ', info, izero,
482 + uplo, n, n, -1, -1, nrhs, iit,
483 + nfail, nerrs, nout )
494 CALL dpftrs( cform, uplo, n, nrhs, arf, x, ldb,
498 CALL dtfttr( cform, uplo, n, arf, afac, lda, info )
503 CALL dlacpy( uplo, n, n, afac, lda, asav, lda )
504 CALL dpot01( uplo, n, a, lda, afac, lda,
505 + d_work_dpot01, result( 1 ) )
506 CALL dlacpy( uplo, n, n, asav, lda, afac, lda )
510 IF(mod(n,2).EQ.0)
THEN
511 CALL dlacpy(
'A', n+1, n/2, arf, n+1, arfinv,
514 CALL dlacpy(
'A', n, (n+1)/2, arf, n, arfinv,
519 CALL dpftri( cform, uplo, n, arfinv , info )
522 CALL dtfttr( cform, uplo, n, arfinv, ainv, lda,
528 +
CALL alaerh(
'DPO',
'DPFTRI', info, 0, uplo, n,
529 + n, -1, -1, -1, imat, nfail, nerrs,
532 CALL dpot03( uplo, n, a, lda, ainv, lda,
533 + d_temp_dpot03, lda, d_work_dpot03,
534 + rcondc, result( 2 ) )
538 CALL dlacpy(
'Full', n, nrhs, b, lda,
539 + d_temp_dpot02, lda )
540 CALL dpot02( uplo, n, nrhs, a, lda, x, lda,
541 + d_temp_dpot02, lda, d_work_dpot02,
546 CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
554 IF( result( k ).GE.thresh )
THEN
555 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
556 +
CALL aladhd( nout,
'DPF' )
557 WRITE( nout, fmt = 9999 )
'DPFSV ', uplo,
558 + n, iit, k, result( k )
571 CALL alasvm(
'DPF', nout, nfail, nrun, nerrs )
573 9999
FORMAT( 1x, a6,
', UPLO=''', a1,
''', N =', i5,
', type ', i1,
574 +
', test(', i1,
')=', 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 aladhd(IOUNIT, PATH)
ALADHD
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 dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
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 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 dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
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 dpftrs(TRANSR, UPLO, N, NRHS, A, B, LDB, INFO)
DPFTRS
subroutine dpftri(TRANSR, UPLO, N, A, INFO)
DPFTRI
subroutine dpftrf(TRANSR, UPLO, N, A, INFO)
DPFTRF
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 dpotrf(UPLO, N, A, LDA, INFO)
DPOTRF
subroutine dpotri(UPLO, N, A, LDA, INFO)
DPOTRI