1*> \brief \b CTRT03 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 CTRT03( UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, 12* CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID ) 13* 14* .. Scalar Arguments .. 15* CHARACTER DIAG, TRANS, UPLO 16* INTEGER LDA, LDB, LDX, N, NRHS 17* REAL RESID, SCALE, TSCAL 18* .. 19* .. Array Arguments .. 20* REAL CNORM( * ) 21* COMPLEX A( LDA, * ), B( LDB, * ), WORK( * ), 22* $ X( LDX, * ) 23* .. 24* 25* 26*> \par Purpose: 27* ============= 28*> 29*> \verbatim 30*> 31*> CTRT03 computes the residual for the solution to a scaled triangular 32*> system of equations A*x = s*b, A**T *x = s*b, or A**H *x = s*b. 33*> Here A is a triangular matrix, A**T denotes the transpose of A, A**H 34*> denotes the conjugate transpose of A, s is a scalar, and x and b are 35*> N by NRHS matrices. The test ratio is the maximum over the number of 36*> right hand sides of 37*> norm(s*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 = s*b (No transpose) 57*> = 'T': A**T *x = s*b (Transpose) 58*> = 'C': A**H *x = s*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] A 83*> \verbatim 84*> A is COMPLEX array, dimension (LDA,N) 85*> The triangular matrix A. If UPLO = 'U', the leading n by n 86*> upper triangular part of the array A contains the upper 87*> triangular matrix, and the strictly lower triangular part of 88*> A is not referenced. If UPLO = 'L', the leading n by n lower 89*> triangular part of the array A contains the lower triangular 90*> matrix, and the strictly upper triangular part of A is not 91*> referenced. If DIAG = 'U', the diagonal elements of A are 92*> also not referenced and are assumed to be 1. 93*> \endverbatim 94*> 95*> \param[in] LDA 96*> \verbatim 97*> LDA is INTEGER 98*> The leading dimension of the array A. LDA >= max(1,N). 99*> \endverbatim 100*> 101*> \param[in] SCALE 102*> \verbatim 103*> SCALE is REAL 104*> The scaling factor s used in solving the triangular system. 105*> \endverbatim 106*> 107*> \param[in] CNORM 108*> \verbatim 109*> CNORM is REAL array, dimension (N) 110*> The 1-norms of the columns of A, not counting the diagonal. 111*> \endverbatim 112*> 113*> \param[in] TSCAL 114*> \verbatim 115*> TSCAL is REAL 116*> The scaling factor used in computing the 1-norms in CNORM. 117*> CNORM actually contains the column norms of TSCAL*A. 118*> \endverbatim 119*> 120*> \param[in] X 121*> \verbatim 122*> X is COMPLEX array, dimension (LDX,NRHS) 123*> The computed solution vectors for the system of linear 124*> equations. 125*> \endverbatim 126*> 127*> \param[in] LDX 128*> \verbatim 129*> LDX is INTEGER 130*> The leading dimension of the array X. LDX >= max(1,N). 131*> \endverbatim 132*> 133*> \param[in] B 134*> \verbatim 135*> B is COMPLEX array, dimension (LDB,NRHS) 136*> The right hand side vectors for the system of linear 137*> equations. 138*> \endverbatim 139*> 140*> \param[in] LDB 141*> \verbatim 142*> LDB is INTEGER 143*> The leading dimension of the array B. LDB >= max(1,N). 144*> \endverbatim 145*> 146*> \param[out] WORK 147*> \verbatim 148*> WORK is COMPLEX array, dimension (N) 149*> \endverbatim 150*> 151*> \param[out] RESID 152*> \verbatim 153*> RESID is REAL 154*> The maximum over the number of right hand sides of 155*> norm(op(A)*x - s*b) / ( norm(op(A)) * norm(x) * EPS ). 156*> \endverbatim 157* 158* Authors: 159* ======== 160* 161*> \author Univ. of Tennessee 162*> \author Univ. of California Berkeley 163*> \author Univ. of Colorado Denver 164*> \author NAG Ltd. 165* 166*> \date November 2011 167* 168*> \ingroup complex_lin 169* 170* ===================================================================== 171 SUBROUTINE CTRT03( UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, 172 $ CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID ) 173* 174* -- LAPACK test routine (version 3.4.0) -- 175* -- LAPACK is a software package provided by Univ. of Tennessee, -- 176* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 177* November 2011 178* 179* .. Scalar Arguments .. 180 CHARACTER DIAG, TRANS, UPLO 181 INTEGER LDA, LDB, LDX, N, NRHS 182 REAL RESID, SCALE, TSCAL 183* .. 184* .. Array Arguments .. 185 REAL CNORM( * ) 186 COMPLEX A( LDA, * ), B( LDB, * ), WORK( * ), 187 $ X( LDX, * ) 188* .. 189* 190* ===================================================================== 191* 192* .. Parameters .. 193 REAL ONE, ZERO 194 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 195* .. 196* .. Local Scalars .. 197 INTEGER IX, J 198 REAL EPS, ERR, SMLNUM, TNORM, XNORM, XSCAL 199* .. 200* .. External Functions .. 201 LOGICAL LSAME 202 INTEGER ICAMAX 203 REAL SLAMCH 204 EXTERNAL LSAME, ICAMAX, SLAMCH 205* .. 206* .. External Subroutines .. 207 EXTERNAL CAXPY, CCOPY, CSSCAL, CTRMV 208* .. 209* .. Intrinsic Functions .. 210 INTRINSIC ABS, CMPLX, MAX, REAL 211* .. 212* .. Executable Statements .. 213* 214* Quick exit if N = 0 215* 216 IF( N.LE.0 .OR. NRHS.LE.0 ) THEN 217 RESID = ZERO 218 RETURN 219 END IF 220 EPS = SLAMCH( 'Epsilon' ) 221 SMLNUM = SLAMCH( 'Safe minimum' ) 222* 223* Compute the norm of the triangular matrix A using the column 224* norms already computed by CLATRS. 225* 226 TNORM = ZERO 227 IF( LSAME( DIAG, 'N' ) ) THEN 228 DO 10 J = 1, N 229 TNORM = MAX( TNORM, TSCAL*ABS( A( J, J ) )+CNORM( J ) ) 230 10 CONTINUE 231 ELSE 232 DO 20 J = 1, N 233 TNORM = MAX( TNORM, TSCAL+CNORM( J ) ) 234 20 CONTINUE 235 END IF 236* 237* Compute the maximum over the number of right hand sides of 238* norm(op(A)*x - s*b) / ( norm(op(A)) * norm(x) * EPS ). 239* 240 RESID = ZERO 241 DO 30 J = 1, NRHS 242 CALL CCOPY( N, X( 1, J ), 1, WORK, 1 ) 243 IX = ICAMAX( N, WORK, 1 ) 244 XNORM = MAX( ONE, ABS( X( IX, J ) ) ) 245 XSCAL = ( ONE / XNORM ) / REAL( N ) 246 CALL CSSCAL( N, XSCAL, WORK, 1 ) 247 CALL CTRMV( UPLO, TRANS, DIAG, N, A, LDA, WORK, 1 ) 248 CALL CAXPY( N, CMPLX( -SCALE*XSCAL ), B( 1, J ), 1, WORK, 1 ) 249 IX = ICAMAX( N, WORK, 1 ) 250 ERR = TSCAL*ABS( WORK( IX ) ) 251 IX = ICAMAX( N, X( 1, J ), 1 ) 252 XNORM = ABS( X( IX, J ) ) 253 IF( ERR*SMLNUM.LE.XNORM ) THEN 254 IF( XNORM.GT.ZERO ) 255 $ ERR = ERR / XNORM 256 ELSE 257 IF( ERR.GT.ZERO ) 258 $ ERR = ONE / EPS 259 END IF 260 IF( ERR*SMLNUM.LE.TNORM ) THEN 261 IF( TNORM.GT.ZERO ) 262 $ ERR = ERR / TNORM 263 ELSE 264 IF( ERR.GT.ZERO ) 265 $ ERR = ONE / EPS 266 END IF 267 RESID = MAX( RESID, ERR ) 268 30 CONTINUE 269* 270 RETURN 271* 272* End of CTRT03 273* 274 END 275