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

10
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
@ -513,6 +514,7 @@ subroutine unitTest
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()')
@ -524,6 +526,8 @@ subroutine unitTest
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(abs(q),abs(q_2))) call IO_error(401,ext_msg='conjg/abs')
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(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(any(dNeq(q_2%aimag(),q%aimag()*(-1.0_pReal)))) call IO_error(401,ext_msg='conjg/aimag')
@ -531,6 +535,10 @@ subroutine unitTest
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