1*> \brief \b CTBT03 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 CTBT03( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, 12* SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, 13* RESID ) 14* 15* .. Scalar Arguments .. 16* CHARACTER DIAG, TRANS, UPLO 17* INTEGER KD, LDAB, LDB, LDX, N, NRHS 18* REAL RESID, SCALE, TSCAL 19* .. 20* .. Array Arguments .. 21* REAL CNORM( * ) 22* COMPLEX AB( LDAB, * ), B( LDB, * ), WORK( * ), 23* $ X( LDX, * ) 24* .. 25* 26* 27*> \par Purpose: 28* ============= 29*> 30*> \verbatim 31*> 32*> CTBT03 computes the residual for the solution to a scaled triangular 33*> system of equations A*x = s*b, A**T *x = s*b, or A**H *x = s*b 34*> when A is a triangular band matrix. Here A**T denotes the transpose 35*> of A, A**H denotes the conjugate transpose of A, s is a scalar, and 36*> x and b are N by NRHS matrices. The test ratio is the maximum over 37*> the number of right hand sides of 38*> norm(s*b - op(A)*x) / ( norm(op(A)) * norm(x) * EPS ), 39*> where op(A) denotes A, A**T, or A**H, and EPS is the machine epsilon. 40*> \endverbatim 41* 42* Arguments: 43* ========== 44* 45*> \param[in] UPLO 46*> \verbatim 47*> UPLO is CHARACTER*1 48*> Specifies whether the matrix A is upper or lower triangular. 49*> = 'U': Upper triangular 50*> = 'L': Lower triangular 51*> \endverbatim 52*> 53*> \param[in] TRANS 54*> \verbatim 55*> TRANS is CHARACTER*1 56*> Specifies the operation applied to A. 57*> = 'N': A *x = s*b (No transpose) 58*> = 'T': A**T *x = s*b (Transpose) 59*> = 'C': A**H *x = s*b (Conjugate transpose) 60*> \endverbatim 61*> 62*> \param[in] DIAG 63*> \verbatim 64*> DIAG is CHARACTER*1 65*> Specifies whether or not the matrix A is unit triangular. 66*> = 'N': Non-unit triangular 67*> = 'U': Unit triangular 68*> \endverbatim 69*> 70*> \param[in] N 71*> \verbatim 72*> N is INTEGER 73*> The order of the matrix A. N >= 0. 74*> \endverbatim 75*> 76*> \param[in] KD 77*> \verbatim 78*> KD is INTEGER 79*> The number of superdiagonals or subdiagonals of the 80*> triangular band matrix A. KD >= 0. 81*> \endverbatim 82*> 83*> \param[in] NRHS 84*> \verbatim 85*> NRHS is INTEGER 86*> The number of right hand sides, i.e., the number of columns 87*> of the matrices X and B. NRHS >= 0. 88*> \endverbatim 89*> 90*> \param[in] AB 91*> \verbatim 92*> AB is COMPLEX array, dimension (LDAB,N) 93*> The upper or lower triangular band matrix A, stored in the 94*> first kd+1 rows of the array. The j-th column of A is stored 95*> in the j-th column of the array AB as follows: 96*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j; 97*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd). 98*> \endverbatim 99*> 100*> \param[in] LDAB 101*> \verbatim 102*> LDAB is INTEGER 103*> The leading dimension of the array AB. LDAB >= KD+1. 104*> \endverbatim 105*> 106*> \param[in] SCALE 107*> \verbatim 108*> SCALE is REAL 109*> The scaling factor s used in solving the triangular system. 110*> \endverbatim 111*> 112*> \param[in] CNORM 113*> \verbatim 114*> CNORM is REAL array, dimension (N) 115*> The 1-norms of the columns of A, not counting the diagonal. 116*> \endverbatim 117*> 118*> \param[in] TSCAL 119*> \verbatim 120*> TSCAL is REAL 121*> The scaling factor used in computing the 1-norms in CNORM. 122*> CNORM actually contains the column norms of TSCAL*A. 123*> \endverbatim 124*> 125*> \param[in] X 126*> \verbatim 127*> X is COMPLEX array, dimension (LDX,NRHS) 128*> The computed solution vectors for the system of linear 129*> equations. 130*> \endverbatim 131*> 132*> \param[in] LDX 133*> \verbatim 134*> LDX is INTEGER 135*> The leading dimension of the array X. LDX >= max(1,N). 136*> \endverbatim 137*> 138*> \param[in] B 139*> \verbatim 140*> B is COMPLEX array, dimension (LDB,NRHS) 141*> The right hand side vectors for the system of linear 142*> equations. 143*> \endverbatim 144*> 145*> \param[in] LDB 146*> \verbatim 147*> LDB is INTEGER 148*> The leading dimension of the array B. LDB >= max(1,N). 149*> \endverbatim 150*> 151*> \param[out] WORK 152*> \verbatim 153*> WORK is COMPLEX array, dimension (N) 154*> \endverbatim 155*> 156*> \param[out] RESID 157*> \verbatim 158*> RESID is REAL 159*> The maximum over the number of right hand sides of 160*> norm(op(A)*x - s*b) / ( norm(op(A)) * norm(x) * EPS ). 161*> \endverbatim 162* 163* Authors: 164* ======== 165* 166*> \author Univ. of Tennessee 167*> \author Univ. of California Berkeley 168*> \author Univ. of Colorado Denver 169*> \author NAG Ltd. 170* 171*> \ingroup complex_lin 172* 173* ===================================================================== 174 SUBROUTINE CTBT03( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, 175 $ SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, 176 $ RESID ) 177* 178* -- LAPACK test routine -- 179* -- LAPACK is a software package provided by Univ. of Tennessee, -- 180* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 181* 182* .. Scalar Arguments .. 183 CHARACTER DIAG, TRANS, UPLO 184 INTEGER KD, LDAB, LDB, LDX, N, NRHS 185 REAL RESID, SCALE, TSCAL 186* .. 187* .. Array Arguments .. 188 REAL CNORM( * ) 189 COMPLEX AB( LDAB, * ), B( LDB, * ), WORK( * ), 190 $ X( LDX, * ) 191* .. 192* 193* ===================================================================== 194* 195* 196* .. Parameters .. 197 REAL ONE, ZERO 198 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 199* .. 200* .. Local Scalars .. 201 INTEGER IX, J 202 REAL EPS, ERR, SMLNUM, TNORM, XNORM, XSCAL 203* .. 204* .. External Functions .. 205 LOGICAL LSAME 206 INTEGER ICAMAX 207 REAL SLAMCH 208 EXTERNAL LSAME, ICAMAX, SLAMCH 209* .. 210* .. External Subroutines .. 211 EXTERNAL CAXPY, CCOPY, CSSCAL, CTBMV 212* .. 213* .. Intrinsic Functions .. 214 INTRINSIC ABS, CMPLX, MAX, REAL 215* .. 216* .. Executable Statements .. 217* 218* Quick exit if N = 0 219* 220 IF( N.LE.0 .OR. NRHS.LE.0 ) THEN 221 RESID = ZERO 222 RETURN 223 END IF 224 EPS = SLAMCH( 'Epsilon' ) 225 SMLNUM = SLAMCH( 'Safe minimum' ) 226* 227* Compute the norm of the triangular matrix A using the column 228* norms already computed by CLATBS. 229* 230 TNORM = ZERO 231 IF( LSAME( DIAG, 'N' ) ) THEN 232 IF( LSAME( UPLO, 'U' ) ) THEN 233 DO 10 J = 1, N 234 TNORM = MAX( TNORM, TSCAL*ABS( AB( KD+1, J ) )+ 235 $ CNORM( J ) ) 236 10 CONTINUE 237 ELSE 238 DO 20 J = 1, N 239 TNORM = MAX( TNORM, TSCAL*ABS( AB( 1, J ) )+CNORM( J ) ) 240 20 CONTINUE 241 END IF 242 ELSE 243 DO 30 J = 1, N 244 TNORM = MAX( TNORM, TSCAL+CNORM( J ) ) 245 30 CONTINUE 246 END IF 247* 248* Compute the maximum over the number of right hand sides of 249* norm(op(A)*x - s*b) / ( norm(op(A)) * norm(x) * EPS ). 250* 251 RESID = ZERO 252 DO 40 J = 1, NRHS 253 CALL CCOPY( N, X( 1, J ), 1, WORK, 1 ) 254 IX = ICAMAX( N, WORK, 1 ) 255 XNORM = MAX( ONE, ABS( X( IX, J ) ) ) 256 XSCAL = ( ONE / XNORM ) / REAL( KD+1 ) 257 CALL CSSCAL( N, XSCAL, WORK, 1 ) 258 CALL CTBMV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, WORK, 1 ) 259 CALL CAXPY( N, CMPLX( -SCALE*XSCAL ), B( 1, J ), 1, WORK, 1 ) 260 IX = ICAMAX( N, WORK, 1 ) 261 ERR = TSCAL*ABS( WORK( IX ) ) 262 IX = ICAMAX( N, X( 1, J ), 1 ) 263 XNORM = ABS( X( IX, J ) ) 264 IF( ERR*SMLNUM.LE.XNORM ) THEN 265 IF( XNORM.GT.ZERO ) 266 $ ERR = ERR / XNORM 267 ELSE 268 IF( ERR.GT.ZERO ) 269 $ ERR = ONE / EPS 270 END IF 271 IF( ERR*SMLNUM.LE.TNORM ) THEN 272 IF( TNORM.GT.ZERO ) 273 $ ERR = ERR / TNORM 274 ELSE 275 IF( ERR.GT.ZERO ) 276 $ ERR = ONE / EPS 277 END IF 278 RESID = MAX( RESID, ERR ) 279 40 CONTINUE 280* 281 RETURN 282* 283* End of CTBT03 284* 285 END 286