Move LAPACK trunk into position.

1 files changed, 124 insertions, 0 deletions

diff --git a/TESTING/LIN/cget04.f b/TESTING/LIN/cget04.f
new file mode 100644
index 00000000..27f5c710
--- /dev/null
+++ b/TESTING/LIN/cget04.f
@@ -0,0 +1,124 @@
+      SUBROUTINE CGET04( N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID )
+*
+*  -- LAPACK test routine (version 3.1) --
+*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+*     November 2006
+*
+*     .. Scalar Arguments ..
+      INTEGER            LDX, LDXACT, N, NRHS
+      REAL               RCOND, RESID
+*     ..
+*     .. Array Arguments ..
+      COMPLEX            X( LDX, * ), XACT( LDXACT, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  CGET04 computes the difference between a computed solution and the
+*  true solution to a system of linear equations.
+*
+*  RESID =  ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ),
+*  where RCOND is the reciprocal of the condition number and EPS is the
+*  machine epsilon.
+*
+*  Arguments
+*  =========
+*
+*  N       (input) INTEGER
+*          The number of rows of the matrices X and XACT.  N >= 0.
+*
+*  NRHS    (input) INTEGER
+*          The number of columns of the matrices X and XACT.  NRHS >= 0.
+*
+*  X       (input) COMPLEX array, dimension (LDX,NRHS)
+*          The computed solution vectors.  Each vector is stored as a
+*          column of the matrix X.
+*
+*  LDX     (input) INTEGER
+*          The leading dimension of the array X.  LDX >= max(1,N).
+*
+*  XACT    (input) COMPLEX array, dimension (LDX,NRHS)
+*          The exact solution vectors.  Each vector is stored as a
+*          column of the matrix XACT.
+*
+*  LDXACT  (input) INTEGER
+*          The leading dimension of the array XACT.  LDXACT >= max(1,N).
+*
+*  RCOND   (input) REAL
+*          The reciprocal of the condition number of the coefficient
+*          matrix in the system of equations.
+*
+*  RESID   (output) REAL
+*          The maximum over the NRHS solution vectors of
+*          ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS )
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO
+      PARAMETER          ( ZERO = 0.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, IX, J
+      REAL               DIFFNM, EPS, XNORM
+      COMPLEX            ZDUM
+*     ..
+*     .. External Functions ..
+      INTEGER            ICAMAX
+      REAL               SLAMCH
+      EXTERNAL           ICAMAX, SLAMCH
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, AIMAG, MAX, REAL
+*     ..
+*     .. Statement Functions ..
+      REAL               CABS1
+*     ..
+*     .. Statement Function definitions ..
+      CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
+*     ..
+*     .. Executable Statements ..
+*
+*     Quick exit if N = 0 or NRHS = 0.
+*
+      IF( N.LE.0 .OR. NRHS.LE.0 ) THEN
+         RESID = ZERO
+         RETURN
+      END IF
+*
+*     Exit with RESID = 1/EPS if RCOND is invalid.
+*
+      EPS = SLAMCH( 'Epsilon' )
+      IF( RCOND.LT.ZERO ) THEN
+         RESID = 1.0 / EPS
+         RETURN
+      END IF
+*
+*     Compute the maximum of
+*        norm(X - XACT) / ( norm(XACT) * EPS )
+*     over all the vectors X and XACT .
+*
+      RESID = ZERO
+      DO 20 J = 1, NRHS
+         IX = ICAMAX( N, XACT( 1, J ), 1 )
+         XNORM = CABS1( XACT( IX, J ) )
+         DIFFNM = ZERO
+         DO 10 I = 1, N
+            DIFFNM = MAX( DIFFNM, CABS1( X( I, J )-XACT( I, J ) ) )
+   10    CONTINUE
+         IF( XNORM.LE.ZERO ) THEN
+            IF( DIFFNM.GT.ZERO )
+     $         RESID = 1.0 / EPS
+         ELSE
+            RESID = MAX( RESID, ( DIFFNM / XNORM )*RCOND )
+         END IF
+   20 CONTINUE
+      IF( RESID*EPS.LT.1.0 )
+     $   RESID = RESID / EPS
+*
+      RETURN
+*
+*     End of CGET04
+*
+      END