1*> \brief \b DGET08 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 DGET08( 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* DOUBLE PRECISION RESID 18* .. 19* .. Array Arguments .. 20* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), RWORK( * ), 21* $ X( LDX, * ) 22* .. 23* 24* 25*> \par Purpose: 26* ============= 27*> 28*> \verbatim 29*> 30*> DGET08 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,inf) / ( norm(A,inf) * norm(X,inf) * 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (M) 111*> \endverbatim 112*> 113*> \param[out] RESID 114*> \verbatim 115*> RESID is DOUBLE PRECISION 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*> \ingroup double_lin 129* 130* ===================================================================== 131 SUBROUTINE DGET08( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, 132 $ RWORK, RESID ) 133* 134* -- LAPACK test routine -- 135* -- LAPACK is a software package provided by Univ. of Tennessee, -- 136* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 137* 138* .. Scalar Arguments .. 139 CHARACTER TRANS 140 INTEGER LDA, LDB, LDX, M, N, NRHS 141 DOUBLE PRECISION RESID 142* .. 143* .. Array Arguments .. 144 DOUBLE PRECISION A( LDA, * ), B( LDB, * ), RWORK( * ), 145 $ X( LDX, * ) 146* .. 147* 148* ===================================================================== 149* 150* .. Parameters .. 151 DOUBLE PRECISION ZERO, ONE 152 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 153* .. 154* .. Local Scalars .. 155 INTEGER J, N1, N2 156 DOUBLE PRECISION ANORM, BNORM, EPS, XNORM 157* .. 158* .. External Functions .. 159 LOGICAL LSAME 160 INTEGER IDAMAX 161 DOUBLE PRECISION DLAMCH, DLANGE 162 EXTERNAL LSAME, IDAMAX, DLAMCH, DLANGE 163* .. 164* .. External Subroutines .. 165 EXTERNAL DGEMM 166* .. 167* .. Intrinsic Functions .. 168 INTRINSIC MAX, ABS 169* .. 170* .. Executable Statements .. 171* 172* Quick exit if M = 0 or N = 0 or NRHS = 0 173* 174 IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.EQ.0 ) THEN 175 RESID = ZERO 176 RETURN 177 END IF 178* 179 IF( LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) ) THEN 180 N1 = N 181 N2 = M 182 ELSE 183 N1 = M 184 N2 = N 185 END IF 186* 187* Exit with RESID = 1/EPS if ANORM = 0. 188* 189 EPS = DLAMCH( 'Epsilon' ) 190 ANORM = DLANGE( 'I', N1, N2, A, LDA, RWORK ) 191 IF( ANORM.LE.ZERO ) THEN 192 RESID = ONE / EPS 193 RETURN 194 END IF 195* 196* Compute B - A*X (or B - A'*X ) and store in B. 197* 198 CALL DGEMM( TRANS, 'No transpose', N1, NRHS, N2, -ONE, A, LDA, X, 199 $ LDX, ONE, B, LDB ) 200* 201* Compute the maximum over the number of right hand sides of 202* norm(B - A*X) / ( norm(A) * norm(X) * EPS ) . 203* 204 RESID = ZERO 205 DO 10 J = 1, NRHS 206 BNORM = ABS(B(IDAMAX( N1, B( 1, J ), 1 ),J)) 207 XNORM = ABS(X(IDAMAX( N2, X( 1, J ), 1 ),J)) 208 IF( XNORM.LE.ZERO ) THEN 209 RESID = ONE / EPS 210 ELSE 211 RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS ) 212 END IF 213 10 CONTINUE 214* 215 RETURN 216* 217* End of DGET08 218* 219 END 220