1       SUBROUTINE SGET04( N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID )
  2 *
  3 *  -- LAPACK test routine (version 3.1) --
  4 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  5 *     November 2006
  6 *
  7 *     .. Scalar Arguments ..
  8       INTEGER            LDX, LDXACT, N, NRHS
  9       REAL               RCOND, RESID
 10 *     ..
 11 *     .. Array Arguments ..
 12       REAL               X( LDX, * ), XACT( LDXACT, * )
 13 *     ..
 14 *
 15 *  Purpose
 16 *  =======
 17 *
 18 *  SGET04 computes the difference between a computed solution and the
 19 *  true solution to a system of linear equations.
 20 *
 21 *  RESID =  ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ),
 22 *  where RCOND is the reciprocal of the condition number and EPS is the
 23 *  machine epsilon.
 24 *
 25 *  Arguments
 26 *  =========
 27 *
 28 *  N       (input) INTEGER
 29 *          The number of rows of the matrices X and XACT.  N >= 0.
 30 *
 31 *  NRHS    (input) INTEGER
 32 *          The number of columns of the matrices X and XACT.  NRHS >= 0.
 33 *
 34 *  X       (input) REAL array, dimension (LDX,NRHS)
 35 *          The computed solution vectors.  Each vector is stored as a
 36 *          column of the matrix X.
 37 *
 38 *  LDX     (input) INTEGER
 39 *          The leading dimension of the array X.  LDX >= max(1,N).
 40 *
 41 *  XACT    (input) REAL array, dimension( LDX, NRHS )
 42 *          The exact solution vectors.  Each vector is stored as a
 43 *          column of the matrix XACT.
 44 *
 45 *  LDXACT  (input) INTEGER
 46 *          The leading dimension of the array XACT.  LDXACT >= max(1,N).
 47 *
 48 *  RCOND   (input) REAL
 49 *          The reciprocal of the condition number of the coefficient
 50 *          matrix in the system of equations.
 51 *
 52 *  RESID   (output) REAL
 53 *          The maximum over the NRHS solution vectors of
 54 *          ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS )
 55 *
 56 *  =====================================================================
 57 *
 58 *     .. Parameters ..
 59       REAL               ZERO
 60       PARAMETER          ( ZERO = 0.0E+0 )
 61 *     ..
 62 *     .. Local Scalars ..
 63       INTEGER            I, IX, J
 64       REAL               DIFFNM, EPS, XNORM
 65 *     ..
 66 *     .. External Functions ..
 67       INTEGER            ISAMAX
 68       REAL               SLAMCH
 69       EXTERNAL           ISAMAX, SLAMCH
 70 *     ..
 71 *     .. Intrinsic Functions ..
 72       INTRINSIC          ABSMAX
 73 *     ..
 74 *     .. Executable Statements ..
 75 *
 76 *     Quick exit if N = 0 or NRHS = 0.
 77 *
 78       IF( N.LE.0 .OR. NRHS.LE.0 ) THEN
 79          RESID = ZERO
 80          RETURN
 81       END IF
 82 *
 83 *     Exit with RESID = 1/EPS if RCOND is invalid.
 84 *
 85       EPS = SLAMCH( 'Epsilon' )
 86       IF( RCOND.LT.ZERO ) THEN
 87          RESID = 1.0 / EPS
 88          RETURN
 89       END IF
 90 *
 91 *     Compute the maximum of
 92 *        norm(X - XACT) / ( norm(XACT) * EPS )
 93 *     over all the vectors X and XACT .
 94 *
 95       RESID = ZERO
 96       DO 20 J = 1, NRHS
 97          IX = ISAMAX( N, XACT( 1, J ), 1 )
 98          XNORM = ABS( XACT( IX, J ) )
 99          DIFFNM = ZERO
100          DO 10 I = 1, N
101             DIFFNM = MAX( DIFFNM, ABS( X( I, J )-XACT( I, J ) ) )
102    10    CONTINUE
103          IF( XNORM.LE.ZERO ) THEN
104             IF( DIFFNM.GT.ZERO )
105      $         RESID = 1.0 / EPS
106          ELSE
107             RESID = MAX( RESID, ( DIFFNM / XNORM )*RCOND )
108          END IF
109    20 CONTINUE
110       IF( RESID*EPS.LT.1.0 )
111      $   RESID = RESID / EPS
112 *
113       RETURN
114 *
115 *     End of SGET04
116 *
117       END