![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SGET04 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 SGET04( N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER LDX, LDXACT, N, NRHS 00015 * REAL RCOND, RESID 00016 * .. 00017 * .. Array Arguments .. 00018 * REAL X( LDX, * ), XACT( LDXACT, * ) 00019 * .. 00020 * 00021 * 00022 *> \par Purpose: 00023 * ============= 00024 *> 00025 *> \verbatim 00026 *> 00027 *> SGET04 computes the difference between a computed solution and the 00028 *> true solution to a system of linear equations. 00029 *> 00030 *> RESID = ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ), 00031 *> where RCOND is the reciprocal of the condition number and EPS is the 00032 *> machine epsilon. 00033 *> \endverbatim 00034 * 00035 * Arguments: 00036 * ========== 00037 * 00038 *> \param[in] N 00039 *> \verbatim 00040 *> N is INTEGER 00041 *> The number of rows of the matrices X and XACT. N >= 0. 00042 *> \endverbatim 00043 *> 00044 *> \param[in] NRHS 00045 *> \verbatim 00046 *> NRHS is INTEGER 00047 *> The number of columns of the matrices X and XACT. NRHS >= 0. 00048 *> \endverbatim 00049 *> 00050 *> \param[in] X 00051 *> \verbatim 00052 *> X is REAL array, dimension (LDX,NRHS) 00053 *> The computed solution vectors. Each vector is stored as a 00054 *> column of the matrix X. 00055 *> \endverbatim 00056 *> 00057 *> \param[in] LDX 00058 *> \verbatim 00059 *> LDX is INTEGER 00060 *> The leading dimension of the array X. LDX >= max(1,N). 00061 *> \endverbatim 00062 *> 00063 *> \param[in] XACT 00064 *> \verbatim 00065 *> XACT is REAL array, dimension( LDX, NRHS ) 00066 *> The exact solution vectors. Each vector is stored as a 00067 *> column of the matrix XACT. 00068 *> \endverbatim 00069 *> 00070 *> \param[in] LDXACT 00071 *> \verbatim 00072 *> LDXACT is INTEGER 00073 *> The leading dimension of the array XACT. LDXACT >= max(1,N). 00074 *> \endverbatim 00075 *> 00076 *> \param[in] RCOND 00077 *> \verbatim 00078 *> RCOND is REAL 00079 *> The reciprocal of the condition number of the coefficient 00080 *> matrix in the system of equations. 00081 *> \endverbatim 00082 *> 00083 *> \param[out] RESID 00084 *> \verbatim 00085 *> RESID is REAL 00086 *> The maximum over the NRHS solution vectors of 00087 *> ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ) 00088 *> \endverbatim 00089 * 00090 * Authors: 00091 * ======== 00092 * 00093 *> \author Univ. of Tennessee 00094 *> \author Univ. of California Berkeley 00095 *> \author Univ. of Colorado Denver 00096 *> \author NAG Ltd. 00097 * 00098 *> \date November 2011 00099 * 00100 *> \ingroup single_lin 00101 * 00102 * ===================================================================== 00103 SUBROUTINE SGET04( N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID ) 00104 * 00105 * -- LAPACK test routine (version 3.4.0) -- 00106 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00107 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00108 * November 2011 00109 * 00110 * .. Scalar Arguments .. 00111 INTEGER LDX, LDXACT, N, NRHS 00112 REAL RCOND, RESID 00113 * .. 00114 * .. Array Arguments .. 00115 REAL X( LDX, * ), XACT( LDXACT, * ) 00116 * .. 00117 * 00118 * ===================================================================== 00119 * 00120 * .. Parameters .. 00121 REAL ZERO 00122 PARAMETER ( ZERO = 0.0E+0 ) 00123 * .. 00124 * .. Local Scalars .. 00125 INTEGER I, IX, J 00126 REAL DIFFNM, EPS, XNORM 00127 * .. 00128 * .. External Functions .. 00129 INTEGER ISAMAX 00130 REAL SLAMCH 00131 EXTERNAL ISAMAX, SLAMCH 00132 * .. 00133 * .. Intrinsic Functions .. 00134 INTRINSIC ABS, MAX 00135 * .. 00136 * .. Executable Statements .. 00137 * 00138 * Quick exit if N = 0 or NRHS = 0. 00139 * 00140 IF( N.LE.0 .OR. NRHS.LE.0 ) THEN 00141 RESID = ZERO 00142 RETURN 00143 END IF 00144 * 00145 * Exit with RESID = 1/EPS if RCOND is invalid. 00146 * 00147 EPS = SLAMCH( 'Epsilon' ) 00148 IF( RCOND.LT.ZERO ) THEN 00149 RESID = 1.0 / EPS 00150 RETURN 00151 END IF 00152 * 00153 * Compute the maximum of 00154 * norm(X - XACT) / ( norm(XACT) * EPS ) 00155 * over all the vectors X and XACT . 00156 * 00157 RESID = ZERO 00158 DO 20 J = 1, NRHS 00159 IX = ISAMAX( N, XACT( 1, J ), 1 ) 00160 XNORM = ABS( XACT( IX, J ) ) 00161 DIFFNM = ZERO 00162 DO 10 I = 1, N 00163 DIFFNM = MAX( DIFFNM, ABS( X( I, J )-XACT( I, J ) ) ) 00164 10 CONTINUE 00165 IF( XNORM.LE.ZERO ) THEN 00166 IF( DIFFNM.GT.ZERO ) 00167 $ RESID = 1.0 / EPS 00168 ELSE 00169 RESID = MAX( RESID, ( DIFFNM / XNORM )*RCOND ) 00170 END IF 00171 20 CONTINUE 00172 IF( RESID*EPS.LT.1.0 ) 00173 $ RESID = RESID / EPS 00174 * 00175 RETURN 00176 * 00177 * End of SGET04 00178 * 00179 END