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 )
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 zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
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 zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
double precision function zlanhe(NORM, UPLO, N, A, LDA, WORK)
ZLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix.
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zpotri(UPLO, N, A, LDA, INFO)
ZPOTRI
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPOT03
subroutine zpftrs(TRANSR, UPLO, N, NRHS, A, B, LDB, INFO)
ZPFTRS
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 zpftrf(TRANSR, UPLO, N, A, INFO)
ZPFTRF
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
subroutine zpftri(TRANSR, UPLO, N, A, INFO)
ZPFTRI
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...
Intel Corp All rights reserved Redistribution and use in source and binary forms
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4