LAPACK 3.3.0
|
00001 SUBROUTINE CGET04( 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 REAL RCOND, RESID 00010 * .. 00011 * .. Array Arguments .. 00012 COMPLEX X( LDX, * ), XACT( LDXACT, * ) 00013 * .. 00014 * 00015 * Purpose 00016 * ======= 00017 * 00018 * CGET04 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) COMPLEX 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) COMPLEX 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) REAL 00049 * The reciprocal of the condition number of the coefficient 00050 * matrix in the system of equations. 00051 * 00052 * RESID (output) REAL 00053 * The maximum over the NRHS solution vectors of 00054 * ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ) 00055 * 00056 * ===================================================================== 00057 * 00058 * .. Parameters .. 00059 REAL ZERO 00060 PARAMETER ( ZERO = 0.0E+0 ) 00061 * .. 00062 * .. Local Scalars .. 00063 INTEGER I, IX, J 00064 REAL DIFFNM, EPS, XNORM 00065 COMPLEX ZDUM 00066 * .. 00067 * .. External Functions .. 00068 INTEGER ICAMAX 00069 REAL SLAMCH 00070 EXTERNAL ICAMAX, SLAMCH 00071 * .. 00072 * .. Intrinsic Functions .. 00073 INTRINSIC ABS, AIMAG, MAX, REAL 00074 * .. 00075 * .. Statement Functions .. 00076 REAL CABS1 00077 * .. 00078 * .. Statement Function definitions .. 00079 CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) ) 00080 * .. 00081 * .. Executable Statements .. 00082 * 00083 * Quick exit if N = 0 or NRHS = 0. 00084 * 00085 IF( N.LE.0 .OR. NRHS.LE.0 ) THEN 00086 RESID = ZERO 00087 RETURN 00088 END IF 00089 * 00090 * Exit with RESID = 1/EPS if RCOND is invalid. 00091 * 00092 EPS = SLAMCH( 'Epsilon' ) 00093 IF( RCOND.LT.ZERO ) THEN 00094 RESID = 1.0 / EPS 00095 RETURN 00096 END IF 00097 * 00098 * Compute the maximum of 00099 * norm(X - XACT) / ( norm(XACT) * EPS ) 00100 * over all the vectors X and XACT . 00101 * 00102 RESID = ZERO 00103 DO 20 J = 1, NRHS 00104 IX = ICAMAX( N, XACT( 1, J ), 1 ) 00105 XNORM = CABS1( XACT( IX, J ) ) 00106 DIFFNM = ZERO 00107 DO 10 I = 1, N 00108 DIFFNM = MAX( DIFFNM, CABS1( X( I, J )-XACT( I, J ) ) ) 00109 10 CONTINUE 00110 IF( XNORM.LE.ZERO ) THEN 00111 IF( DIFFNM.GT.ZERO ) 00112 $ RESID = 1.0 / EPS 00113 ELSE 00114 RESID = MAX( RESID, ( DIFFNM / XNORM )*RCOND ) 00115 END IF 00116 20 CONTINUE 00117 IF( RESID*EPS.LT.1.0 ) 00118 $ RESID = RESID / EPS 00119 * 00120 RETURN 00121 * 00122 * End of CGET04 00123 * 00124 END