![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b STRT02 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 STRT02( UPLO, TRANS, DIAG, N, NRHS, A, LDA, X, LDX, B, 00012 * LDB, WORK, RESID ) 00013 * 00014 * .. Scalar Arguments .. 00015 * CHARACTER DIAG, TRANS, UPLO 00016 * INTEGER LDA, LDB, LDX, N, NRHS 00017 * REAL RESID 00018 * .. 00019 * .. Array Arguments .. 00020 * REAL A( LDA, * ), B( LDB, * ), WORK( * ), 00021 * $ X( LDX, * ) 00022 * .. 00023 * 00024 * 00025 *> \par Purpose: 00026 * ============= 00027 *> 00028 *> \verbatim 00029 *> 00030 *> STRT02 computes the residual for the computed solution to a 00031 *> triangular system of linear equations A*x = b or A'*x = b. 00032 *> Here A is a triangular matrix, A' is the transpose of A, and x and b 00033 *> are N by NRHS matrices. The test ratio is the maximum over the 00034 *> 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] NRHS 00074 *> \verbatim 00075 *> NRHS is INTEGER 00076 *> The number of right hand sides, i.e., the number of columns 00077 *> of the matrices X and B. NRHS >= 0. 00078 *> \endverbatim 00079 *> 00080 *> \param[in] A 00081 *> \verbatim 00082 *> A is REAL array, dimension (LDA,N) 00083 *> The triangular matrix A. If UPLO = 'U', the leading n by n 00084 *> upper triangular part of the array A contains the upper 00085 *> triangular matrix, and the strictly lower triangular part of 00086 *> A is not referenced. If UPLO = 'L', the leading n by n lower 00087 *> triangular part of the array A contains the lower triangular 00088 *> matrix, and the strictly upper triangular part of A is not 00089 *> referenced. If DIAG = 'U', the diagonal elements of A are 00090 *> also not referenced and are assumed to be 1. 00091 *> \endverbatim 00092 *> 00093 *> \param[in] LDA 00094 *> \verbatim 00095 *> LDA is INTEGER 00096 *> The leading dimension of the array A. LDA >= max(1,N). 00097 *> \endverbatim 00098 *> 00099 *> \param[in] X 00100 *> \verbatim 00101 *> X is REAL array, dimension (LDX,NRHS) 00102 *> The computed solution vectors for the system of linear 00103 *> equations. 00104 *> \endverbatim 00105 *> 00106 *> \param[in] LDX 00107 *> \verbatim 00108 *> LDX is INTEGER 00109 *> The leading dimension of the array X. LDX >= max(1,N). 00110 *> \endverbatim 00111 *> 00112 *> \param[in] B 00113 *> \verbatim 00114 *> B is REAL array, dimension (LDB,NRHS) 00115 *> The right hand side vectors for the system of linear 00116 *> equations. 00117 *> \endverbatim 00118 *> 00119 *> \param[in] LDB 00120 *> \verbatim 00121 *> LDB is INTEGER 00122 *> The leading dimension of the array B. LDB >= max(1,N). 00123 *> \endverbatim 00124 *> 00125 *> \param[out] WORK 00126 *> \verbatim 00127 *> WORK is REAL array, dimension (N) 00128 *> \endverbatim 00129 *> 00130 *> \param[out] RESID 00131 *> \verbatim 00132 *> RESID is REAL 00133 *> The maximum over the number of right hand sides of 00134 *> norm(op(A)*x - b) / ( norm(op(A)) * norm(x) * EPS ). 00135 *> \endverbatim 00136 * 00137 * Authors: 00138 * ======== 00139 * 00140 *> \author Univ. of Tennessee 00141 *> \author Univ. of California Berkeley 00142 *> \author Univ. of Colorado Denver 00143 *> \author NAG Ltd. 00144 * 00145 *> \date November 2011 00146 * 00147 *> \ingroup single_lin 00148 * 00149 * ===================================================================== 00150 SUBROUTINE STRT02( UPLO, TRANS, DIAG, N, NRHS, A, LDA, X, LDX, B, 00151 $ LDB, WORK, RESID ) 00152 * 00153 * -- LAPACK test routine (version 3.4.0) -- 00154 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00155 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00156 * November 2011 00157 * 00158 * .. Scalar Arguments .. 00159 CHARACTER DIAG, TRANS, UPLO 00160 INTEGER LDA, LDB, LDX, N, NRHS 00161 REAL RESID 00162 * .. 00163 * .. Array Arguments .. 00164 REAL A( LDA, * ), B( LDB, * ), WORK( * ), 00165 $ X( LDX, * ) 00166 * .. 00167 * 00168 * ===================================================================== 00169 * 00170 * .. Parameters .. 00171 REAL ZERO, ONE 00172 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 00173 * .. 00174 * .. Local Scalars .. 00175 INTEGER J 00176 REAL ANORM, BNORM, EPS, XNORM 00177 * .. 00178 * .. External Functions .. 00179 LOGICAL LSAME 00180 REAL SASUM, SLAMCH, SLANTR 00181 EXTERNAL LSAME, SASUM, SLAMCH, SLANTR 00182 * .. 00183 * .. External Subroutines .. 00184 EXTERNAL SAXPY, SCOPY, STRMV 00185 * .. 00186 * .. Intrinsic Functions .. 00187 INTRINSIC MAX 00188 * .. 00189 * .. Executable Statements .. 00190 * 00191 * Quick exit if N = 0 or NRHS = 0 00192 * 00193 IF( N.LE.0 .OR. NRHS.LE.0 ) THEN 00194 RESID = ZERO 00195 RETURN 00196 END IF 00197 * 00198 * Compute the 1-norm of A or A'. 00199 * 00200 IF( LSAME( TRANS, 'N' ) ) THEN 00201 ANORM = SLANTR( '1', UPLO, DIAG, N, N, A, LDA, WORK ) 00202 ELSE 00203 ANORM = SLANTR( 'I', UPLO, DIAG, N, N, A, LDA, WORK ) 00204 END IF 00205 * 00206 * Exit with RESID = 1/EPS if ANORM = 0. 00207 * 00208 EPS = SLAMCH( 'Epsilon' ) 00209 IF( ANORM.LE.ZERO ) THEN 00210 RESID = ONE / EPS 00211 RETURN 00212 END IF 00213 * 00214 * Compute the maximum over the number of right hand sides of 00215 * norm(op(A)*x - b) / ( norm(op(A)) * norm(x) * EPS ) 00216 * 00217 RESID = ZERO 00218 DO 10 J = 1, NRHS 00219 CALL SCOPY( N, X( 1, J ), 1, WORK, 1 ) 00220 CALL STRMV( UPLO, TRANS, DIAG, N, A, LDA, WORK, 1 ) 00221 CALL SAXPY( N, -ONE, B( 1, J ), 1, WORK, 1 ) 00222 BNORM = SASUM( N, WORK, 1 ) 00223 XNORM = SASUM( N, X( 1, J ), 1 ) 00224 IF( XNORM.LE.ZERO ) THEN 00225 RESID = ONE / EPS 00226 ELSE 00227 RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS ) 00228 END IF 00229 10 CONTINUE 00230 * 00231 RETURN 00232 * 00233 * End of STRT02 00234 * 00235 END