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 )
subroutine zpotrf(UPLO, N, A, LDA, INFO)
ZPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS.
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
subroutine zpftrf(TRANSR, UPLO, N, A, INFO)
ZPFTRF
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
subroutine zpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPOT03
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
subroutine ztfttr(TRANSR, UPLO, N, ARF, A, LDA, INFO)
ZTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
subroutine zdrvrfp(NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, A, ASAV, AFAC, AINV, B, BSAV, XACT, X, ARF, ARFINV, Z_WORK_ZLATMS, Z_WORK_ZPOT02, Z_WORK_ZPOT03, D_WORK_ZLATMS, D_WORK_ZLANHE, D_WORK_ZPOT01, D_WORK_ZPOT02, D_WORK_ZPOT03)
ZDRVRFP
subroutine zpftri(TRANSR, UPLO, N, A, INFO)
ZPFTRI
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine zpot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
ZPOT01
subroutine ztrttf(TRANSR, UPLO, N, A, LDA, ARF, INFO)
ZTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zpftrs(TRANSR, UPLO, N, NRHS, A, B, LDB, INFO)
ZPFTRS
subroutine zpotri(UPLO, N, A, LDA, INFO)
ZPOTRI