![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b STBT02 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE STBT02( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, X, 00012 * LDX, B, LDB, WORK, RESID ) 00013 * 00014 * .. Scalar Arguments .. 00015 * CHARACTER DIAG, TRANS, UPLO 00016 * INTEGER KD, LDAB, LDB, LDX, N, NRHS 00017 * REAL RESID 00018 * .. 00019 * .. Array Arguments .. 00020 * REAL AB( LDAB, * ), B( LDB, * ), WORK( * ), 00021 * $ X( LDX, * ) 00022 * .. 00023 * 00024 * 00025 *> \par Purpose: 00026 * ============= 00027 *> 00028 *> \verbatim 00029 *> 00030 *> STBT02 computes the residual for the computed solution to a 00031 *> triangular system of linear equations A*x = b or A' *x = b when 00032 *> A is a triangular band matrix. Here A' is the transpose of A and 00033 *> x and b are N by NRHS matrices. The test ratio is the maximum over 00034 *> the number of right hand sides of 00035 *> norm(b - op(A)*x) / ( norm(op(A)) * norm(x) * EPS ), 00036 *> where op(A) denotes A or A' and EPS is the machine epsilon. 00037 *> \endverbatim 00038 * 00039 * Arguments: 00040 * ========== 00041 * 00042 *> \param[in] UPLO 00043 *> \verbatim 00044 *> UPLO is CHARACTER*1 00045 *> Specifies whether the matrix A is upper or lower triangular. 00046 *> = 'U': Upper triangular 00047 *> = 'L': Lower triangular 00048 *> \endverbatim 00049 *> 00050 *> \param[in] TRANS 00051 *> \verbatim 00052 *> TRANS is CHARACTER*1 00053 *> Specifies the operation applied to A. 00054 *> = 'N': A *x = b (No transpose) 00055 *> = 'T': A'*x = b (Transpose) 00056 *> = 'C': A'*x = b (Conjugate transpose = Transpose) 00057 *> \endverbatim 00058 *> 00059 *> \param[in] DIAG 00060 *> \verbatim 00061 *> DIAG is CHARACTER*1 00062 *> Specifies whether or not the matrix A is unit triangular. 00063 *> = 'N': Non-unit triangular 00064 *> = 'U': Unit triangular 00065 *> \endverbatim 00066 *> 00067 *> \param[in] N 00068 *> \verbatim 00069 *> N is INTEGER 00070 *> The order of the matrix A. N >= 0. 00071 *> \endverbatim 00072 *> 00073 *> \param[in] KD 00074 *> \verbatim 00075 *> KD is INTEGER 00076 *> The number of superdiagonals or subdiagonals of the 00077 *> triangular band matrix A. KD >= 0. 00078 *> \endverbatim 00079 *> 00080 *> \param[in] NRHS 00081 *> \verbatim 00082 *> NRHS is INTEGER 00083 *> The number of right hand sides, i.e., the number of columns 00084 *> of the matrices X and B. NRHS >= 0. 00085 *> \endverbatim 00086 *> 00087 *> \param[in] AB 00088 *> \verbatim 00089 *> AB is REAL array, dimension (LDAB,N) 00090 *> The upper or lower triangular band matrix A, stored in the 00091 *> first kd+1 rows of the array. The j-th column of A is stored 00092 *> in the j-th column of the array AB as follows: 00093 *> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j; 00094 *> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd). 00095 *> \endverbatim 00096 *> 00097 *> \param[in] LDAB 00098 *> \verbatim 00099 *> LDAB is INTEGER 00100 *> The leading dimension of the array AB. LDAB >= KD+1. 00101 *> \endverbatim 00102 *> 00103 *> \param[in] X 00104 *> \verbatim 00105 *> X is REAL array, dimension (LDX,NRHS) 00106 *> The computed solution vectors for the system of linear 00107 *> equations. 00108 *> \endverbatim 00109 *> 00110 *> \param[in] LDX 00111 *> \verbatim 00112 *> LDX is INTEGER 00113 *> The leading dimension of the array X. LDX >= max(1,N). 00114 *> \endverbatim 00115 *> 00116 *> \param[in] B 00117 *> \verbatim 00118 *> B is REAL array, dimension (LDB,NRHS) 00119 *> The right hand side vectors for the system of linear 00120 *> equations. 00121 *> \endverbatim 00122 *> 00123 *> \param[in] LDB 00124 *> \verbatim 00125 *> LDB is INTEGER 00126 *> The leading dimension of the array B. LDB >= max(1,N). 00127 *> \endverbatim 00128 *> 00129 *> \param[out] WORK 00130 *> \verbatim 00131 *> WORK is REAL array, dimension (N) 00132 *> \endverbatim 00133 *> 00134 *> \param[out] RESID 00135 *> \verbatim 00136 *> RESID is REAL 00137 *> The maximum over the number of right hand sides of 00138 *> norm(op(A)*x - b) / ( norm(op(A)) * norm(x) * EPS ). 00139 *> \endverbatim 00140 * 00141 * Authors: 00142 * ======== 00143 * 00144 *> \author Univ. of Tennessee 00145 *> \author Univ. of California Berkeley 00146 *> \author Univ. of Colorado Denver 00147 *> \author NAG Ltd. 00148 * 00149 *> \date November 2011 00150 * 00151 *> \ingroup single_lin 00152 * 00153 * ===================================================================== 00154 SUBROUTINE STBT02( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, X, 00155 $ LDX, B, LDB, WORK, RESID ) 00156 * 00157 * -- LAPACK test routine (version 3.4.0) -- 00158 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00159 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00160 * November 2011 00161 * 00162 * .. Scalar Arguments .. 00163 CHARACTER DIAG, TRANS, UPLO 00164 INTEGER KD, LDAB, LDB, LDX, N, NRHS 00165 REAL RESID 00166 * .. 00167 * .. Array Arguments .. 00168 REAL AB( LDAB, * ), B( LDB, * ), WORK( * ), 00169 $ X( LDX, * ) 00170 * .. 00171 * 00172 * ===================================================================== 00173 * 00174 * .. Parameters .. 00175 REAL ZERO, ONE 00176 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 00177 * .. 00178 * .. Local Scalars .. 00179 INTEGER J 00180 REAL ANORM, BNORM, EPS, XNORM 00181 * .. 00182 * .. External Functions .. 00183 LOGICAL LSAME 00184 REAL SASUM, SLAMCH, SLANTB 00185 EXTERNAL LSAME, SASUM, SLAMCH, SLANTB 00186 * .. 00187 * .. External Subroutines .. 00188 EXTERNAL SAXPY, SCOPY, STBMV 00189 * .. 00190 * .. Intrinsic Functions .. 00191 INTRINSIC MAX 00192 * .. 00193 * .. Executable Statements .. 00194 * 00195 * Quick exit if N = 0 or NRHS = 0 00196 * 00197 IF( N.LE.0 .OR. NRHS.LE.0 ) THEN 00198 RESID = ZERO 00199 RETURN 00200 END IF 00201 * 00202 * Compute the 1-norm of A or A'. 00203 * 00204 IF( LSAME( TRANS, 'N' ) ) THEN 00205 ANORM = SLANTB( '1', UPLO, DIAG, N, KD, AB, LDAB, WORK ) 00206 ELSE 00207 ANORM = SLANTB( 'I', UPLO, DIAG, N, KD, AB, LDAB, WORK ) 00208 END IF 00209 * 00210 * Exit with RESID = 1/EPS if ANORM = 0. 00211 * 00212 EPS = SLAMCH( 'Epsilon' ) 00213 IF( ANORM.LE.ZERO ) THEN 00214 RESID = ONE / EPS 00215 RETURN 00216 END IF 00217 * 00218 * Compute the maximum over the number of right hand sides of 00219 * norm(op(A)*x - b) / ( norm(op(A)) * norm(x) * EPS ). 00220 * 00221 RESID = ZERO 00222 DO 10 J = 1, NRHS 00223 CALL SCOPY( N, X( 1, J ), 1, WORK, 1 ) 00224 CALL STBMV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, WORK, 1 ) 00225 CALL SAXPY( N, -ONE, B( 1, J ), 1, WORK, 1 ) 00226 BNORM = SASUM( N, WORK, 1 ) 00227 XNORM = SASUM( N, X( 1, J ), 1 ) 00228 IF( XNORM.LE.ZERO ) THEN 00229 RESID = ONE / EPS 00230 ELSE 00231 RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS ) 00232 END IF 00233 10 CONTINUE 00234 * 00235 RETURN 00236 * 00237 * End of STBT02 00238 * 00239 END