1*> \brief \b CGET04
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 CGET04( 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*       COMPLEX            X( LDX, * ), XACT( LDXACT, * )
19*       ..
20*
21*
22*> \par Purpose:
23*  =============
24*>
25*> \verbatim
26*>
27*> CGET04 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 COMPLEX 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 COMPLEX 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 complex_lin
99*
100*  =====================================================================
101      SUBROUTINE CGET04( 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      COMPLEX            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      COMPLEX            ZDUM
125*     ..
126*     .. External Functions ..
127      INTEGER            ICAMAX
128      REAL               SLAMCH
129      EXTERNAL           ICAMAX, SLAMCH
130*     ..
131*     .. Intrinsic Functions ..
132      INTRINSIC          ABS, AIMAG, MAX, REAL
133*     ..
134*     .. Statement Functions ..
135      REAL               CABS1
136*     ..
137*     .. Statement Function definitions ..
138      CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
139*     ..
140*     .. Executable Statements ..
141*
142*     Quick exit if N = 0 or NRHS = 0.
143*
144      IF( N.LE.0 .OR. NRHS.LE.0 ) THEN
145         RESID = ZERO
146         RETURN
147      END IF
148*
149*     Exit with RESID = 1/EPS if RCOND is invalid.
150*
151      EPS = SLAMCH( 'Epsilon' )
152      IF( RCOND.LT.ZERO ) THEN
153         RESID = 1.0 / EPS
154         RETURN
155      END IF
156*
157*     Compute the maximum of
158*        norm(X - XACT) / ( norm(XACT) * EPS )
159*     over all the vectors X and XACT .
160*
161      RESID = ZERO
162      DO 20 J = 1, NRHS
163         IX = ICAMAX( N, XACT( 1, J ), 1 )
164         XNORM = CABS1( XACT( IX, J ) )
165         DIFFNM = ZERO
166         DO 10 I = 1, N
167            DIFFNM = MAX( DIFFNM, CABS1( X( I, J )-XACT( I, J ) ) )
168   10    CONTINUE
169         IF( XNORM.LE.ZERO ) THEN
170            IF( DIFFNM.GT.ZERO )
171     $         RESID = 1.0 / EPS
172         ELSE
173            RESID = MAX( RESID, ( DIFFNM / XNORM )*RCOND )
174         END IF
175   20 CONTINUE
176      IF( RESID*EPS.LT.1.0 )
177     $   RESID = RESID / EPS
178*
179      RETURN
180*
181*     End of CGET04
182*
183      END
184