1*> \brief \b SGET02 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 SGET02( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, 12* RWORK, RESID ) 13* 14* .. Scalar Arguments .. 15* CHARACTER TRANS 16* INTEGER LDA, LDB, LDX, M, N, NRHS 17* REAL RESID 18* .. 19* .. Array Arguments .. 20* REAL A( LDA, * ), B( LDB, * ), RWORK( * ), 21* $ X( LDX, * ) 22* .. 23* 24* 25*> \par Purpose: 26* ============= 27*> 28*> \verbatim 29*> 30*> SGET02 computes the residual for a solution of a system of linear 31*> equations A*x = b or A'*x = b: 32*> RESID = norm(B - A*X) / ( norm(A) * norm(X) * EPS ), 33*> where EPS is the machine epsilon. 34*> \endverbatim 35* 36* Arguments: 37* ========== 38* 39*> \param[in] TRANS 40*> \verbatim 41*> TRANS is CHARACTER*1 42*> Specifies the form of the system of equations: 43*> = 'N': A *x = b 44*> = 'T': A'*x = b, where A' is the transpose of A 45*> = 'C': A'*x = b, where A' is the transpose of A 46*> \endverbatim 47*> 48*> \param[in] M 49*> \verbatim 50*> M is INTEGER 51*> The number of rows of the matrix A. M >= 0. 52*> \endverbatim 53*> 54*> \param[in] N 55*> \verbatim 56*> N is INTEGER 57*> The number of columns of the matrix A. N >= 0. 58*> \endverbatim 59*> 60*> \param[in] NRHS 61*> \verbatim 62*> NRHS is INTEGER 63*> The number of columns of B, the matrix of right hand sides. 64*> NRHS >= 0. 65*> \endverbatim 66*> 67*> \param[in] A 68*> \verbatim 69*> A is REAL array, dimension (LDA,N) 70*> The original M x N matrix A. 71*> \endverbatim 72*> 73*> \param[in] LDA 74*> \verbatim 75*> LDA is INTEGER 76*> The leading dimension of the array A. LDA >= max(1,M). 77*> \endverbatim 78*> 79*> \param[in] X 80*> \verbatim 81*> X is REAL array, dimension (LDX,NRHS) 82*> The computed solution vectors for the system of linear 83*> equations. 84*> \endverbatim 85*> 86*> \param[in] LDX 87*> \verbatim 88*> LDX is INTEGER 89*> The leading dimension of the array X. If TRANS = 'N', 90*> LDX >= max(1,N); if TRANS = 'T' or 'C', LDX >= max(1,M). 91*> \endverbatim 92*> 93*> \param[in,out] B 94*> \verbatim 95*> B is REAL array, dimension (LDB,NRHS) 96*> On entry, the right hand side vectors for the system of 97*> linear equations. 98*> On exit, B is overwritten with the difference B - A*X. 99*> \endverbatim 100*> 101*> \param[in] LDB 102*> \verbatim 103*> LDB is INTEGER 104*> The leading dimension of the array B. IF TRANS = 'N', 105*> LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N). 106*> \endverbatim 107*> 108*> \param[out] RWORK 109*> \verbatim 110*> RWORK is REAL array, dimension (M) 111*> \endverbatim 112*> 113*> \param[out] RESID 114*> \verbatim 115*> RESID is REAL 116*> The maximum over the number of right hand sides of 117*> norm(B - A*X) / ( norm(A) * norm(X) * EPS ). 118*> \endverbatim 119* 120* Authors: 121* ======== 122* 123*> \author Univ. of Tennessee 124*> \author Univ. of California Berkeley 125*> \author Univ. of Colorado Denver 126*> \author NAG Ltd. 127* 128*> \date November 2011 129* 130*> \ingroup single_lin 131* 132* ===================================================================== 133 SUBROUTINE SGET02( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, 134 $ RWORK, RESID ) 135* 136* -- LAPACK test routine (version 3.4.0) -- 137* -- LAPACK is a software package provided by Univ. of Tennessee, -- 138* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 139* November 2011 140* 141* .. Scalar Arguments .. 142 CHARACTER TRANS 143 INTEGER LDA, LDB, LDX, M, N, NRHS 144 REAL RESID 145* .. 146* .. Array Arguments .. 147 REAL A( LDA, * ), B( LDB, * ), RWORK( * ), 148 $ X( LDX, * ) 149* .. 150* 151* ===================================================================== 152* 153* .. Parameters .. 154 REAL ZERO, ONE 155 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 156* .. 157* .. Local Scalars .. 158 INTEGER J, N1, N2 159 REAL ANORM, BNORM, EPS, XNORM 160* .. 161* .. External Functions .. 162 LOGICAL LSAME 163 REAL SASUM, SLAMCH, SLANGE 164 EXTERNAL LSAME, SASUM, SLAMCH, SLANGE 165* .. 166* .. External Subroutines .. 167 EXTERNAL SGEMM 168* .. 169* .. Intrinsic Functions .. 170 INTRINSIC MAX 171* .. 172* .. Executable Statements .. 173* 174* Quick exit if M = 0 or N = 0 or NRHS = 0 175* 176 IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.EQ.0 ) THEN 177 RESID = ZERO 178 RETURN 179 END IF 180* 181 IF( LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) ) THEN 182 N1 = N 183 N2 = M 184 ELSE 185 N1 = M 186 N2 = N 187 END IF 188* 189* Exit with RESID = 1/EPS if ANORM = 0. 190* 191 EPS = SLAMCH( 'Epsilon' ) 192 ANORM = SLANGE( '1', N1, N2, A, LDA, RWORK ) 193 IF( ANORM.LE.ZERO ) THEN 194 RESID = ONE / EPS 195 RETURN 196 END IF 197* 198* Compute B - A*X (or B - A'*X ) and store in B. 199* 200 CALL SGEMM( TRANS, 'No transpose', N1, NRHS, N2, -ONE, A, LDA, X, 201 $ LDX, ONE, B, LDB ) 202* 203* Compute the maximum over the number of right hand sides of 204* norm(B - A*X) / ( norm(A) * norm(X) * EPS ) . 205* 206 RESID = ZERO 207 DO 10 J = 1, NRHS 208 BNORM = SASUM( N1, B( 1, J ), 1 ) 209 XNORM = SASUM( N2, X( 1, J ), 1 ) 210 IF( XNORM.LE.ZERO ) THEN 211 RESID = ONE / EPS 212 ELSE 213 RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS ) 214 END IF 215 10 CONTINUE 216* 217 RETURN 218* 219* End of SGET02 220* 221 END 222