always using intrinsic init when assigning quaternions as output variables
This commit is contained in:
parent
0fdc880e2c
commit
3a08a8bbe2
|
@ -142,32 +142,29 @@ type(quaternion) pure function init__(array)
|
||||||
|
|
||||||
real(pReal), intent(in), dimension(4) :: array
|
real(pReal), intent(in), dimension(4) :: array
|
||||||
|
|
||||||
init__%w=array(1)
|
init__%w = array(1)
|
||||||
init__%x=array(2)
|
init__%x = array(2)
|
||||||
init__%y=array(3)
|
init__%y = array(3)
|
||||||
init__%z=array(4)
|
init__%z = array(4)
|
||||||
|
|
||||||
end function init__
|
end function init__
|
||||||
|
|
||||||
|
|
||||||
!---------------------------------------------------------------------------------------------------
|
!---------------------------------------------------------------------------------------------------
|
||||||
!> assing a quaternion
|
!> assigning a quaternion
|
||||||
!---------------------------------------------------------------------------------------------------
|
!---------------------------------------------------------------------------------------------------
|
||||||
elemental pure subroutine assign_quat__(self,other)
|
elemental pure subroutine assign_quat__(self,other)
|
||||||
|
|
||||||
type(quaternion), intent(out) :: self
|
type(quaternion), intent(out) :: self
|
||||||
type(quaternion), intent(in) :: other
|
type(quaternion), intent(in) :: other
|
||||||
|
|
||||||
self%w = other%w
|
self = [other%w,other%x,other%y,other%z]
|
||||||
self%x = other%x
|
|
||||||
self%y = other%y
|
|
||||||
self%z = other%z
|
|
||||||
|
|
||||||
end subroutine assign_quat__
|
end subroutine assign_quat__
|
||||||
|
|
||||||
|
|
||||||
!---------------------------------------------------------------------------------------------------
|
!---------------------------------------------------------------------------------------------------
|
||||||
!> assing a 4-vector
|
!> assigning a 4-vector
|
||||||
!---------------------------------------------------------------------------------------------------
|
!---------------------------------------------------------------------------------------------------
|
||||||
pure subroutine assign_vec__(self,other)
|
pure subroutine assign_vec__(self,other)
|
||||||
|
|
||||||
|
@ -189,10 +186,7 @@ type(quaternion) elemental pure function add__(self,other)
|
||||||
|
|
||||||
class(quaternion), intent(in) :: self,other
|
class(quaternion), intent(in) :: self,other
|
||||||
|
|
||||||
add__%w = self%w + other%w
|
add__ = [self%w + other%w,self%x + other%x,self%y + other%y,self%z + other%z]
|
||||||
add__%x = self%x + other%x
|
|
||||||
add__%y = self%y + other%y
|
|
||||||
add__%z = self%z + other%z
|
|
||||||
|
|
||||||
end function add__
|
end function add__
|
||||||
|
|
||||||
|
@ -204,10 +198,7 @@ type(quaternion) elemental pure function pos__(self)
|
||||||
|
|
||||||
class(quaternion), intent(in) :: self
|
class(quaternion), intent(in) :: self
|
||||||
|
|
||||||
pos__%w = self%w
|
pos__ = [self%w,self%x,self%y,self%z]
|
||||||
pos__%x = self%x
|
|
||||||
pos__%y = self%y
|
|
||||||
pos__%z = self%z
|
|
||||||
|
|
||||||
end function pos__
|
end function pos__
|
||||||
|
|
||||||
|
@ -219,25 +210,19 @@ type(quaternion) elemental pure function sub__(self,other)
|
||||||
|
|
||||||
class(quaternion), intent(in) :: self,other
|
class(quaternion), intent(in) :: self,other
|
||||||
|
|
||||||
sub__%w = self%w - other%w
|
sub__ = [self%w - other%w,self%x - other%x,self%y - other%y,self%z - other%z]
|
||||||
sub__%x = self%x - other%x
|
|
||||||
sub__%y = self%y - other%y
|
|
||||||
sub__%z = self%z - other%z
|
|
||||||
|
|
||||||
end function sub__
|
end function sub__
|
||||||
|
|
||||||
|
|
||||||
!---------------------------------------------------------------------------------------------------
|
!---------------------------------------------------------------------------------------------------
|
||||||
!> unary positive operator
|
!> unary negative operator
|
||||||
!---------------------------------------------------------------------------------------------------
|
!---------------------------------------------------------------------------------------------------
|
||||||
type(quaternion) elemental pure function neg__(self)
|
type(quaternion) elemental pure function neg__(self)
|
||||||
|
|
||||||
class(quaternion), intent(in) :: self
|
class(quaternion), intent(in) :: self
|
||||||
|
|
||||||
neg__%w = -self%w
|
neg__ = [-self%w,-self%x,-self%y,-self%z]
|
||||||
neg__%x = -self%x
|
|
||||||
neg__%y = -self%y
|
|
||||||
neg__%z = -self%z
|
|
||||||
|
|
||||||
end function neg__
|
end function neg__
|
||||||
|
|
||||||
|
@ -258,17 +243,14 @@ end function mul_quat__
|
||||||
|
|
||||||
|
|
||||||
!---------------------------------------------------------------------------------------------------
|
!---------------------------------------------------------------------------------------------------
|
||||||
!> multiplication of quaternions with scalar
|
!> multiplication of quaternion with scalar
|
||||||
!---------------------------------------------------------------------------------------------------
|
!---------------------------------------------------------------------------------------------------
|
||||||
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__%w = self%w*scal
|
mul_scal__ = [self%w,self%x,self%y,self%z]*scal
|
||||||
mul_scal__%x = self%x*scal
|
|
||||||
mul_scal__%y = self%y*scal
|
|
||||||
mul_scal__%z = self%z*scal
|
|
||||||
|
|
||||||
end function mul_scal__
|
end function mul_scal__
|
||||||
|
|
||||||
|
@ -418,7 +400,7 @@ type(quaternion) elemental pure function conjg__(a)
|
||||||
|
|
||||||
class(quaternion), intent(in) :: a
|
class(quaternion), intent(in) :: a
|
||||||
|
|
||||||
conjg__ = quaternion([a%w, -a%x, -a%y, -a%z])
|
conjg__ = [a%w, -a%x, -a%y, -a%z]
|
||||||
|
|
||||||
end function conjg__
|
end function conjg__
|
||||||
|
|
||||||
|
@ -430,7 +412,7 @@ type(quaternion) elemental pure function quat_homomorphed(self)
|
||||||
|
|
||||||
class(quaternion), intent(in) :: self
|
class(quaternion), intent(in) :: self
|
||||||
|
|
||||||
quat_homomorphed = quaternion(-[self%w,self%x,self%y,self%z])
|
quat_homomorphed = -[self%w,self%x,self%y,self%z]
|
||||||
|
|
||||||
end function quat_homomorphed
|
end function quat_homomorphed
|
||||||
|
|
||||||
|
@ -444,6 +426,7 @@ pure function asArray(self)
|
||||||
class(quaternion), intent(in) :: self
|
class(quaternion), intent(in) :: self
|
||||||
|
|
||||||
asArray = [self%w,self%x,self%y,self%z]
|
asArray = [self%w,self%x,self%y,self%z]
|
||||||
|
if (self%w < 0) asArray = -asArray
|
||||||
|
|
||||||
end function asArray
|
end function asArray
|
||||||
|
|
||||||
|
@ -484,6 +467,7 @@ subroutine unitTest
|
||||||
type(quaternion) :: q, q_2
|
type(quaternion) :: q, q_2
|
||||||
|
|
||||||
call random_number(qu)
|
call random_number(qu)
|
||||||
|
if (qu(1) < 0.0_pReal) qu = -qu
|
||||||
q = qu
|
q = qu
|
||||||
|
|
||||||
q_2 = q + q
|
q_2 = q + q
|
||||||
|
@ -492,10 +476,10 @@ subroutine unitTest
|
||||||
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
|
q_2 = q
|
||||||
|
|
Loading…
Reference in New Issue