avoid floating point comparison
This commit is contained in:
parent
da15ff85f3
commit
78344c01ac
|
@ -111,7 +111,7 @@ pure function Lambert_CubeToBall(cube) result(ball)
|
|||
LamXYZ = [ T(order(2)) * q, T(order(1)) * q, pref * XYZ(3) - c ]
|
||||
endif special
|
||||
|
||||
! reverse the coordinates back to the regular order according to the original pyramid number
|
||||
! reverse the coordinates back to order according to the original pyramid number
|
||||
ball = LamXYZ(p)
|
||||
|
||||
endif center
|
||||
|
@ -165,7 +165,7 @@ pure function Lambert_BallToCube(xyz) result(cube)
|
|||
! inverse M_1
|
||||
xyz1 = [ Tinv(1), Tinv(2), sign(1.0_pReal,xyz3(3)) * rs / pref ] /sc
|
||||
|
||||
! reverst the coordinates back to the regular order according to the original pyramid number
|
||||
! reverse the coordinates back to order according to the original pyramid number
|
||||
cube = xyz1(p)
|
||||
|
||||
endif center
|
||||
|
|
|
@ -127,7 +127,7 @@ contains
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief doing self test
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine quaternions_init()
|
||||
subroutine quaternions_init
|
||||
|
||||
write(6,'(/,a)') ' <<<+- quaternions init -+>>>'
|
||||
call unitTest
|
||||
|
@ -482,39 +482,37 @@ subroutine unitTest
|
|||
real(pReal), dimension(4) :: qu
|
||||
|
||||
type(quaternion) :: q, q_2
|
||||
|
||||
|
||||
call random_number(qu)
|
||||
q = qu
|
||||
|
||||
q_2 = q + q
|
||||
if(any(q_2%asArray() /= 2.0_pReal*qu)) call IO_error(401,ext_msg='add__')
|
||||
if(any(dNeq(q_2%asArray(),2.0_pReal*qu))) call IO_error(401,ext_msg='add__')
|
||||
|
||||
q_2 = q - q
|
||||
if(any(q_2%asArray() /= [0.0_pReal,0.0_pReal,0.0_pReal,0.0_pReal])) &
|
||||
call IO_error(401,ext_msg='sub__')
|
||||
if(any(dNeq0(q_2%asArray()))) call IO_error(401,ext_msg='sub__')
|
||||
|
||||
q_2 = q * 5.0_preal
|
||||
if(any(q_2%asArray() /= 5.0_pReal*qu)) call IO_error(401,ext_msg='mul__')
|
||||
if(any(dNeq(q_2%asArray(),5.0_pReal*qu))) call IO_error(401,ext_msg='mul__')
|
||||
|
||||
q_2 = q / 0.5_preal
|
||||
if(any(q_2%asArray() /= 2.0_pReal*qu)) call IO_error(401,ext_msg='div__')
|
||||
if(any(dNeq(q_2%asArray(),2.0_pReal*qu))) call IO_error(401,ext_msg='div__')
|
||||
|
||||
q_2 = q
|
||||
if(q_2 /= q) call IO_error(401,ext_msg='eq__')
|
||||
if(q_2 /= q) call IO_error(401,ext_msg='eq__')
|
||||
|
||||
if(any(q%asArray() /= qu)) call IO_error(401,ext_msg='eq__')
|
||||
if(q%real() /= qu(1)) call IO_error(401,ext_msg='real()')
|
||||
if(any(q%aimag() /= qu(2:4))) call IO_error(401,ext_msg='aimag()')
|
||||
if(any(dNeq(q%asArray(),qu))) call IO_error(401,ext_msg='eq__')
|
||||
if(dNeq(q%real(), qu(1))) call IO_error(401,ext_msg='real()')
|
||||
if(any(dNeq(q%aimag(), qu(2:4)))) call IO_error(401,ext_msg='aimag()')
|
||||
|
||||
q_2 = q%homomorphed()
|
||||
if(q /= q_2*(-1.0_pReal)) call IO_error(401,ext_msg='homomorphed')
|
||||
if(q_2%real() /= qu(1)*(-1.0_pReal)) call IO_error(401,ext_msg='homomorphed/real')
|
||||
if(any(q_2%aimag() /= qu(2:4)*(-1.0_pReal))) call IO_error(401,ext_msg='homomorphed/aimag')
|
||||
if(q /= q_2* (-1.0_pReal)) call IO_error(401,ext_msg='homomorphed')
|
||||
if(dNeq(q_2%real(), qu(1)* (-1.0_pReal))) call IO_error(401,ext_msg='homomorphed/real')
|
||||
if(any(dNeq(q_2%aimag(),qu(2:4)*(-1.0_pReal)))) call IO_error(401,ext_msg='homomorphed/aimag')
|
||||
|
||||
q_2 = conjg(q)
|
||||
if(q_2%real() /= q%real()) call IO_error(401,ext_msg='conjg/real')
|
||||
if(any(q_2%aimag() /= q%aimag()*(-1.0_pReal))) call IO_error(401,ext_msg='conjg/aimag')
|
||||
|
||||
if(dNeq(q_2%real(), q%real())) call IO_error(401,ext_msg='conjg/real')
|
||||
if(any(dNeq(q_2%aimag(),q%aimag()*(-1.0_pReal)))) call IO_error(401,ext_msg='conjg/aimag')
|
||||
|
||||
end subroutine unitTest
|
||||
|
||||
|
|
|
@ -90,6 +90,7 @@ contains
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine rotations_init
|
||||
|
||||
call quaternions_init
|
||||
write(6,'(/,a)') ' <<<+- rotations init -+>>>'
|
||||
call unitTest
|
||||
|
||||
|
|
Loading…
Reference in New Issue