1*> \brief \b SGET04
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE SGET04( N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            LDX, LDXACT, N, NRHS
15*       REAL               RCOND, RESID
16*       ..
17*       .. Array Arguments ..
18*       REAL               X( LDX, * ), XACT( LDXACT, * )
19*       ..
20*
21*
22*> \par Purpose:
23*  =============
24*>
25*> \verbatim
26*>
27*> SGET04 computes the difference between a computed solution and the
28*> true solution to a system of linear equations.
29*>
30*> RESID =  ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ),
31*> where RCOND is the reciprocal of the condition number and EPS is the
32*> machine epsilon.
33*> \endverbatim
34*
35*  Arguments:
36*  ==========
37*
38*> \param[in] N
39*> \verbatim
40*>          N is INTEGER
41*>          The number of rows of the matrices X and XACT.  N >= 0.
42*> \endverbatim
43*>
44*> \param[in] NRHS
45*> \verbatim
46*>          NRHS is INTEGER
47*>          The number of columns of the matrices X and XACT.  NRHS >= 0.
48*> \endverbatim
49*>
50*> \param[in] X
51*> \verbatim
52*>          X is REAL array, dimension (LDX,NRHS)
53*>          The computed solution vectors.  Each vector is stored as a
54*>          column of the matrix X.
55*> \endverbatim
56*>
57*> \param[in] LDX
58*> \verbatim
59*>          LDX is INTEGER
60*>          The leading dimension of the array X.  LDX >= max(1,N).
61*> \endverbatim
62*>
63*> \param[in] XACT
64*> \verbatim
65*>          XACT is REAL array, dimension( LDX, NRHS )
66*>          The exact solution vectors.  Each vector is stored as a
67*>          column of the matrix XACT.
68*> \endverbatim
69*>
70*> \param[in] LDXACT
71*> \verbatim
72*>          LDXACT is INTEGER
73*>          The leading dimension of the array XACT.  LDXACT >= max(1,N).
74*> \endverbatim
75*>
76*> \param[in] RCOND
77*> \verbatim
78*>          RCOND is REAL
79*>          The reciprocal of the condition number of the coefficient
80*>          matrix in the system of equations.
81*> \endverbatim
82*>
83*> \param[out] RESID
84*> \verbatim
85*>          RESID is REAL
86*>          The maximum over the NRHS solution vectors of
87*>          ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS )
88*> \endverbatim
89*
90*  Authors:
91*  ========
92*
93*> \author Univ. of Tennessee
94*> \author Univ. of California Berkeley
95*> \author Univ. of Colorado Denver
96*> \author NAG Ltd.
97*
98*> \ingroup single_lin
99*
100*  =====================================================================
101      SUBROUTINE SGET04( N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID )
102*
103*  -- LAPACK test routine --
104*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
105*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
106*
107*     .. Scalar Arguments ..
108      INTEGER            LDX, LDXACT, N, NRHS
109      REAL               RCOND, RESID
110*     ..
111*     .. Array Arguments ..
112      REAL               X( LDX, * ), XACT( LDXACT, * )
113*     ..
114*
115*  =====================================================================
116*
117*     .. Parameters ..
118      REAL               ZERO
119      PARAMETER          ( ZERO = 0.0E+0 )
120*     ..
121*     .. Local Scalars ..
122      INTEGER            I, IX, J
123      REAL               DIFFNM, EPS, XNORM
124*     ..
125*     .. External Functions ..
126      INTEGER            ISAMAX
127      REAL               SLAMCH
128      EXTERNAL           ISAMAX, SLAMCH
129*     ..
130*     .. Intrinsic Functions ..
131      INTRINSIC          ABS, MAX
132*     ..
133*     .. Executable Statements ..
134*
135*     Quick exit if N = 0 or NRHS = 0.
136*
137      IF( N.LE.0 .OR. NRHS.LE.0 ) THEN
138         RESID = ZERO
139         RETURN
140      END IF
141*
142*     Exit with RESID = 1/EPS if RCOND is invalid.
143*
144      EPS = SLAMCH( 'Epsilon' )
145      IF( RCOND.LT.ZERO ) THEN
146         RESID = 1.0 / EPS
147         RETURN
148      END IF
149*
150*     Compute the maximum of
151*        norm(X - XACT) / ( norm(XACT) * EPS )
152*     over all the vectors X and XACT .
153*
154      RESID = ZERO
155      DO 20 J = 1, NRHS
156         IX = ISAMAX( N, XACT( 1, J ), 1 )
157         XNORM = ABS( XACT( IX, J ) )
158         DIFFNM = ZERO
159         DO 10 I = 1, N
160            DIFFNM = MAX( DIFFNM, ABS( X( I, J )-XACT( I, J ) ) )
161   10    CONTINUE
162         IF( XNORM.LE.ZERO ) THEN
163            IF( DIFFNM.GT.ZERO )
164     $         RESID = 1.0 / EPS
165         ELSE
166            RESID = MAX( RESID, ( DIFFNM / XNORM )*RCOND )
167         END IF
168   20 CONTINUE
169      IF( RESID*EPS.LT.1.0 )
170     $   RESID = RESID / EPS
171*
172      RETURN
173*
174*     End of SGET04
175*
176      END
177