1*> \brief \b ZTPT02 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 ZTPT02( 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* DOUBLE PRECISION RESID 18* .. 19* .. Array Arguments .. 20* DOUBLE PRECISION RWORK( * ) 21* COMPLEX*16 AP( * ), B( LDB, * ), WORK( * ), X( LDX, * ) 22* .. 23* 24* 25*> \par Purpose: 26* ============= 27*> 28*> \verbatim 29*> 30*> ZTPT02 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*16 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*16 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*16 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*16 array, dimension (N) 122*> \endverbatim 123*> 124*> \param[out] RWORK 125*> \verbatim 126*> RWORK is DOUBLE PRECISION array, dimension (N) 127*> \endverbatim 128*> 129*> \param[out] RESID 130*> \verbatim 131*> RESID is DOUBLE PRECISION 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*> \ingroup complex16_lin 145* 146* ===================================================================== 147 SUBROUTINE ZTPT02( UPLO, TRANS, DIAG, N, NRHS, AP, X, LDX, B, LDB, 148 $ WORK, RWORK, RESID ) 149* 150* -- LAPACK test routine -- 151* -- LAPACK is a software package provided by Univ. of Tennessee, -- 152* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 153* 154* .. Scalar Arguments .. 155 CHARACTER DIAG, TRANS, UPLO 156 INTEGER LDB, LDX, N, NRHS 157 DOUBLE PRECISION RESID 158* .. 159* .. Array Arguments .. 160 DOUBLE PRECISION RWORK( * ) 161 COMPLEX*16 AP( * ), B( LDB, * ), WORK( * ), X( LDX, * ) 162* .. 163* 164* ===================================================================== 165* 166* .. Parameters .. 167 DOUBLE PRECISION ZERO, ONE 168 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 169* .. 170* .. Local Scalars .. 171 INTEGER J 172 DOUBLE PRECISION ANORM, BNORM, EPS, XNORM 173* .. 174* .. External Functions .. 175 LOGICAL LSAME 176 DOUBLE PRECISION DLAMCH, DZASUM, ZLANTP 177 EXTERNAL LSAME, DLAMCH, DZASUM, ZLANTP 178* .. 179* .. External Subroutines .. 180 EXTERNAL ZAXPY, ZCOPY, ZTPMV 181* .. 182* .. Intrinsic Functions .. 183 INTRINSIC DCMPLX, MAX 184* .. 185* .. Executable Statements .. 186* 187* Quick exit if N = 0 or NRHS = 0 188* 189 IF( N.LE.0 .OR. NRHS.LE.0 ) THEN 190 RESID = ZERO 191 RETURN 192 END IF 193* 194* Compute the 1-norm of A or A**H. 195* 196 IF( LSAME( TRANS, 'N' ) ) THEN 197 ANORM = ZLANTP( '1', UPLO, DIAG, N, AP, RWORK ) 198 ELSE 199 ANORM = ZLANTP( 'I', UPLO, DIAG, N, AP, RWORK ) 200 END IF 201* 202* Exit with RESID = 1/EPS if ANORM = 0. 203* 204 EPS = DLAMCH( 'Epsilon' ) 205 IF( ANORM.LE.ZERO ) THEN 206 RESID = ONE / EPS 207 RETURN 208 END IF 209* 210* Compute the maximum over the number of right hand sides of 211* norm(op(A)*x - b) / ( norm(op(A)) * norm(x) * EPS ). 212* 213 RESID = ZERO 214 DO 10 J = 1, NRHS 215 CALL ZCOPY( N, X( 1, J ), 1, WORK, 1 ) 216 CALL ZTPMV( UPLO, TRANS, DIAG, N, AP, WORK, 1 ) 217 CALL ZAXPY( N, DCMPLX( -ONE ), B( 1, J ), 1, WORK, 1 ) 218 BNORM = DZASUM( N, WORK, 1 ) 219 XNORM = DZASUM( N, X( 1, J ), 1 ) 220 IF( XNORM.LE.ZERO ) THEN 221 RESID = ONE / EPS 222 ELSE 223 RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS ) 224 END IF 225 10 CONTINUE 226* 227 RETURN 228* 229* End of ZTPT02 230* 231 END 232