da/d86/sget04_8f_source.html

00001       SUBROUTINE SGET04( 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       REAL               X( LDX, * ), XACT( LDXACT, * )
00013 *     ..
00014 *
00015 *  Purpose
00016 *  =======
00017 *
00018 *  SGET04 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) REAL 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) REAL 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 *     ..
00066 *     .. External Functions ..
00067       INTEGER            ISAMAX
00068       REAL               SLAMCH
00069       EXTERNAL           ISAMAX, SLAMCH
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 = SLAMCH( 'Epsilon' )
00086       IF( RCOND.LT.ZERO ) THEN
00087          RESID = 1.0 / 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 = ISAMAX( 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.0 / EPS
00106          ELSE
00107             RESID = MAX( RESID, ( DIFFNM / XNORM )*RCOND )
00108          END IF
00109    20 CONTINUE
00110       IF( RESID*EPS.LT.1.0 )
00111      $   RESID = RESID / EPS
00112 *
00113       RETURN
00114 *
00115 *     End of SGET04
00116 *
00117       END