Commit faa73864 authored by Graham, Aaron's avatar Graham, Aaron
Browse files

Merge branch 'fpeTrap' into 'master'

Resolve invalid math

See merge request futility/Futility!334
parents 63ff98b2 e2a9eb09
Pipeline #154623 passed with stage
in 1 minute and 55 seconds
......@@ -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)
......
......@@ -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
!
......
......@@ -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(...)')
......
......@@ -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
!
!-------------------------------------------------------------------------------
......
......@@ -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
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment