From d371e22ff044045a590cb37b49fe1529dedcc7eb Mon Sep 17 00:00:00 2001
From: Mo Zhou <cdluminate@gmail.com>
Date: Wed, 20 Dec 2023 21:28:36 -0500
Subject: [PATCH] Fix the wrong implementation of the new tests for xblat1.f.
 (Fixes: #963)

Since this is a regression after upgrading from v3.11.0 to v3.12.0, we can
narrow down the range of the bug into the newly added SB1NRM2 subroutine.
According to the buildlog and the documentation in the code, the VALUES(9),
calculated as SXVALS(XX,2) should be infty. But the current code is returning
a zero (or randomly) initialized variable YY, which does not make sense.

In fact, if you go back to the reference implementation, namely the
supplementary material of this paper
  https://dl.acm.org/doi/abs/10.1145/3061665
You can find a similar implementation of the SXVALS function in the
`la_xxvals.F90` file. This patch corrests the test following the reference
code.
---
 BLAS/TESTING/cblat1.f | 8 ++++++--
 BLAS/TESTING/dblat1.f | 8 ++++++--
 BLAS/TESTING/sblat1.f | 8 ++++++--
 BLAS/TESTING/zblat1.f | 8 ++++++--
 4 files changed, 24 insertions(+), 8 deletions(-)

diff --git a/BLAS/TESTING/cblat1.f b/BLAS/TESTING/cblat1.f
index 83b02f0cac..82798fe0b6 100644
--- a/BLAS/TESTING/cblat1.f
+++ b/BLAS/TESTING/cblat1.f
@@ -994,13 +994,17 @@ REAL FUNCTION SXVALS(XX,K)
 *     .. Scalar Arguments ..
       REAL              XX
       INTEGER           K
+*     .. Parameters ..
+      REAL              ZERO
+      PARAMETER         (ZERO=0.0E+0)
 *     .. Local Scalars ..
-      REAL              X, Y, YY, Z
+      REAL              X, Y, Z
 *     .. Intrinsic Functions ..
       INTRINSIC         HUGE
 *     .. Executable Statements ..
+      X = ZERO
       Y = HUGE(XX)
-      Z = YY
+      Z = Y*Y
       IF (K.EQ.1) THEN
          X = -Z
       ELSE IF (K.EQ.2) THEN
diff --git a/BLAS/TESTING/dblat1.f b/BLAS/TESTING/dblat1.f
index 063ffac3d2..95da39d12e 100644
--- a/BLAS/TESTING/dblat1.f
+++ b/BLAS/TESTING/dblat1.f
@@ -1326,13 +1326,17 @@ DOUBLE PRECISION FUNCTION DXVALS(XX,K)
 *     .. Scalar Arguments ..
       DOUBLE PRECISION  XX
       INTEGER           K
+*     .. Parameters ..
+      DOUBLE PRECISION  ZERO
+      PARAMETER         (ZERO=0.0D+0)
 *     .. Local Scalars ..
-      DOUBLE PRECISION  X, Y, YY, Z
+      DOUBLE PRECISION  X, Y, Z
 *     .. Intrinsic Functions ..
       INTRINSIC         HUGE
 *     .. Executable Statements ..
+      X = ZERO
       Y = HUGE(XX)
-      Z = YY
+      Z = Y*Y
       IF (K.EQ.1) THEN
          X = -Z
       ELSE IF (K.EQ.2) THEN
diff --git a/BLAS/TESTING/sblat1.f b/BLAS/TESTING/sblat1.f
index 4dc537e2f0..e68ee09c1a 100644
--- a/BLAS/TESTING/sblat1.f
+++ b/BLAS/TESTING/sblat1.f
@@ -1278,13 +1278,17 @@ REAL FUNCTION SXVALS(XX,K)
 *     .. Scalar Arguments ..
       REAL              XX
       INTEGER           K
+*     .. Parameters ..
+      REAL              ZERO
+      PARAMETER         (ZERO=0.0E+0)
 *     .. Local Scalars ..
-      REAL              X, Y, YY, Z
+      REAL              X, Y, Z
 *     .. Intrinsic Functions ..
       INTRINSIC         HUGE
 *     .. Executable Statements ..
+      X = ZERO
       Y = HUGE(XX)
-      Z = YY
+      Z = Y*Y
       IF (K.EQ.1) THEN
          X = -Z
       ELSE IF (K.EQ.2) THEN
diff --git a/BLAS/TESTING/zblat1.f b/BLAS/TESTING/zblat1.f
index ef6deff921..29daad5741 100644
--- a/BLAS/TESTING/zblat1.f
+++ b/BLAS/TESTING/zblat1.f
@@ -994,13 +994,17 @@ DOUBLE PRECISION FUNCTION DXVALS(XX,K)
 *     .. Scalar Arguments ..
       DOUBLE PRECISION  XX
       INTEGER           K
+*     .. Parameters ..
+      DOUBLE PRECISION  ZERO
+      PARAMETER         (ZERO=0.0D+0)
 *     .. Local Scalars ..
-      DOUBLE PRECISION  X, Y, YY, Z
+      DOUBLE PRECISION  X, Y, Z
 *     .. Intrinsic Functions ..
       INTRINSIC         HUGE
 *     .. Executable Statements ..
+      X = ZERO
       Y = HUGE(XX)
-      Z = YY
+      Z = Y*Y
       IF (K.EQ.1) THEN
          X = -Z
       ELSE IF (K.EQ.2) THEN