Merge branch 'fpeTrap' into 'master'

Resolve invalid math

See merge request futility/Futility!334

src/Geom_Line.f90

@@ -359,7 +359,7 @@ ELEMENTAL FUNCTION distance_LineType_to_PointType(line,p) RESULT(d2)
   CLASS(LineType),INTENT(IN) :: line
   TYPE(PointType),INTENT(IN) :: p
   REAL(SRK) :: d2
-  d2=-1._SRK
+  d2=-HUGE(d2)
   IF(line%p1%dim == line%p2%dim .AND. line%p1%dim == p%dim) THEN
     SELECTCASE(p%dim)
     CASE(1)

src/Geom_Poly.f90

@@ -411,7 +411,11 @@ SUBROUTINE calcCentroid(this)
     ENDDO
   ENDIF
   CALL this%centroid%clear()
-  CALL this%centroid%init(DIM=2,X=xcent/this%area,Y=ycent/this%area)
+  IF(this%area > 0.0_SRK) THEN
+    CALL this%centroid%init(DIM=2,X=xcent/this%area,Y=ycent/this%area)
+  ELSEIF(this%area .APPROXEQ. 0.0_SRK) THEN
+    CALL this%centroid%init(DIM=2,X=xcent,Y=ycent)
+  ENDIF
 
 ENDSUBROUTINE calcCentroid
 !

unit_tests/testGeom_Line/testGeom_Line.f90

@@ -268,7 +268,7 @@ SUBROUTINE TestLine
   CALL line1%p1%init(COORD=(/0.0_SRK,0.0_SRK/))
   CALL line1%p2%init(COORD=(/1.0_SRK,1.0_SRK/))
   CALL point%init(COORD=(/-0.5_SRK/))
-  ASSERT(line1%distance2Point(point) == -1.0_SRK, '2-D line1%distance2Point(...)')
+  ASSERT(line1%distance2Point(point) == -HUGE(1.0_SRK), '2-D line1%distance2Point(...)')
   CALL point%clear()
   CALL point%init(COORD=(/0.5_SRK,0.5_SRK/))
   ASSERT(line1%distance2Point(point) .APPROXEQ. 0.0_SRK, '2-D line1%distance2Point(...)')

unit_tests/testIntrType/testIntrType.f90

@@ -516,31 +516,35 @@ ENDSUBROUTINE testSOFTCompare
 !-------------------------------------------------------------------------------
 SUBROUTINE testisNAN()
   LOGICAL(SBK) :: bool
+  CHARACTER(LEN=3) :: nanChar = 'NaN'
+  REAL(SDK) :: nanDouble
+  REAL(SSK) :: nanSingle
   COMPONENT_TEST('isNAN (DOUBLE PRECISION)')
-  doublefloat=-1.0_SDK
-  bool=.NOT.(.NOT.(isNAN(REAL(SQRT(doublefloat),SDK))) .OR. &
-                  (isNAN(REAL(SQRT(1.0_SDK),SDK))))
-  ASSERT(bool, 'isNAN(...) (DOUBLE PRECISION)')
+  READ(nanChar,*) nanDouble
+  ASSERT(isNAN(nanDouble), 'isNAN(...) (DOUBLE PRECISION)')
+  ASSERT(.NOT.(isNAN(REAL(SQRT(1.0_SDK),SDK))), 'isNAN(...) (DOUBLE PRECISION)')
+
   COMPONENT_TEST('isNAN (SINGLE PRECISION)')
-  singlefloat=-1.0_SSK
-  bool=.NOT.(.NOT.(isNAN(REAL(SQRT(singlefloat),SSK))) .OR. &
-                  (isNAN(REAL(SQRT(1.0_SSK),SSK))))
-  ASSERT(bool, 'isNAN(...) (SINGLE PRECISION)')
+  READ(nanChar,*) nanSingle
+  ASSERT(isNAN(nanSingle), 'isNAN(...) (SINGLE PRECISION)')
+  ASSERT(.NOT.(isNAN(REAL(SQRT(1.0_SSK),SSK))), 'isNAN(...) (SINGLE PRECISION)')
 ENDSUBROUTINE testisNAN
 !
 !-------------------------------------------------------------------------------
 SUBROUTINE testisINF()
   LOGICAL(SBK) :: bool
+  CHARACTER(LEN=3) :: infChar = 'Inf'
+  REAL(SDK) :: infDouble
+  REAL(SSK) :: infSingle
   COMPONENT_TEST('isInf (DOUBLE PRECISION)')
-  doublefloat=0.0_SDK
-  bool=.NOT.(.NOT.(isINF(REAL(1.0_SDK/doublefloat,SDK))) .OR. &
-                  (isINF(REAL(1.0_SDK,SDK))))
-  ASSERT(bool, 'isINF(...) (DOUBLE PRECISION)')
+  READ(infChar,*) infDouble
+  ASSERT(isINF(infDouble), 'isINF(...) (DOUBLE PRECISION)')
+  ASSERT(.NOT.(isINF(REAL(1.0_SDK,SDK))), 'isINF(...) (DOUBLE PRECISION)')
+
   COMPONENT_TEST('isInf (SINGLE PRECISION)')
-  singlefloat=0.0_SDK
-  bool=.NOT.(.NOT.(isINF(REAL(1.0_SSK/singlefloat,SSK))) .OR. &
-                  (isINF(REAL(1.0_SSK,SSK))))
-  ASSERT(bool, 'isINF(...) (SINGLE PRECISION)')
+  READ(infChar,*) infSingle
+  ASSERT(isINF(infSingle), 'isINF(...) (SINGLE PRECISION)')
+  ASSERT(.NOT.(isINF(REAL(1.0_SSK,SSK))), 'isINF(...) (SINGLE PRECISION)')
 ENDSUBROUTINE testisInf
 !
 !-------------------------------------------------------------------------------

unit_tests/testODESolver/testODESolver.f90

@@ -561,10 +561,12 @@ SUBROUTINE testOrderConv(exp_order,tol,ref,tag)
 
   DO i=1,3 ! reduction order
     DO j=1,3 ! solution index
-      bool=(ABS(exp_order-LOG10(tmp(j,i)/tmp(j,i+1)))<=tol .OR. ABS(tmp(j,i))<=1.0E-8)
-      ASSERT(bool,'Order Convergence: '//TRIM(tag))
-      FINFO() tmp(j,:)
-      FINFO() i,j,exp_order,LOG10(tmp(j,i)/tmp(j,i+1)),ABS(exp_order-LOG(tmp(j,i)/tmp(j,i+1)))
+      IF(.NOT.(tmp(j,i+1) .APPROXEQ. 0.0_SRK)) THEN
+        bool=(ABS(exp_order-LOG10(ABS(tmp(j,i)/tmp(j,i+1))))<=tol .OR. ABS(tmp(j,i))<=1.0E-8)
+        ASSERT(bool,'Order Convergence: '//TRIM(tag))
+        FINFO() tmp(j,:)
+        FINFO() i,j,exp_order,LOG10(tmp(j,i)/tmp(j,i+1)),ABS(exp_order-LOG(tmp(j,i)/tmp(j,i+1)))
+      ENDIF
     ENDDO
   ENDDO
 

unit_tests/testStrings/testStrings.f90

@@ -136,9 +136,6 @@ SUBROUTINE testAssign_nums()
   testSSK=1.01_SSK
   testString=testSSK
   ASSERT_EQ(CHAR(testString),'1.01000E+00','testSSK : 1')
-  testSSK=-testSSK
-  testString=SQRT(testSSK)
-  ASSERT_EQ(CHAR(testString),'NaN','testSSK : NaN')
   testString=-HUGE(testSSK)
   ASSERT_EQ(CHAR(testString),'-3.40282E+38','testSSK : lowest')
   testString=HUGE(testSSK)
@@ -157,9 +154,6 @@ SUBROUTINE testAssign_nums()
   testSDK=1.01_SDK
   testString=testSDK
   ASSERT_EQ(CHAR(testString),'1.010000000000000E+00','testSDK : 1.01')
-  testSDK=-testSDK
-  testString=SQRT(testSDK)
-  ASSERT_EQ(CHAR(testString),'NaN','testString=testSDK : NaN')
   !Since HUGE produces a triple digit exponent, it seems the 'E' disappears when
   !writing.
   testString=-HUGE(testSDK)