240 SUBROUTINE zdrvrfp( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL,
241 + THRESH, A, ASAV, AFAC, AINV, B,
242 + BSAV, XACT, X, ARF, ARFINV,
243 + Z_WORK_ZLATMS, Z_WORK_ZPOT02,
244 + Z_WORK_ZPOT03, D_WORK_ZLATMS, D_WORK_ZLANHE,
245 + D_WORK_ZPOT01, D_WORK_ZPOT02, D_WORK_ZPOT03 )
253 INTEGER NN, NNS, NNT, NOUT
254 DOUBLE PRECISION THRESH
257 INTEGER NVAL( NN ), NSVAL( NNS ), NTVAL( NNT )
265 COMPLEX*16 ARFINV( * )
268 COMPLEX*16 Z_WORK_ZLATMS( * )
269 COMPLEX*16 Z_WORK_ZPOT02( * )
270 COMPLEX*16 Z_WORK_ZPOT03( * )
271 DOUBLE PRECISION D_WORK_ZLATMS( * )
272 DOUBLE PRECISION D_WORK_ZLANHE( * )
273 DOUBLE PRECISION D_WORK_ZPOT01( * )
274 DOUBLE PRECISION D_WORK_ZPOT02( * )
275 DOUBLE PRECISION D_WORK_ZPOT03( * )
281 DOUBLE PRECISION ONE, ZERO
282 PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
284 PARAMETER ( NTESTS = 4 )
288 INTEGER I, INFO, IUPLO, LDA, LDB, IMAT, NERRS, NFAIL,
289 + nrhs, nrun, izero, ioff, k, nt, n, iform, iin,
291 CHARACTER DIST, CTYPE, UPLO, CFORM
293 DOUBLE PRECISION ANORM, AINVNM, CNDNUM, RCONDC
296 CHARACTER UPLOS( 2 ), FORMS( 2 )
297 INTEGER ISEED( 4 ), ISEEDY( 4 )
298 DOUBLE PRECISION RESULT( NTESTS )
301 DOUBLE PRECISION ZLANHE
314 COMMON / SRNAMC / SRNAMT
317 DATA iseedy / 1988, 1989, 1990, 1991 /
318 DATA uplos /
'U',
'L' /
319 DATA forms /
'N',
'C' /
329 iseed( i ) = iseedy( i )
348 IF( n.EQ.0 .AND. iit.GE.1 )
GO TO 120
352 IF( imat.EQ.4 .AND. n.LE.1 )
GO TO 120
353 IF( imat.EQ.5 .AND. n.LE.2 )
GO TO 120
358 uplo = uplos( iuplo )
363 cform = forms( iform )
368 CALL zlatb4(
'ZPO', imat, n, n, ctype, kl, ku,
369 + anorm, mode, cndnum, dist )
372 CALL zlatms( n, n, dist, iseed, ctype,
374 + mode, cndnum, anorm, kl, ku, uplo, a,
375 + lda, z_work_zlatms, info )
380 CALL alaerh(
'ZPF',
'ZLATMS', info, 0, uplo, n,
381 + n, -1, -1, -1, iit, nfail, nerrs,
389 zerot = imat.GE.3 .AND. imat.LE.5
393 ELSE IF( iit.EQ.4 )
THEN
398 ioff = ( izero-1 )*lda
402 IF( iuplo.EQ.1 )
THEN
403 DO 20 i = 1, izero - 1
413 DO 40 i = 1, izero - 1
428 CALL zlaipd( n, a, lda+1, 0 )
432 CALL zlacpy( uplo, n, n, a, lda, asav, lda )
442 anorm = zlanhe(
'1', uplo, n, a, lda,
447 CALL zpotrf( uplo, n, a, lda, info )
451 CALL zpotri( uplo, n, a, lda, info )
457 ainvnm = zlanhe(
'1', uplo, n, a, lda,
459 rcondc = ( one / anorm ) / ainvnm
463 CALL zlacpy( uplo, n, n, asav, lda, a, lda )
471 CALL zlarhs(
'ZPO',
'N', uplo,
' ', n, n, kl, ku,
472 + nrhs, a, lda, xact, lda, b, lda,
474 CALL zlacpy(
'Full', n, nrhs, b, lda, bsav, lda )
479 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
480 CALL zlacpy(
'Full', n, nrhs, b, ldb, x, ldb )
483 CALL ztrttf( cform, uplo, n, afac, lda, arf, info )
485 CALL zpftrf( cform, uplo, n, arf, info )
489 IF( info.NE.izero )
THEN
495 CALL alaerh(
'ZPF',
'ZPFSV ', info, izero,
496 + uplo, n, n, -1, -1, nrhs, iit,
497 + nfail, nerrs, nout )
508 CALL zpftrs( cform, uplo, n, nrhs, arf, x, ldb,
512 CALL ztfttr( cform, uplo, n, arf, afac, lda, info )
517 CALL zlacpy( uplo, n, n, afac, lda, asav, lda )
518 CALL zpot01( uplo, n, a, lda, afac, lda,
519 + d_work_zpot01, result( 1 ) )
520 CALL zlacpy( uplo, n, n, asav, lda, afac, lda )
524 IF(mod(n,2).EQ.0)
THEN
525 CALL zlacpy(
'A', n+1, n/2, arf, n+1, arfinv,
528 CALL zlacpy(
'A', n, (n+1)/2, arf, n, arfinv,
533 CALL zpftri( cform, uplo, n, arfinv , info )
536 CALL ztfttr( cform, uplo, n, arfinv, ainv, lda,
542 +
CALL alaerh(
'ZPO',
'ZPFTRI', info, 0, uplo, n,
543 + n, -1, -1, -1, imat, nfail, nerrs,
546 CALL zpot03( uplo, n, a, lda, ainv, lda,
547 + z_work_zpot03, lda, d_work_zpot03,
548 + rcondc, result( 2 ) )
552 CALL zlacpy(
'Full', n, nrhs, b, lda,
553 + z_work_zpot02, lda )
554 CALL zpot02( uplo, n, nrhs, a, lda, x, lda,
555 + z_work_zpot02, lda, d_work_zpot02,
560 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
568 IF( result( k ).GE.thresh )
THEN
569 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
570 +
CALL aladhd( nout,
'ZPF' )
571 WRITE( nout, fmt = 9999 )
'ZPFSV ', uplo,
572 + n, iit, k, result( k )
585 CALL alasvm(
'ZPF', nout, nfail, nrun, nerrs )
587 9999
FORMAT( 1x, a6,
', UPLO=''', a1,
''', N =', i5,
', type ', i1,
588 +
', test(', i1,
')=', g12.5 )