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 )
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( 1
x, a6,
', UPLO=''', a1,
''', N =', i5,
', type ', i1,
582 +
', test(', i1,
')=', g12.5 )
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 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 alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
DOUBLE PRECISION function dlansy(NORM, UPLO, N, A, LDA, WORK)
DLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.
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 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 dpot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
DPOT01
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dpftrs(TRANSR, UPLO, N, NRHS, A, B, LDB, INFO)
DPFTRS
subroutine dpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
DPOT03
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
subroutine dpotri(UPLO, N, A, LDA, INFO)
DPOTRI
subroutine dpotrf(UPLO, N, A, LDA, INFO)
DPOTRF
subroutine dpftrf(TRANSR, UPLO, N, A, INFO)
DPFTRF
Intel Corp All rights reserved Redistribution and use in source and binary forms