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 )