1*> \brief \b DGET04
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 DGET04( N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            LDX, LDXACT, N, NRHS
15*       DOUBLE PRECISION   RCOND, RESID
16*       ..
17*       .. Array Arguments ..
18*       DOUBLE PRECISION   X( LDX, * ), XACT( LDXACT, * )
19*       ..
20*
21*
22*> \par Purpose:
23*  =============
24*>
25*> \verbatim
26*>
27*> DGET04 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION
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 DOUBLE PRECISION
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*> \date November 2011
99*
100*> \ingroup double_lin
101*
102*  =====================================================================
103      SUBROUTINE DGET04( N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID )
104*
105*  -- LAPACK test routine (version 3.4.0) --
106*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
107*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
108*     November 2011
109*
110*     .. Scalar Arguments ..
111      INTEGER            LDX, LDXACT, N, NRHS
112      DOUBLE PRECISION   RCOND, RESID
113*     ..
114*     .. Array Arguments ..
115      DOUBLE PRECISION   X( LDX, * ), XACT( LDXACT, * )
116*     ..
117*
118*  =====================================================================
119*
120*     .. Parameters ..
121      DOUBLE PRECISION   ZERO
122      PARAMETER          ( ZERO = 0.0D+0 )
123*     ..
124*     .. Local Scalars ..
125      INTEGER            I, IX, J
126      DOUBLE PRECISION   DIFFNM, EPS, XNORM
127*     ..
128*     .. External Functions ..
129      INTEGER            IDAMAX
130      DOUBLE PRECISION   DLAMCH
131      EXTERNAL           IDAMAX, DLAMCH
132*     ..
133*     .. Intrinsic Functions ..
134      INTRINSIC          ABS, MAX
135*     ..
136*     .. Executable Statements ..
137*
138*     Quick exit if N = 0 or NRHS = 0.
139*
140      IF( N.LE.0 .OR. NRHS.LE.0 ) THEN
141         RESID = ZERO
142         RETURN
143      END IF
144*
145*     Exit with RESID = 1/EPS if RCOND is invalid.
146*
147      EPS = DLAMCH( 'Epsilon' )
148      IF( RCOND.LT.ZERO ) THEN
149         RESID = 1.0D0 / EPS
150         RETURN
151      END IF
152*
153*     Compute the maximum of
154*        norm(X - XACT) / ( norm(XACT) * EPS )
155*     over all the vectors X and XACT .
156*
157      RESID = ZERO
158      DO 20 J = 1, NRHS
159         IX = IDAMAX( N, XACT( 1, J ), 1 )
160         XNORM = ABS( XACT( IX, J ) )
161         DIFFNM = ZERO
162         DO 10 I = 1, N
163            DIFFNM = MAX( DIFFNM, ABS( X( I, J )-XACT( I, J ) ) )
164   10    CONTINUE
165         IF( XNORM.LE.ZERO ) THEN
166            IF( DIFFNM.GT.ZERO )
167     $         RESID = 1.0D0 / EPS
168         ELSE
169            RESID = MAX( RESID, ( DIFFNM / XNORM )*RCOND )
170         END IF
171   20 CONTINUE
172      IF( RESID*EPS.LT.1.0D0 )
173     $   RESID = RESID / EPS
174*
175      RETURN
176*
177*     End of DGET04
178*
179      END
180