1*> \brief \b CTPT02 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE CTPT02( UPLO, TRANS, DIAG, N, NRHS, AP, X, LDX, B, LDB, 12* WORK, RWORK, RESID ) 13* 14* .. Scalar Arguments .. 15* CHARACTER DIAG, TRANS, UPLO 16* INTEGER LDB, LDX, N, NRHS 17* REAL RESID 18* .. 19* .. Array Arguments .. 20* REAL RWORK( * ) 21* COMPLEX AP( * ), B( LDB, * ), WORK( * ), X( LDX, * ) 22* .. 23* 24* 25*> \par Purpose: 26* ============= 27*> 28*> \verbatim 29*> 30*> CTPT02 computes the residual for the computed solution to a 31*> triangular system of linear equations A*x = b, A**T *x = b, or 32*> A**H *x = b, when the triangular matrix A is stored in packed format. 33*> Here A**T denotes the transpose of A, A**H denotes the conjugate 34*> transpose of A, and x and b are N by NRHS matrices. The test ratio 35*> is the maximum over the number of right hand sides of 36*> the maximum over the number of right hand sides of 37*> norm(b - op(A)*x) / ( norm(op(A)) * norm(x) * EPS ), 38*> where op(A) denotes A, A**T, or A**H, and EPS is the machine epsilon. 39*> \endverbatim 40* 41* Arguments: 42* ========== 43* 44*> \param[in] UPLO 45*> \verbatim 46*> UPLO is CHARACTER*1 47*> Specifies whether the matrix A is upper or lower triangular. 48*> = 'U': Upper triangular 49*> = 'L': Lower triangular 50*> \endverbatim 51*> 52*> \param[in] TRANS 53*> \verbatim 54*> TRANS is CHARACTER*1 55*> Specifies the operation applied to A. 56*> = 'N': A *x = b (No transpose) 57*> = 'T': A**T *x = b (Transpose) 58*> = 'C': A**H *x = b (Conjugate transpose) 59*> \endverbatim 60*> 61*> \param[in] DIAG 62*> \verbatim 63*> DIAG is CHARACTER*1 64*> Specifies whether or not the matrix A is unit triangular. 65*> = 'N': Non-unit triangular 66*> = 'U': Unit triangular 67*> \endverbatim 68*> 69*> \param[in] N 70*> \verbatim 71*> N is INTEGER 72*> The order of the matrix A. N >= 0. 73*> \endverbatim 74*> 75*> \param[in] NRHS 76*> \verbatim 77*> NRHS is INTEGER 78*> The number of right hand sides, i.e., the number of columns 79*> of the matrices X and B. NRHS >= 0. 80*> \endverbatim 81*> 82*> \param[in] AP 83*> \verbatim 84*> AP is COMPLEX array, dimension (N*(N+1)/2) 85*> The upper or lower triangular matrix A, packed columnwise in 86*> a linear array. The j-th column of A is stored in the array 87*> AP as follows: 88*> if UPLO = 'U', AP((j-1)*j/2 + i) = A(i,j) for 1<=i<=j; 89*> if UPLO = 'L', 90*> AP((j-1)*(n-j) + j*(j+1)/2 + i-j) = A(i,j) for j<=i<=n. 91*> \endverbatim 92*> 93*> \param[in] X 94*> \verbatim 95*> X is COMPLEX array, dimension (LDX,NRHS) 96*> The computed solution vectors for the system of linear 97*> equations. 98*> \endverbatim 99*> 100*> \param[in] LDX 101*> \verbatim 102*> LDX is INTEGER 103*> The leading dimension of the array X. LDX >= max(1,N). 104*> \endverbatim 105*> 106*> \param[in] B 107*> \verbatim 108*> B is COMPLEX array, dimension (LDB,NRHS) 109*> The right hand side vectors for the system of linear 110*> equations. 111*> \endverbatim 112*> 113*> \param[in] LDB 114*> \verbatim 115*> LDB is INTEGER 116*> The leading dimension of the array B. LDB >= max(1,N). 117*> \endverbatim 118*> 119*> \param[out] WORK 120*> \verbatim 121*> WORK is COMPLEX array, dimension (N) 122*> \endverbatim 123*> 124*> \param[out] RWORK 125*> \verbatim 126*> RWORK is REAL array, dimension (N) 127*> \endverbatim 128*> 129*> \param[out] RESID 130*> \verbatim 131*> RESID is REAL 132*> The maximum over the number of right hand sides of 133*> norm(op(A)*x - b) / ( norm(op(A)) * norm(x) * EPS ). 134*> \endverbatim 135* 136* Authors: 137* ======== 138* 139*> \author Univ. of Tennessee 140*> \author Univ. of California Berkeley 141*> \author Univ. of Colorado Denver 142*> \author NAG Ltd. 143* 144*> \date November 2011 145* 146*> \ingroup complex_lin 147* 148* ===================================================================== 149 SUBROUTINE CTPT02( UPLO, TRANS, DIAG, N, NRHS, AP, X, LDX, B, LDB, 150 $ WORK, RWORK, RESID ) 151* 152* -- LAPACK test routine (version 3.4.0) -- 153* -- LAPACK is a software package provided by Univ. of Tennessee, -- 154* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 155* November 2011 156* 157* .. Scalar Arguments .. 158 CHARACTER DIAG, TRANS, UPLO 159 INTEGER LDB, LDX, N, NRHS 160 REAL RESID 161* .. 162* .. Array Arguments .. 163 REAL RWORK( * ) 164 COMPLEX AP( * ), B( LDB, * ), WORK( * ), X( LDX, * ) 165* .. 166* 167* ===================================================================== 168* 169* .. Parameters .. 170 REAL ZERO, ONE 171 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 172* .. 173* .. Local Scalars .. 174 INTEGER J 175 REAL ANORM, BNORM, EPS, XNORM 176* .. 177* .. External Functions .. 178 LOGICAL LSAME 179 REAL CLANTP, SCASUM, SLAMCH 180 EXTERNAL LSAME, CLANTP, SCASUM, SLAMCH 181* .. 182* .. External Subroutines .. 183 EXTERNAL CAXPY, CCOPY, CTPMV 184* .. 185* .. Intrinsic Functions .. 186 INTRINSIC CMPLX, MAX 187* .. 188* .. Executable Statements .. 189* 190* Quick exit if N = 0 or NRHS = 0 191* 192 IF( N.LE.0 .OR. NRHS.LE.0 ) THEN 193 RESID = ZERO 194 RETURN 195 END IF 196* 197* Compute the 1-norm of A or A**H. 198* 199 IF( LSAME( TRANS, 'N' ) ) THEN 200 ANORM = CLANTP( '1', UPLO, DIAG, N, AP, RWORK ) 201 ELSE 202 ANORM = CLANTP( 'I', UPLO, DIAG, N, AP, RWORK ) 203 END IF 204* 205* Exit with RESID = 1/EPS if ANORM = 0. 206* 207 EPS = SLAMCH( 'Epsilon' ) 208 IF( ANORM.LE.ZERO ) THEN 209 RESID = ONE / EPS 210 RETURN 211 END IF 212* 213* Compute the maximum over the number of right hand sides of 214* norm(op(A)*x - b) / ( norm(op(A)) * norm(x) * EPS ). 215* 216 RESID = ZERO 217 DO 10 J = 1, NRHS 218 CALL CCOPY( N, X( 1, J ), 1, WORK, 1 ) 219 CALL CTPMV( UPLO, TRANS, DIAG, N, AP, WORK, 1 ) 220 CALL CAXPY( N, CMPLX( -ONE ), B( 1, J ), 1, WORK, 1 ) 221 BNORM = SCASUM( N, WORK, 1 ) 222 XNORM = SCASUM( N, X( 1, J ), 1 ) 223 IF( XNORM.LE.ZERO ) THEN 224 RESID = ONE / EPS 225 ELSE 226 RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS ) 227 END IF 228 10 CONTINUE 229* 230 RETURN 231* 232* End of CTPT02 233* 234 END 235