Skip to content

Commit

Permalink
Merge pull request #909 from weslleyspereira/fix-xlassq
Browse files Browse the repository at this point in the history 
Fix issue #908 related to accumulation in xLASSQ
  • Loading branch information
@langou
langou authored Oct 31, 2023
2 parents 461cc2c + c4f8085 commit 02ea2d3
Show file tree
Hide file tree
Showing 4 changed files with 68 additions and 72 deletions.
35 changes: 17 additions & 18 deletions SRC/classq.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,19 +44,6 @@
!> scale and sumsq must be supplied in SCALE and SUMSQ and
!> scale_out and sumsq_out are overwritten on SCALE and SUMSQ respectively.
!>
!> If scale * sqrt( sumsq ) > tbig then
!> we require: scale >= sqrt( TINY*EPS ) / sbig on entry,
!> and if 0 < scale * sqrt( sumsq ) < tsml then
!> we require: scale <= sqrt( HUGE ) / ssml on entry,
!> where
!> tbig -- upper threshold for values whose square is representable;
!> sbig -- scaling constant for big numbers; \see la_constants.f90
!> tsml -- lower threshold for values whose square is representable;
!> ssml -- scaling constant for small numbers; \see la_constants.f90
!> and
!> TINY*EPS -- tiniest representable number;
!> HUGE -- biggest representable number.
!>
!> \endverbatim
!
! Arguments:
Expand Down Expand Up @@ -209,13 +196,25 @@ subroutine CLASSQ( n, x, incx, scale, sumsq )
if( sumsq > zero ) then
ax = scale*sqrt( sumsq )
if (ax > tbig) then
! We assume scale >= sqrt( TINY*EPS ) / sbig
abig = abig + (scale*sbig)**2 * sumsq
if (scale > one) then
scale = scale * sbig
abig = abig + scale * (scale * sumsq)
else
! sumsq > tbig^2 => (sbig * (sbig * sumsq)) is representable
abig = abig + scale * (scale * (sbig * (sbig * sumsq)))
end if
else if (ax < tsml) then
! We assume scale <= sqrt( HUGE ) / ssml
if (notbig) asml = asml + (scale*ssml)**2 * sumsq
if (notbig) then
if (scale < one) then
scale = scale * ssml
asml = asml + scale * (scale * sumsq)
else
! sumsq < tsml^2 => (ssml * (ssml * sumsq)) is representable
asml = asml + scale * (scale * (ssml * (ssml * sumsq)))
end if
end if
else
amed = amed + scale**2 * sumsq
amed = amed + scale * (scale * sumsq)
end if
end if
!
Expand Down
35 changes: 17 additions & 18 deletions SRC/dlassq.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,19 +44,6 @@
!> scale and sumsq must be supplied in SCALE and SUMSQ and
!> scale_out and sumsq_out are overwritten on SCALE and SUMSQ respectively.
!>
!> If scale * sqrt( sumsq ) > tbig then
!> we require: scale >= sqrt( TINY*EPS ) / sbig on entry,
!> and if 0 < scale * sqrt( sumsq ) < tsml then
!> we require: scale <= sqrt( HUGE ) / ssml on entry,
!> where
!> tbig -- upper threshold for values whose square is representable;
!> sbig -- scaling constant for big numbers; \see la_constants.f90
!> tsml -- lower threshold for values whose square is representable;
!> ssml -- scaling constant for small numbers; \see la_constants.f90
!> and
!> TINY*EPS -- tiniest representable number;
!> HUGE -- biggest representable number.
!>
!> \endverbatim
!
! Arguments:
Expand Down Expand Up @@ -200,13 +187,25 @@ subroutine DLASSQ( n, x, incx, scale, sumsq )
if( sumsq > zero ) then
ax = scale*sqrt( sumsq )
if (ax > tbig) then
! We assume scale >= sqrt( TINY*EPS ) / sbig
abig = abig + (scale*sbig)**2 * sumsq
if (scale > one) then
scale = scale * sbig
abig = abig + scale * (scale * sumsq)
else
! sumsq > tbig^2 => (sbig * (sbig * sumsq)) is representable
abig = abig + scale * (scale * (sbig * (sbig * sumsq)))
end if
else if (ax < tsml) then
! We assume scale <= sqrt( HUGE ) / ssml
if (notbig) asml = asml + (scale*ssml)**2 * sumsq
if (notbig) then
if (scale < one) then
scale = scale * ssml
asml = asml + scale * (scale * sumsq)
else
! sumsq < tsml^2 => (ssml * (ssml * sumsq)) is representable
asml = asml + scale * (scale * (ssml * (ssml * sumsq)))
end if
end if
else
amed = amed + scale**2 * sumsq
amed = amed + scale * (scale * sumsq)
end if
end if
!
Expand Down
35 changes: 17 additions & 18 deletions SRC/slassq.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,19 +44,6 @@
!> scale and sumsq must be supplied in SCALE and SUMSQ and
!> scale_out and sumsq_out are overwritten on SCALE and SUMSQ respectively.
!>
!> If scale * sqrt( sumsq ) > tbig then
!> we require: scale >= sqrt( TINY*EPS ) / sbig on entry,
!> and if 0 < scale * sqrt( sumsq ) < tsml then
!> we require: scale <= sqrt( HUGE ) / ssml on entry,
!> where
!> tbig -- upper threshold for values whose square is representable;
!> sbig -- scaling constant for big numbers; \see la_constants.f90
!> tsml -- lower threshold for values whose square is representable;
!> ssml -- scaling constant for small numbers; \see la_constants.f90
!> and
!> TINY*EPS -- tiniest representable number;
!> HUGE -- biggest representable number.
!>
!> \endverbatim
!
! Arguments:
Expand Down Expand Up @@ -200,13 +187,25 @@ subroutine SLASSQ( n, x, incx, scale, sumsq )
if( sumsq > zero ) then
ax = scale*sqrt( sumsq )
if (ax > tbig) then
! We assume scale >= sqrt( TINY*EPS ) / sbig
abig = abig + (scale*sbig)**2 * sumsq
if (scale > one) then
scale = scale * sbig
abig = abig + scale * (scale * sumsq)
else
! sumsq > tbig^2 => (sbig * (sbig * sumsq)) is representable
abig = abig + scale * (scale * (sbig * (sbig * sumsq)))
end if
else if (ax < tsml) then
! We assume scale <= sqrt( HUGE ) / ssml
if (notbig) asml = asml + (scale*ssml)**2 * sumsq
if (notbig) then
if (scale < one) then
scale = scale * ssml
asml = asml + scale * (scale * sumsq)
else
! sumsq < tsml^2 => (ssml * (ssml * sumsq)) is representable
asml = asml + scale * (scale * (ssml * (ssml * sumsq)))
end if
end if
else
amed = amed + scale**2 * sumsq
amed = amed + scale * (scale * sumsq)
end if
end if
!
Expand Down
35 changes: 17 additions & 18 deletions SRC/zlassq.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,19 +44,6 @@
!> scale and sumsq must be supplied in SCALE and SUMSQ and
!> scale_out and sumsq_out are overwritten on SCALE and SUMSQ respectively.
!>
!> If scale * sqrt( sumsq ) > tbig then
!> we require: scale >= sqrt( TINY*EPS ) / sbig on entry,
!> and if 0 < scale * sqrt( sumsq ) < tsml then
!> we require: scale <= sqrt( HUGE ) / ssml on entry,
!> where
!> tbig -- upper threshold for values whose square is representable;
!> sbig -- scaling constant for big numbers; \see la_constants.f90
!> tsml -- lower threshold for values whose square is representable;
!> ssml -- scaling constant for small numbers; \see la_constants.f90
!> and
!> TINY*EPS -- tiniest representable number;
!> HUGE -- biggest representable number.
!>
!> \endverbatim
!
! Arguments:
Expand Down Expand Up @@ -209,13 +196,25 @@ subroutine ZLASSQ( n, x, incx, scale, sumsq )
if( sumsq > zero ) then
ax = scale*sqrt( sumsq )
if (ax > tbig) then
! We assume scale >= sqrt( TINY*EPS ) / sbig
abig = abig + (scale*sbig)**2 * sumsq
if (scale > one) then
scale = scale * sbig
abig = abig + scale * (scale * sumsq)
else
! sumsq > tbig^2 => (sbig * (sbig * sumsq)) is representable
abig = abig + scale * (scale * (sbig * (sbig * sumsq)))
end if
else if (ax < tsml) then
! We assume scale <= sqrt( HUGE ) / ssml
if (notbig) asml = asml + (scale*ssml)**2 * sumsq
if (notbig) then
if (scale < one) then
scale = scale * ssml
asml = asml + scale * (scale * sumsq)
else
! sumsq < tsml^2 => (ssml * (ssml * sumsq)) is representable
asml = asml + scale * (scale * (ssml * (ssml * sumsq)))
end if
end if
else
amed = amed + scale**2 * sumsq
amed = amed + scale * (scale * sumsq)
end if
end if
!
Expand Down

0 comments on commit 02ea2d3

Please sign in to comment.