Merge pull request Reference-LAPACK#569 from weslleyspereira/fix-bug-…

…in-xCOMBSSQ Fix bug in (s,d)COMBSSQ
chrwarm · May 25, 2021 · bd6add2 · bd6add2
2 parents 2ecd03d + c55a399
commit bd6add2
Show file tree

Hide file tree

Showing 6 changed files with 10 additions and 4 deletions.
diff --git a/SRC/classq.f90 b/SRC/classq.f90
@@ -241,7 +241,7 @@ subroutine CLASSQ( n, x, incx, scl, sumsq )
       end if
    else
 !
-!     Otherwise all values are mid-range
+!     Otherwise all values are mid-range or zero
 !
       scl = one
       sumsq = amed

diff --git a/SRC/dcombssq.f b/SRC/dcombssq.f
@@ -74,6 +74,9 @@ SUBROUTINE DCOMBSSQ( V1, V2 )
       PARAMETER          ( ZERO = 0.0D+0 )
 *     ..
 *     .. Executable Statements ..
+*
+*     A zero sum V2 shall not modify the scaling factor of V1
+      IF( V2( 2 ).EQ.ZERO ) RETURN
 *
       IF( V1( 1 ).GE.V2( 1 ) ) THEN
          IF( V1( 1 ).NE.ZERO ) THEN

diff --git a/SRC/dlassq.f90 b/SRC/dlassq.f90
@@ -232,7 +232,7 @@ subroutine DLASSQ( n, x, incx, scl, sumsq )
       end if
    else
 !
-!     Otherwise all values are mid-range
+!     Otherwise all values are mid-range or zero
 !
       scl = one
       sumsq = amed

diff --git a/SRC/scombssq.f b/SRC/scombssq.f
@@ -74,6 +74,9 @@ SUBROUTINE SCOMBSSQ( V1, V2 )
       PARAMETER          ( ZERO = 0.0D+0 )
 *     ..
 *     .. Executable Statements ..
+*
+*     A zero sum V2 shall not modify the scaling factor of V1
+      IF( V2( 2 ).EQ.ZERO ) RETURN
 *
       IF( V1( 1 ).GE.V2( 1 ) ) THEN
          IF( V1( 1 ).NE.ZERO ) THEN

diff --git a/SRC/slassq.f90 b/SRC/slassq.f90
@@ -232,7 +232,7 @@ subroutine SLASSQ( n, x, incx, scl, sumsq )
       end if
    else
 !
-!     Otherwise all values are mid-range
+!     Otherwise all values are mid-range or zero
 !
       scl = one
       sumsq = amed

diff --git a/SRC/zlassq.f90 b/SRC/zlassq.f90
@@ -241,7 +241,7 @@ subroutine ZLASSQ( n, x, incx, scl, sumsq )
       end if
    else
 !
-!     Otherwise all values are mid-range
+!     Otherwise all values are mid-range or zero
 !
       scl = one
       sumsq = amed