NAKATA Maho
25d74b31a7
Replace hard-coded floating-point constants with existing named constants in the drvrf3 and drvrfp test drivers. This keeps the test initialization code consistent with surrounding LAPACK test style.
593 lines
19 KiB
FortranFixed
593 lines
19 KiB
FortranFixed
*> \brief \b ZDRVRFP
|
|
*
|
|
* =========== DOCUMENTATION ===========
|
|
*
|
|
* Online html documentation available at
|
|
* http://www.netlib.org/lapack/explore-html/
|
|
*
|
|
* Definition:
|
|
* ===========
|
|
*
|
|
* 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 )
|
|
*
|
|
* .. Scalar Arguments ..
|
|
* INTEGER NN, NNS, NNT, NOUT
|
|
* DOUBLE PRECISION THRESH
|
|
* ..
|
|
* .. Array Arguments ..
|
|
* INTEGER NVAL( NN ), NSVAL( NNS ), NTVAL( NNT )
|
|
* COMPLEX*16 A( * )
|
|
* COMPLEX*16 AINV( * )
|
|
* COMPLEX*16 ASAV( * )
|
|
* COMPLEX*16 B( * )
|
|
* COMPLEX*16 BSAV( * )
|
|
* COMPLEX*16 AFAC( * )
|
|
* COMPLEX*16 ARF( * )
|
|
* COMPLEX*16 ARFINV( * )
|
|
* COMPLEX*16 XACT( * )
|
|
* COMPLEX*16 X( * )
|
|
* COMPLEX*16 Z_WORK_ZLATMS( * )
|
|
* COMPLEX*16 Z_WORK_ZPOT02( * )
|
|
* COMPLEX*16 Z_WORK_ZPOT03( * )
|
|
* DOUBLE PRECISION D_WORK_ZLATMS( * )
|
|
* DOUBLE PRECISION D_WORK_ZLANHE( * )
|
|
* DOUBLE PRECISION D_WORK_ZPOT01( * )
|
|
* DOUBLE PRECISION D_WORK_ZPOT02( * )
|
|
* DOUBLE PRECISION D_WORK_ZPOT03( * )
|
|
* ..
|
|
*
|
|
*
|
|
*> \par Purpose:
|
|
* =============
|
|
*>
|
|
*> \verbatim
|
|
*>
|
|
*> ZDRVRFP tests the LAPACK RFP routines:
|
|
*> ZPFTRF, ZPFTRS, and ZPFTRI.
|
|
*>
|
|
*> This testing routine follow the same tests as ZDRVPO (test for the full
|
|
*> format Symmetric Positive Definite solver).
|
|
*>
|
|
*> The tests are performed in Full Format, conversion back and forth from
|
|
*> full format to RFP format are performed using the routines ZTRTTF and
|
|
*> ZTFTTR.
|
|
*>
|
|
*> First, a specific matrix A of size N is created. There is nine types of
|
|
*> different matrixes possible.
|
|
*> 1. Diagonal 6. Random, CNDNUM = sqrt(0.1/EPS)
|
|
*> 2. Random, CNDNUM = 2 7. Random, CNDNUM = 0.1/EPS
|
|
*> *3. First row and column zero 8. Scaled near underflow
|
|
*> *4. Last row and column zero 9. Scaled near overflow
|
|
*> *5. Middle row and column zero
|
|
*> (* - tests error exits from ZPFTRF, no test ratios are computed)
|
|
*> A solution XACT of size N-by-NRHS is created and the associated right
|
|
*> hand side B as well. Then ZPFTRF is called to compute L (or U), the
|
|
*> Cholesky factor of A. Then L (or U) is used to solve the linear system
|
|
*> of equations AX = B. This gives X. Then L (or U) is used to compute the
|
|
*> inverse of A, AINV. The following four tests are then performed:
|
|
*> (1) norm( L*L' - A ) / ( N * norm(A) * EPS ) or
|
|
*> norm( U'*U - A ) / ( N * norm(A) * EPS ),
|
|
*> (2) norm(B - A*X) / ( norm(A) * norm(X) * EPS ),
|
|
*> (3) norm( I - A*AINV ) / ( N * norm(A) * norm(AINV) * EPS ),
|
|
*> (4) ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ),
|
|
*> where EPS is the machine precision, RCOND the condition number of A, and
|
|
*> norm( . ) the 1-norm for (1,2,3) and the inf-norm for (4).
|
|
*> Errors occur when INFO parameter is not as expected. Failures occur when
|
|
*> a test ratios is greater than THRES.
|
|
*> \endverbatim
|
|
*
|
|
* Arguments:
|
|
* ==========
|
|
*
|
|
*> \param[in] NOUT
|
|
*> \verbatim
|
|
*> NOUT is INTEGER
|
|
*> The unit number for output.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] NN
|
|
*> \verbatim
|
|
*> NN is INTEGER
|
|
*> The number of values of N contained in the vector NVAL.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] NVAL
|
|
*> \verbatim
|
|
*> NVAL is INTEGER array, dimension (NN)
|
|
*> The values of the matrix dimension N.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] NNS
|
|
*> \verbatim
|
|
*> NNS is INTEGER
|
|
*> The number of values of NRHS contained in the vector NSVAL.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] NSVAL
|
|
*> \verbatim
|
|
*> NSVAL is INTEGER array, dimension (NNS)
|
|
*> The values of the number of right-hand sides NRHS.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] NNT
|
|
*> \verbatim
|
|
*> NNT is INTEGER
|
|
*> The number of values of MATRIX TYPE contained in the vector NTVAL.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] NTVAL
|
|
*> \verbatim
|
|
*> NTVAL is INTEGER array, dimension (NNT)
|
|
*> The values of matrix type (between 0 and 9 for PO/PP/PF matrices).
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] THRESH
|
|
*> \verbatim
|
|
*> THRESH is DOUBLE PRECISION
|
|
*> The threshold value for the test ratios. A result is
|
|
*> included in the output file if RESULT >= THRESH. To have
|
|
*> every test ratio printed, use THRESH = 0.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] A
|
|
*> \verbatim
|
|
*> A is COMPLEX*16 array, dimension (NMAX*NMAX)
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] ASAV
|
|
*> \verbatim
|
|
*> ASAV is COMPLEX*16 array, dimension (NMAX*NMAX)
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] AFAC
|
|
*> \verbatim
|
|
*> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] AINV
|
|
*> \verbatim
|
|
*> AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] B
|
|
*> \verbatim
|
|
*> B is COMPLEX*16 array, dimension (NMAX*MAXRHS)
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] BSAV
|
|
*> \verbatim
|
|
*> BSAV is COMPLEX*16 array, dimension (NMAX*MAXRHS)
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] XACT
|
|
*> \verbatim
|
|
*> XACT is COMPLEX*16 array, dimension (NMAX*MAXRHS)
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] X
|
|
*> \verbatim
|
|
*> X is COMPLEX*16 array, dimension (NMAX*MAXRHS)
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] ARF
|
|
*> \verbatim
|
|
*> ARF is COMPLEX*16 array, dimension ((NMAX*(NMAX+1))/2)
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] ARFINV
|
|
*> \verbatim
|
|
*> ARFINV is COMPLEX*16 array, dimension ((NMAX*(NMAX+1))/2)
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] Z_WORK_ZLATMS
|
|
*> \verbatim
|
|
*> Z_WORK_ZLATMS is COMPLEX*16 array, dimension ( 3*NMAX )
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] Z_WORK_ZPOT02
|
|
*> \verbatim
|
|
*> Z_WORK_ZPOT02 is COMPLEX*16 array, dimension ( NMAX*MAXRHS )
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] Z_WORK_ZPOT03
|
|
*> \verbatim
|
|
*> Z_WORK_ZPOT03 is COMPLEX*16 array, dimension ( NMAX*NMAX )
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] D_WORK_ZLATMS
|
|
*> \verbatim
|
|
*> D_WORK_ZLATMS is DOUBLE PRECISION array, dimension ( NMAX )
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] D_WORK_ZLANHE
|
|
*> \verbatim
|
|
*> D_WORK_ZLANHE is DOUBLE PRECISION array, dimension ( NMAX )
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] D_WORK_ZPOT01
|
|
*> \verbatim
|
|
*> D_WORK_ZPOT01 is DOUBLE PRECISION array, dimension ( NMAX )
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] D_WORK_ZPOT02
|
|
*> \verbatim
|
|
*> D_WORK_ZPOT02 is DOUBLE PRECISION array, dimension ( NMAX )
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] D_WORK_ZPOT03
|
|
*> \verbatim
|
|
*> D_WORK_ZPOT03 is DOUBLE PRECISION array, dimension ( NMAX )
|
|
*> \endverbatim
|
|
*
|
|
* Authors:
|
|
* ========
|
|
*
|
|
*> \author Univ. of Tennessee
|
|
*> \author Univ. of California Berkeley
|
|
*> \author Univ. of Colorado Denver
|
|
*> \author NAG Ltd.
|
|
*
|
|
*> \ingroup complex16_lin
|
|
*
|
|
* =====================================================================
|
|
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 )
|
|
IMPLICIT NONE
|
|
*
|
|
* -- LAPACK test routine --
|
|
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
|
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
|
*
|
|
* .. Scalar Arguments ..
|
|
INTEGER NN, NNS, NNT, NOUT
|
|
DOUBLE PRECISION THRESH
|
|
* ..
|
|
* .. Array Arguments ..
|
|
INTEGER NVAL( NN ), NSVAL( NNS ), NTVAL( NNT )
|
|
COMPLEX*16 A( * )
|
|
COMPLEX*16 AINV( * )
|
|
COMPLEX*16 ASAV( * )
|
|
COMPLEX*16 B( * )
|
|
COMPLEX*16 BSAV( * )
|
|
COMPLEX*16 AFAC( * )
|
|
COMPLEX*16 ARF( * )
|
|
COMPLEX*16 ARFINV( * )
|
|
COMPLEX*16 XACT( * )
|
|
COMPLEX*16 X( * )
|
|
COMPLEX*16 Z_WORK_ZLATMS( * )
|
|
COMPLEX*16 Z_WORK_ZPOT02( * )
|
|
COMPLEX*16 Z_WORK_ZPOT03( * )
|
|
DOUBLE PRECISION D_WORK_ZLATMS( * )
|
|
DOUBLE PRECISION D_WORK_ZLANHE( * )
|
|
DOUBLE PRECISION D_WORK_ZPOT01( * )
|
|
DOUBLE PRECISION D_WORK_ZPOT02( * )
|
|
DOUBLE PRECISION D_WORK_ZPOT03( * )
|
|
* ..
|
|
*
|
|
* =====================================================================
|
|
*
|
|
* .. Parameters ..
|
|
DOUBLE PRECISION ZERO, ONE
|
|
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
|
|
INTEGER NTESTS
|
|
PARAMETER ( NTESTS = 4 )
|
|
* ..
|
|
* .. Local Scalars ..
|
|
LOGICAL ZEROT
|
|
INTEGER I, INFO, IUPLO, LDA, LDB, IMAT, NERRS, NFAIL,
|
|
+ NRHS, NRUN, IZERO, IOFF, K, NT, N, IFORM, IIN,
|
|
+ IIT, IIS
|
|
CHARACTER DIST, CTYPE, UPLO, CFORM
|
|
INTEGER KL, KU, MODE
|
|
DOUBLE PRECISION ANORM, AINVNM, CNDNUM, RCONDC
|
|
* ..
|
|
* .. Local Arrays ..
|
|
CHARACTER UPLOS( 2 ), FORMS( 2 )
|
|
INTEGER ISEED( 4 ), ISEEDY( 4 )
|
|
DOUBLE PRECISION RESULT( NTESTS )
|
|
* ..
|
|
* .. External Functions ..
|
|
DOUBLE PRECISION ZLANHE
|
|
EXTERNAL ZLANHE
|
|
* ..
|
|
* .. External Subroutines ..
|
|
EXTERNAL ALADHD, ALAERH, ALASVM, ZGET04, ZTFTTR, ZLACPY,
|
|
+ ZLAIPD, ZLARHS, ZLATB4, ZLATMS, ZPFTRI, ZPFTRF,
|
|
+ ZPFTRS, ZPOT01, ZPOT02, ZPOT03, ZPOTRI, ZPOTRF,
|
|
+ ZTRTTF
|
|
* ..
|
|
* .. Scalars in Common ..
|
|
CHARACTER*32 SRNAMT
|
|
* ..
|
|
* .. Common blocks ..
|
|
COMMON / SRNAMC / SRNAMT
|
|
* ..
|
|
* .. Data statements ..
|
|
DATA ISEEDY / 1988, 1989, 1990, 1991 /
|
|
DATA UPLOS / 'U', 'L' /
|
|
DATA FORMS / 'N', 'C' /
|
|
* ..
|
|
* .. Executable Statements ..
|
|
*
|
|
* Initialize constants and the random number seed.
|
|
*
|
|
NRUN = 0
|
|
NFAIL = 0
|
|
NERRS = 0
|
|
DO 10 I = 1, 4
|
|
ISEED( I ) = ISEEDY( I )
|
|
10 CONTINUE
|
|
*
|
|
DO 130 IIN = 1, NN
|
|
*
|
|
N = NVAL( IIN )
|
|
LDA = MAX( N, 1 )
|
|
LDB = MAX( N, 1 )
|
|
*
|
|
DO 980 IIS = 1, NNS
|
|
*
|
|
NRHS = NSVAL( IIS )
|
|
*
|
|
DO 120 IIT = 1, NNT
|
|
*
|
|
IMAT = NTVAL( IIT )
|
|
*
|
|
* If N.EQ.0, only consider the first type
|
|
*
|
|
IF( N.EQ.0 .AND. IIT.GE.1 ) GO TO 120
|
|
*
|
|
* Skip types 3, 4, or 5 if the matrix size is too small.
|
|
*
|
|
IF( IMAT.EQ.4 .AND. N.LE.1 ) GO TO 120
|
|
IF( IMAT.EQ.5 .AND. N.LE.2 ) GO TO 120
|
|
*
|
|
* Do first for UPLO = 'U', then for UPLO = 'L'
|
|
*
|
|
DO 110 IUPLO = 1, 2
|
|
UPLO = UPLOS( IUPLO )
|
|
*
|
|
* Do first for CFORM = 'N', then for CFORM = 'C'
|
|
*
|
|
DO 100 IFORM = 1, 2
|
|
CFORM = FORMS( IFORM )
|
|
*
|
|
* Set up parameters with ZLATB4 and generate a test
|
|
* matrix with ZLATMS.
|
|
*
|
|
CALL ZLATB4( 'ZPO', IMAT, N, N, CTYPE, KL, KU,
|
|
+ ANORM, MODE, CNDNUM, DIST )
|
|
*
|
|
SRNAMT = 'ZLATMS'
|
|
CALL ZLATMS( N, N, DIST, ISEED, CTYPE,
|
|
+ D_WORK_ZLATMS,
|
|
+ MODE, CNDNUM, ANORM, KL, KU, UPLO, A,
|
|
+ LDA, Z_WORK_ZLATMS, INFO )
|
|
*
|
|
* Check error code from ZLATMS.
|
|
*
|
|
IF( INFO.NE.0 ) THEN
|
|
CALL ALAERH( 'ZPF', 'ZLATMS', INFO, 0, UPLO, N,
|
|
+ N, -1, -1, -1, IIT, NFAIL, NERRS,
|
|
+ NOUT )
|
|
GO TO 100
|
|
END IF
|
|
*
|
|
* For types 3-5, zero one row and column of the matrix to
|
|
* test that INFO is returned correctly.
|
|
*
|
|
ZEROT = IMAT.GE.3 .AND. IMAT.LE.5
|
|
IF( ZEROT ) THEN
|
|
IF( IIT.EQ.3 ) THEN
|
|
IZERO = 1
|
|
ELSE IF( IIT.EQ.4 ) THEN
|
|
IZERO = N
|
|
ELSE
|
|
IZERO = N / 2 + 1
|
|
END IF
|
|
IOFF = ( IZERO-1 )*LDA
|
|
*
|
|
* Set row and column IZERO of A to 0.
|
|
*
|
|
IF( IUPLO.EQ.1 ) THEN
|
|
DO 20 I = 1, IZERO - 1
|
|
A( IOFF+I ) = ZERO
|
|
20 CONTINUE
|
|
IOFF = IOFF + IZERO
|
|
DO 30 I = IZERO, N
|
|
A( IOFF ) = ZERO
|
|
IOFF = IOFF + LDA
|
|
30 CONTINUE
|
|
ELSE
|
|
IOFF = IZERO
|
|
DO 40 I = 1, IZERO - 1
|
|
A( IOFF ) = ZERO
|
|
IOFF = IOFF + LDA
|
|
40 CONTINUE
|
|
IOFF = IOFF - IZERO
|
|
DO 50 I = IZERO, N
|
|
A( IOFF+I ) = ZERO
|
|
50 CONTINUE
|
|
END IF
|
|
ELSE
|
|
IZERO = 0
|
|
END IF
|
|
*
|
|
* Set the imaginary part of the diagonals.
|
|
*
|
|
CALL ZLAIPD( N, A, LDA+1, 0 )
|
|
*
|
|
* Save a copy of the matrix A in ASAV.
|
|
*
|
|
CALL ZLACPY( UPLO, N, N, A, LDA, ASAV, LDA )
|
|
*
|
|
* Compute the condition number of A (RCONDC).
|
|
*
|
|
IF( ZEROT ) THEN
|
|
RCONDC = ZERO
|
|
ELSE
|
|
*
|
|
* Compute the 1-norm of A.
|
|
*
|
|
ANORM = ZLANHE( '1', UPLO, N, A, LDA,
|
|
+ D_WORK_ZLANHE )
|
|
*
|
|
* Factor the matrix A.
|
|
*
|
|
CALL ZPOTRF( UPLO, N, A, LDA, INFO )
|
|
*
|
|
* Form the inverse of A.
|
|
*
|
|
CALL ZPOTRI( UPLO, N, A, LDA, INFO )
|
|
|
|
IF ( N .NE. 0 ) THEN
|
|
*
|
|
* Compute the 1-norm condition number of A.
|
|
*
|
|
AINVNM = ZLANHE( '1', UPLO, N, A, LDA,
|
|
+ D_WORK_ZLANHE )
|
|
RCONDC = ( ONE / ANORM ) / AINVNM
|
|
*
|
|
* Restore the matrix A.
|
|
*
|
|
CALL ZLACPY( UPLO, N, N, ASAV, LDA, A, LDA )
|
|
END IF
|
|
*
|
|
END IF
|
|
*
|
|
* Form an exact solution and set the right hand side.
|
|
*
|
|
SRNAMT = 'ZLARHS'
|
|
CALL ZLARHS( 'ZPO', 'N', UPLO, ' ', N, N, KL, KU,
|
|
+ NRHS, A, LDA, XACT, LDA, B, LDA,
|
|
+ ISEED, INFO )
|
|
CALL ZLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA )
|
|
*
|
|
* Compute the L*L' or U'*U factorization of the
|
|
* matrix and solve the system.
|
|
*
|
|
CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
|
|
CALL ZLACPY( 'Full', N, NRHS, B, LDB, X, LDB )
|
|
*
|
|
SRNAMT = 'ZTRTTF'
|
|
CALL ZTRTTF( CFORM, UPLO, N, AFAC, LDA, ARF, INFO )
|
|
SRNAMT = 'ZPFTRF'
|
|
CALL ZPFTRF( CFORM, UPLO, N, ARF, INFO )
|
|
*
|
|
* Check error code from ZPFTRF.
|
|
*
|
|
IF( INFO.NE.IZERO ) THEN
|
|
*
|
|
* LANGOU: there is a small hick here: IZERO should
|
|
* always be INFO however if INFO is ZERO, ALAERH does not
|
|
* complain.
|
|
*
|
|
CALL ALAERH( 'ZPF', 'ZPFSV ', INFO, IZERO,
|
|
+ UPLO, N, N, -1, -1, NRHS, IIT,
|
|
+ NFAIL, NERRS, NOUT )
|
|
GO TO 100
|
|
END IF
|
|
*
|
|
* Skip the tests if INFO is not 0.
|
|
*
|
|
IF( INFO.NE.0 ) THEN
|
|
GO TO 100
|
|
END IF
|
|
*
|
|
SRNAMT = 'ZPFTRS'
|
|
CALL ZPFTRS( CFORM, UPLO, N, NRHS, ARF, X, LDB,
|
|
+ INFO )
|
|
*
|
|
SRNAMT = 'ZTFTTR'
|
|
CALL ZTFTTR( CFORM, UPLO, N, ARF, AFAC, LDA, INFO )
|
|
*
|
|
* Reconstruct matrix from factors and compute
|
|
* residual.
|
|
*
|
|
CALL ZLACPY( UPLO, N, N, AFAC, LDA, ASAV, LDA )
|
|
CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA,
|
|
+ D_WORK_ZPOT01, RESULT( 1 ) )
|
|
CALL ZLACPY( UPLO, N, N, ASAV, LDA, AFAC, LDA )
|
|
*
|
|
* Form the inverse and compute the residual.
|
|
*
|
|
IF(MOD(N,2).EQ.0)THEN
|
|
CALL ZLACPY( 'A', N+1, N/2, ARF, N+1, ARFINV,
|
|
+ N+1 )
|
|
ELSE
|
|
CALL ZLACPY( 'A', N, (N+1)/2, ARF, N, ARFINV,
|
|
+ N )
|
|
END IF
|
|
*
|
|
SRNAMT = 'ZPFTRI'
|
|
CALL ZPFTRI( CFORM, UPLO, N, ARFINV , INFO )
|
|
*
|
|
SRNAMT = 'ZTFTTR'
|
|
CALL ZTFTTR( CFORM, UPLO, N, ARFINV, AINV, LDA,
|
|
+ INFO )
|
|
*
|
|
* Check error code from ZPFTRI.
|
|
*
|
|
IF( INFO.NE.0 )
|
|
+ CALL ALAERH( 'ZPO', 'ZPFTRI', INFO, 0, UPLO, N,
|
|
+ N, -1, -1, -1, IMAT, NFAIL, NERRS,
|
|
+ NOUT )
|
|
*
|
|
CALL ZPOT03( UPLO, N, A, LDA, AINV, LDA,
|
|
+ Z_WORK_ZPOT03, LDA, D_WORK_ZPOT03,
|
|
+ RCONDC, RESULT( 2 ) )
|
|
*
|
|
* Compute residual of the computed solution.
|
|
*
|
|
CALL ZLACPY( 'Full', N, NRHS, B, LDA,
|
|
+ Z_WORK_ZPOT02, LDA )
|
|
CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
|
|
+ Z_WORK_ZPOT02, LDA, D_WORK_ZPOT02,
|
|
+ RESULT( 3 ) )
|
|
*
|
|
* Check solution from generated exact solution.
|
|
*
|
|
CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
|
|
+ RESULT( 4 ) )
|
|
NT = 4
|
|
*
|
|
* Print information about the tests that did not
|
|
* pass the threshold.
|
|
*
|
|
DO 60 K = 1, NT
|
|
IF( RESULT( K ).GE.THRESH ) THEN
|
|
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
|
+ CALL ALADHD( NOUT, 'ZPF' )
|
|
WRITE( NOUT, FMT = 9999 )'ZPFSV ', UPLO,
|
|
+ N, IIT, K, RESULT( K )
|
|
NFAIL = NFAIL + 1
|
|
END IF
|
|
60 CONTINUE
|
|
NRUN = NRUN + NT
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
120 CONTINUE
|
|
980 CONTINUE
|
|
130 CONTINUE
|
|
*
|
|
* Print a summary of the results.
|
|
*
|
|
CALL ALASVM( 'ZPF', NOUT, NFAIL, NRUN, NERRS )
|
|
*
|
|
9999 FORMAT( 1X, A6, ', UPLO=''', A1, ''', N =', I5, ', type ', I1,
|
|
+ ', test(', I1, ')=', G12.5 )
|
|
*
|
|
RETURN
|
|
*
|
|
* End of ZDRVRFP
|
|
*
|
|
END
|