phynexis-deps/lapack
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge pull request #1331 from ACSimon33/underflow_warning

Browse Source 
Avoid computing ONE / HUGE(ZERO) unless it is needed.
This commit is contained in:
langou
2026-07-22 10:49:23 -06:00
committed by GitHub
parent a23bdceb22 81d28e7b13
commit b11f5bd89d
2 changed files with 10 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files
INSTALL/dlamch.f
+5 -4
View File
@@ -83,7 +83,7 @@
PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
* ..
* .. Local Scalars ..
DOUBLE PRECISION RND, EPS, SFMIN, SMALL, RMACH
DOUBLE PRECISION RND, EPS, SFMIN, SMALL, HUGEVAL, RMACH
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -110,8 +110,9 @@
RMACH = EPS
ELSE IF( LSAME( CMACH, 'S' ) ) THEN
SFMIN = TINY(ZERO)
SMALL = ONE / HUGE(ZERO)
IF( SMALL.GE.SFMIN ) THEN
HUGEVAL = HUGE(ZERO)
IF( HUGEVAL*SFMIN.LE.ONE ) THEN
SMALL = ONE / HUGEVAL
*
* Use SMALL plus a bit, to avoid the possibility of rounding
* causing overflow when computing 1/sfmin.
@@ -130,7 +131,7 @@
ELSE IF( LSAME( CMACH, 'M' ) ) THEN
RMACH = MINEXPONENT(ZERO)
ELSE IF( LSAME( CMACH, 'U' ) ) THEN
RMACH = tiny(zero)
RMACH = TINY(ZERO)
ELSE IF( LSAME( CMACH, 'L' ) ) THEN
RMACH = MAXEXPONENT(ZERO)
ELSE IF( LSAME( CMACH, 'O' ) ) THEN
INSTALL/slamch.f
+5 -4
View File
@@ -82,7 +82,7 @@
PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
* ..
* .. Local Scalars ..
REAL RND, EPS, SFMIN, SMALL, RMACH
REAL RND, EPS, SFMIN, SMALL, HUGEVAL, RMACH
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -109,8 +109,9 @@
RMACH = EPS
ELSE IF( LSAME( CMACH, 'S' ) ) THEN
SFMIN = TINY(ZERO)
SMALL = ONE / HUGE(ZERO)
IF( SMALL.GE.SFMIN ) THEN
HUGEVAL = HUGE(ZERO)
IF( HUGEVAL*SFMIN.LE.ONE ) THEN
SMALL = ONE / HUGEVAL
*
* Use SMALL plus a bit, to avoid the possibility of rounding
* causing overflow when computing 1/sfmin.
@@ -129,7 +130,7 @@
ELSE IF( LSAME( CMACH, 'M' ) ) THEN
RMACH = MINEXPONENT(ZERO)
ELSE IF( LSAME( CMACH, 'U' ) ) THEN
RMACH = tiny(zero)
RMACH = TINY(ZERO)
ELSE IF( LSAME( CMACH, 'L' ) ) THEN
RMACH = MAXEXPONENT(ZERO)
ELSE IF( LSAME( CMACH, 'O' ) ) THEN