From 5906b884236c59c3dc2c79dd6c96c6cf503ad4e8 Mon Sep 17 00:00:00 2001
From: james <james@8a072113-8704-0410-8d35-dd094bca7971>
Date: Fri, 20 Jan 2012 15:12:13 +0000
Subject: Fixed problem with optimizer breaking error checking, now using F90
 EPSILON intrinsic. Thanks to Harald Anlauf for providing the solution.

---
 BLAS/TESTING/cblat1.f |  5 +++--
 BLAS/TESTING/dblat1.f | 10 ++++++----
 BLAS/TESTING/sblat1.f |  5 +++--
 BLAS/TESTING/zblat1.f |  5 +++--
 4 files changed, 15 insertions(+), 10 deletions(-)

(limited to 'BLAS')

diff --git a/BLAS/TESTING/cblat1.f b/BLAS/TESTING/cblat1.f
index 59632018..88db1e68 100644
--- a/BLAS/TESTING/cblat1.f
+++ b/BLAS/TESTING/cblat1.f
@@ -571,7 +571,8 @@
 *
 *     .. Parameters ..
       INTEGER          NOUT
-      PARAMETER        (NOUT=6)
+      REAL             ZERO
+      PARAMETER        (NOUT=6, ZERO=0.0E0)
 *     .. Scalar Arguments ..
       REAL             SFAC
       INTEGER          LEN
@@ -594,7 +595,7 @@
 *
       DO 40 I = 1, LEN
          SD = SCOMP(I) - STRUE(I)
-         IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0E0)
+         IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO))
      +       GO TO 40
 *
 *                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
diff --git a/BLAS/TESTING/dblat1.f b/BLAS/TESTING/dblat1.f
index 23944c6a..0294d91e 100644
--- a/BLAS/TESTING/dblat1.f
+++ b/BLAS/TESTING/dblat1.f
@@ -894,7 +894,8 @@
 *
 *     .. Parameters ..
       INTEGER          NOUT
-      PARAMETER        (NOUT=6)
+      DOUBLE PRECISION ZERO
+      PARAMETER        (NOUT=6, ZERO=0.0D0)
 *     .. Scalar Arguments ..
       DOUBLE PRECISION SFAC
       INTEGER          LEN
@@ -917,7 +918,7 @@
 *
       DO 40 I = 1, LEN
          SD = SCOMP(I) - STRUE(I)
-         IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0D0)
+         IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO))
      +       GO TO 40
 *
 *                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
@@ -949,7 +950,8 @@
 *
 *     .. Parameters ..
       INTEGER          NOUT
-      PARAMETER        (NOUT=6)
+      REAL             ZERO
+      PARAMETER        (NOUT=6, ZERO=0.0E0)
 *     .. Scalar Arguments ..
       REAL             SFAC, SCOMP, SSIZE, STRUE
 *     .. Scalars in Common ..
@@ -964,7 +966,7 @@
 *     .. Executable Statements ..
 *
          SD = SCOMP - STRUE
-         IF ((ABS(SSIZE)+ABS(SFAC*SD)-ABS(SSIZE)).EQ.0.0E0)
+         IF (ABS(SFAC*SD) .LE. ABS(SSIZE) * EPSILON(ZERO))
      +       GO TO 40
 *
 *                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
diff --git a/BLAS/TESTING/sblat1.f b/BLAS/TESTING/sblat1.f
index bf336d6b..b78e10af 100644
--- a/BLAS/TESTING/sblat1.f
+++ b/BLAS/TESTING/sblat1.f
@@ -898,7 +898,8 @@
 *
 *     .. Parameters ..
       INTEGER          NOUT
-      PARAMETER        (NOUT=6)
+      REAL             ZERO
+      PARAMETER        (NOUT=6, ZERO=0.0E0)
 *     .. Scalar Arguments ..
       REAL             SFAC
       INTEGER          LEN
@@ -921,7 +922,7 @@
 *
       DO 40 I = 1, LEN
          SD = SCOMP(I) - STRUE(I)
-         IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0E0)
+         IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO))
      +       GO TO 40
 *
 *                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
diff --git a/BLAS/TESTING/zblat1.f b/BLAS/TESTING/zblat1.f
index 3e7f2d4a..36419cae 100644
--- a/BLAS/TESTING/zblat1.f
+++ b/BLAS/TESTING/zblat1.f
@@ -571,7 +571,8 @@
 *
 *     .. Parameters ..
       INTEGER          NOUT
-      PARAMETER        (NOUT=6)
+      DOUBLE PRECISION ZERO
+      PARAMETER        (NOUT=6, ZERO=0.0D0)
 *     .. Scalar Arguments ..
       DOUBLE PRECISION SFAC
       INTEGER          LEN
@@ -594,7 +595,7 @@
 *
       DO 40 I = 1, LEN
          SD = SCOMP(I) - STRUE(I)
-         IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0D0)
+         IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO))
      +       GO TO 40
 *
 *                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
-- 
cgit v1.2.3