223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

some facts from wikipedia as tests

This commit is contained in:
Martin Diehl 2020-01-11 04:44:30 +01:00
parent de95ca5906
commit f028519597
1 changed files with 29 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
src/quaternions.f90
View File

@ -79,9 +79,9 @@ module quaternions
procedure, public :: abs__ procedure, public :: abs__
procedure, public :: dot_product__ procedure, public :: dot_product__
procedure, public :: conjg__
procedure, public :: exp__ procedure, public :: exp__
procedure, public :: log__ procedure, public :: log__
procedure, public :: conjg => conjg__
procedure, public :: real => real__ procedure, public :: real => real__
procedure, public :: aimag => aimag__ procedure, public :: aimag => aimag__
@ -138,6 +138,7 @@ contains
!> @brief do self test !> @brief do self test
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine quaternions_init subroutine quaternions_init
write(6,'(/,a)') ' <<<+- quaternions init -+>>>'; flush(6) write(6,'(/,a)') ' <<<+- quaternions init -+>>>'; flush(6)
call unitTest call unitTest
@ -259,7 +260,7 @@ end function mul_quat__
type(quaternion) elemental pure function mul_scal__(self,scal) type(quaternion) elemental pure function mul_scal__(self,scal)
class(quaternion), intent(in) :: self class(quaternion), intent(in) :: self
real(pReal), intent(in) :: scal real(pReal), intent(in) :: scal
mul_scal__ = [self%w,self%x,self%y,self%z]*scal mul_scal__ = [self%w,self%x,self%y,self%z]*scal
@ -284,7 +285,7 @@ end function div_quat__
type(quaternion) elemental pure function div_scal__(self,scal) type(quaternion) elemental pure function div_scal__(self,scal)
class(quaternion), intent(in) :: self class(quaternion), intent(in) :: self
real(pReal), intent(in) :: scal real(pReal), intent(in) :: scal
div_scal__ = [self%w,self%x,self%y,self%z]/scal div_scal__ = [self%w,self%x,self%y,self%z]/scal
@ -492,50 +493,57 @@ subroutine unitTest
q = quaternion(qu) q = quaternion(qu)
q_2= qu q_2= qu
if(any(dNeq(q%asArray(),q_2%asArray()))) call IO_error(401,ext_msg='assign_vec__') if(any(dNeq(q%asArray(),q_2%asArray()))) call IO_error(401,ext_msg='assign_vec__')
q_2 = q + q q_2 = q + q
if(any(dNeq(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 q_2 = q - q
if(any(dNeq0(q_2%asArray()))) 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 q_2 = q * 5.0_pReal
if(any(dNeq(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 q_2 = q / 0.5_pReal
if(any(dNeq(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 * 0.3_pReal q_2 = q * 0.3_pReal
if(dNeq0(abs(q)) .and. q_2 == q) call IO_error(401,ext_msg='eq__') if(dNeq0(abs(q)) .and. q_2 == q) call IO_error(401,ext_msg='eq__')
q_2 = q q_2 = q
if(q_2 /= q) call IO_error(401,ext_msg='neq__') if(q_2 /= q) call IO_error(401,ext_msg='neq__')
if(dNeq(abs(q),norm2(qu))) call IO_error(401,ext_msg='abs__') if(dNeq(abs(q),norm2(qu))) call IO_error(401,ext_msg='abs__')
if(dNeq(abs(q)**2.0_pReal, real(q*q%conjg()))) call IO_error(401,ext_msg='abs__/*conjg')
if(any(dNeq(q%asArray(),qu))) call IO_error(401,ext_msg='eq__') 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(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()') if(any(dNeq(q%aimag(), qu(2:4)))) call IO_error(401,ext_msg='aimag()')
q_2 = q%homomorphed() q_2 = q%homomorphed()
if(q /= q_2* (-1.0_pReal)) call IO_error(401,ext_msg='homomorphed') 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(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') if(any(dNeq(q_2%aimag(),qu(2:4)*(-1.0_pReal)))) call IO_error(401,ext_msg='homomorphed/aimag')
q_2 = conjg(q) q_2 = conjg(q)
if(dNeq(q_2%real(), q%real())) call IO_error(401,ext_msg='conjg/real') if(dNeq(abs(q),abs(q_2))) call IO_error(401,ext_msg='conjg/abs')
if(any(dNeq(q_2%aimag(),q%aimag()*(-1.0_pReal)))) call IO_error(401,ext_msg='conjg/aimag') if(q /= conjg(q_2)) call IO_error(401,ext_msg='conjg/involution')
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')
if(abs(q) > 0.0_pReal) then if(abs(q) > 0.0_pReal) then
q_2 = q * q%inverse() q_2 = q * q%inverse()
if( dNeq(real(q_2), 1.0_pReal,1.0e-15_pReal)) call IO_error(401,ext_msg='inverse/real') if( dNeq(real(q_2), 1.0_pReal,1.0e-15_pReal)) call IO_error(401,ext_msg='inverse/real')
if(any(dNeq0(aimag(q_2), 1.0e-15_pReal))) call IO_error(401,ext_msg='inverse/aimag') if(any(dNeq0(aimag(q_2), 1.0e-15_pReal))) call IO_error(401,ext_msg='inverse/aimag')
q_2 = q/abs(q)
q_2 = conjg(q_2) - inverse(q_2)
if(any(dNeq0(q_2%asArray(),1.0e-15_pReal))) call IO_error(401,ext_msg='inverse/conjg')
endif endif
if (norm2(aimag(q)) * abs(real(q)) > 0.0_pReal) then if (norm2(aimag(q)) * abs(real(q)) > 0.0_pReal) then
if (dNeq0(abs(q-exp(log(q))),1.0e-13_pReal)) call IO_error(401,ext_msg='exp/log') if (dNeq0(abs(q-exp(log(q))),1.0e-13_pReal)) call IO_error(401,ext_msg='exp/log')
if (dNeq0(abs(q-log(exp(q))),1.0e-13_pReal)) call IO_error(401,ext_msg='log/exp') if (dNeq0(abs(q-log(exp(q))),1.0e-13_pReal)) call IO_error(401,ext_msg='log/exp')
endif endif
end subroutine unitTest end subroutine unitTest