LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE DGET04( N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID ) 00002 * 00003 * -- LAPACK test routine (version 3.1) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * November 2006 00006 * 00007 * .. Scalar Arguments .. 00008 INTEGER LDX, LDXACT, N, NRHS 00009 DOUBLE PRECISION RCOND, RESID 00010 * .. 00011 * .. Array Arguments .. 00012 DOUBLE PRECISION X( LDX, * ), XACT( LDXACT, * ) 00013 * .. 00014 * 00015 * Purpose 00016 * ======= 00017 * 00018 * DGET04 computes the difference between a computed solution and the 00019 * true solution to a system of linear equations. 00020 * 00021 * RESID = ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ), 00022 * where RCOND is the reciprocal of the condition number and EPS is the 00023 * machine epsilon. 00024 * 00025 * Arguments 00026 * ========= 00027 * 00028 * N (input) INTEGER 00029 * The number of rows of the matrices X and XACT. N >= 0. 00030 * 00031 * NRHS (input) INTEGER 00032 * The number of columns of the matrices X and XACT. NRHS >= 0. 00033 * 00034 * X (input) DOUBLE PRECISION array, dimension (LDX,NRHS) 00035 * The computed solution vectors. Each vector is stored as a 00036 * column of the matrix X. 00037 * 00038 * LDX (input) INTEGER 00039 * The leading dimension of the array X. LDX >= max(1,N). 00040 * 00041 * XACT (input) DOUBLE PRECISION array, dimension( LDX, NRHS ) 00042 * The exact solution vectors. Each vector is stored as a 00043 * column of the matrix XACT. 00044 * 00045 * LDXACT (input) INTEGER 00046 * The leading dimension of the array XACT. LDXACT >= max(1,N). 00047 * 00048 * RCOND (input) DOUBLE PRECISION 00049 * The reciprocal of the condition number of the coefficient 00050 * matrix in the system of equations. 00051 * 00052 * RESID (output) DOUBLE PRECISION 00053 * The maximum over the NRHS solution vectors of 00054 * ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ) 00055 * 00056 * ===================================================================== 00057 * 00058 * .. Parameters .. 00059 DOUBLE PRECISION ZERO 00060 PARAMETER ( ZERO = 0.0D+0 ) 00061 * .. 00062 * .. Local Scalars .. 00063 INTEGER I, IX, J 00064 DOUBLE PRECISION DIFFNM, EPS, XNORM 00065 * .. 00066 * .. External Functions .. 00067 INTEGER IDAMAX 00068 DOUBLE PRECISION DLAMCH 00069 EXTERNAL IDAMAX, DLAMCH 00070 * .. 00071 * .. Intrinsic Functions .. 00072 INTRINSIC ABS, MAX 00073 * .. 00074 * .. Executable Statements .. 00075 * 00076 * Quick exit if N = 0 or NRHS = 0. 00077 * 00078 IF( N.LE.0 .OR. NRHS.LE.0 ) THEN 00079 RESID = ZERO 00080 RETURN 00081 END IF 00082 * 00083 * Exit with RESID = 1/EPS if RCOND is invalid. 00084 * 00085 EPS = DLAMCH( 'Epsilon' ) 00086 IF( RCOND.LT.ZERO ) THEN 00087 RESID = 1.0D0 / EPS 00088 RETURN 00089 END IF 00090 * 00091 * Compute the maximum of 00092 * norm(X - XACT) / ( norm(XACT) * EPS ) 00093 * over all the vectors X and XACT . 00094 * 00095 RESID = ZERO 00096 DO 20 J = 1, NRHS 00097 IX = IDAMAX( N, XACT( 1, J ), 1 ) 00098 XNORM = ABS( XACT( IX, J ) ) 00099 DIFFNM = ZERO 00100 DO 10 I = 1, N 00101 DIFFNM = MAX( DIFFNM, ABS( X( I, J )-XACT( I, J ) ) ) 00102 10 CONTINUE 00103 IF( XNORM.LE.ZERO ) THEN 00104 IF( DIFFNM.GT.ZERO ) 00105 $ RESID = 1.0D0 / EPS 00106 ELSE 00107 RESID = MAX( RESID, ( DIFFNM / XNORM )*RCOND ) 00108 END IF 00109 20 CONTINUE 00110 IF( RESID*EPS.LT.1.0D0 ) 00111 $ RESID = RESID / EPS 00112 * 00113 RETURN 00114 * 00115 * End of DGET04 00116 * 00117 END