1       SUBROUTINE CGET04( 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       COMPLEX            X( LDX, * ), XACT( LDXACT, * )
 13 *     ..
 14 *
 15 *  Purpose
 16 *  =======
 17 *
 18 *  CGET04 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) COMPLEX 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) COMPLEX 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       COMPLEX            ZDUM
 66 *     ..
 67 *     .. External Functions ..
 68       INTEGER            ICAMAX
 69       REAL               SLAMCH
 70       EXTERNAL           ICAMAX, SLAMCH
 71 *     ..
 72 *     .. Intrinsic Functions ..
 73       INTRINSIC          ABSAIMAGMAX, REAL
 74 *     ..
 75 *     .. Statement Functions ..
 76       REAL               CABS1
 77 *     ..
 78 *     .. Statement Function definitions ..
 79       CABS1( ZDUM ) = ABSREAL( ZDUM ) ) + ABSAIMAG( ZDUM ) )
 80 *     ..
 81 *     .. Executable Statements ..
 82 *
 83 *     Quick exit if N = 0 or NRHS = 0.
 84 *
 85       IF( N.LE.0 .OR. NRHS.LE.0 ) THEN
 86          RESID = ZERO
 87          RETURN
 88       END IF
 89 *
 90 *     Exit with RESID = 1/EPS if RCOND is invalid.
 91 *
 92       EPS = SLAMCH( 'Epsilon' )
 93       IF( RCOND.LT.ZERO ) THEN
 94          RESID = 1.0 / EPS
 95          RETURN
 96       END IF
 97 *
 98 *     Compute the maximum of
 99 *        norm(X - XACT) / ( norm(XACT) * EPS )
100 *     over all the vectors X and XACT .
101 *
102       RESID = ZERO
103       DO 20 J = 1, NRHS
104          IX = ICAMAX( N, XACT( 1, J ), 1 )
105          XNORM = CABS1( XACT( IX, J ) )
106          DIFFNM = ZERO
107          DO 10 I = 1, N
108             DIFFNM = MAX( DIFFNM, CABS1( X( I, J )-XACT( I, J ) ) )
109    10    CONTINUE
110          IF( XNORM.LE.ZERO ) THEN
111             IF( DIFFNM.GT.ZERO )
112      $         RESID = 1.0 / EPS
113          ELSE
114             RESID = MAX( RESID, ( DIFFNM / XNORM )*RCOND )
115          END IF
116    20 CONTINUE
117       IF( RESID*EPS.LT.1.0 )
118      $   RESID = RESID / EPS
119 *
120       RETURN
121 *
122 *     End of CGET04
123 *
124       END