Merge pull request #569 from weslleyspereira/fix-bug-in-xCOMBSSQ

Fix bug in (s,d)COMBSSQ

Author: weslleyspereira

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

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

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

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

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

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