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( 1x, a6,
', UPLO=''', a1,
''', N =', i5,
', type ', i1,
582 +
', test(', i1,
')=', g12.5 )