diff --git a/src/config.f90 b/src/config.f90 index 8729014ce..cd67c4641 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -15,7 +15,7 @@ module config implicit none private - type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & + type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & config_phase, & config_microstructure, & config_homogenization, & diff --git a/src/quaternions.f90 b/src/quaternions.f90 index 47490daba..dc894bdfa 100644 --- a/src/quaternions.f90 +++ b/src/quaternions.f90 @@ -3,27 +3,27 @@ ! Modified 2017-2019, Martin Diehl/Max-Planck-Institut für Eisenforschung GmbH ! All rights reserved. ! -! Redistribution and use in source and binary forms, with or without modification, are +! Redistribution and use in source and binary forms, with or without modification, are ! permitted provided that the following conditions are met: ! -! - Redistributions of source code must retain the above copyright notice, this list +! - Redistributions of source code must retain the above copyright notice, this list ! of conditions and the following disclaimer. -! - Redistributions in binary form must reproduce the above copyright notice, this -! list of conditions and the following disclaimer in the documentation and/or +! - Redistributions in binary form must reproduce the above copyright notice, this +! list of conditions and the following disclaimer in the documentation and/or ! other materials provided with the distribution. -! - Neither the names of Marc De Graef, Carnegie Mellon University nor the names -! of its contributors may be used to endorse or promote products derived from +! - Neither the names of Marc De Graef, Carnegie Mellon University nor the names +! of its contributors may be used to endorse or promote products derived from ! this software without specific prior written permission. ! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -! ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE -! LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +! ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +! LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE ! USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ! ################################################################### @@ -34,57 +34,57 @@ !> @details w is the real part, (x, y, z) are the imaginary parts. !--------------------------------------------------------------------------------------------------- module quaternions - use prec - use future + use prec + use future - implicit none - public - - real(pReal), parameter, public :: P = -1.0_pReal !< parameter for orientation conversion. - - type, public :: quaternion - real(pReal) :: w = 0.0_pReal - real(pReal) :: x = 0.0_pReal - real(pReal) :: y = 0.0_pReal - real(pReal) :: z = 0.0_pReal - + implicit none + public - contains - procedure, private :: add__ - procedure, private :: pos__ - generic, public :: operator(+) => add__,pos__ + real(pReal), parameter, public :: P = -1.0_pReal !< parameter for orientation conversion. - procedure, private :: sub__ - procedure, private :: neg__ - generic, public :: operator(-) => sub__,neg__ + type, public :: quaternion + real(pReal) :: w = 0.0_pReal + real(pReal) :: x = 0.0_pReal + real(pReal) :: y = 0.0_pReal + real(pReal) :: z = 0.0_pReal - procedure, private :: mul_quat__ - procedure, private :: mul_scal__ - generic, public :: operator(*) => mul_quat__, mul_scal__ - procedure, private :: div_quat__ - procedure, private :: div_scal__ - generic, public :: operator(/) => div_quat__, div_scal__ + contains + procedure, private :: add__ + procedure, private :: pos__ + generic, public :: operator(+) => add__,pos__ - procedure, private :: eq__ - generic, public :: operator(==) => eq__ + procedure, private :: sub__ + procedure, private :: neg__ + generic, public :: operator(-) => sub__,neg__ - procedure, private :: neq__ - generic, public :: operator(/=) => neq__ + procedure, private :: mul_quat__ + procedure, private :: mul_scal__ + generic, public :: operator(*) => mul_quat__, mul_scal__ - procedure, private :: pow_quat__ - procedure, private :: pow_scal__ - generic, public :: operator(**) => pow_quat__, pow_scal__ + procedure, private :: div_quat__ + procedure, private :: div_scal__ + generic, public :: operator(/) => div_quat__, div_scal__ - procedure, public :: abs__ - procedure, public :: dot_product__ - procedure, public :: conjg__ - procedure, public :: exp__ - procedure, public :: log__ + procedure, private :: eq__ + generic, public :: operator(==) => eq__ - procedure, public :: homomorphed => quat_homomorphed + procedure, private :: neq__ + generic, public :: operator(/=) => neq__ - end type + procedure, private :: pow_quat__ + procedure, private :: pow_scal__ + generic, public :: operator(**) => pow_quat__, pow_scal__ + + procedure, public :: abs__ + procedure, public :: dot_product__ + procedure, public :: conjg__ + procedure, public :: exp__ + procedure, public :: log__ + + procedure, public :: homomorphed => quat_homomorphed + + end type interface assignment (=) module procedure assign_quat__ @@ -123,12 +123,12 @@ contains !--------------------------------------------------------------------------------------------------- type(quaternion) pure function init__(array) - real(pReal), intent(in), dimension(4) :: array - - init__%w=array(1) - init__%x=array(2) - init__%y=array(3) - init__%z=array(4) + real(pReal), intent(in), dimension(4) :: array + + init__%w=array(1) + init__%x=array(2) + init__%y=array(3) + init__%z=array(4) end function init__ @@ -138,14 +138,14 @@ end function init__ !--------------------------------------------------------------------------------------------------- elemental subroutine assign_quat__(self,other) - type(quaternion), intent(out) :: self - type(quaternion), intent(in) :: other - - self%w = other%w - self%x = other%x - self%y = other%y - self%z = other%z - + type(quaternion), intent(out) :: self + type(quaternion), intent(in) :: other + + self%w = other%w + self%x = other%x + self%y = other%y + self%z = other%z + end subroutine assign_quat__ @@ -154,14 +154,14 @@ end subroutine assign_quat__ !--------------------------------------------------------------------------------------------------- pure subroutine assign_vec__(self,other) - type(quaternion), intent(out) :: self - real(pReal), intent(in), dimension(4) :: other - - self%w = other(1) - self%x = other(2) - self%y = other(3) - self%z = other(4) - + type(quaternion), intent(out) :: self + real(pReal), intent(in), dimension(4) :: other + + self%w = other(1) + self%x = other(2) + self%y = other(3) + self%z = other(4) + end subroutine assign_vec__ @@ -170,13 +170,13 @@ end subroutine assign_vec__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function add__(self,other) - class(quaternion), intent(in) :: self,other - - add__%w = self%w + other%w - add__%x = self%x + other%x - add__%y = self%y + other%y - add__%z = self%z + other%z - + class(quaternion), intent(in) :: self,other + + add__%w = self%w + other%w + add__%x = self%x + other%x + add__%y = self%y + other%y + add__%z = self%z + other%z + end function add__ @@ -185,13 +185,13 @@ end function add__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function pos__(self) - class(quaternion), intent(in) :: self - - pos__%w = self%w - pos__%x = self%x - pos__%y = self%y - pos__%z = self%z - + class(quaternion), intent(in) :: self + + pos__%w = self%w + pos__%x = self%x + pos__%y = self%y + pos__%z = self%z + end function pos__ @@ -200,13 +200,13 @@ end function pos__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function sub__(self,other) - class(quaternion), intent(in) :: self,other - - sub__%w = self%w - other%w - sub__%x = self%x - other%x - sub__%y = self%y - other%y - sub__%z = self%z - other%z - + class(quaternion), intent(in) :: self,other + + sub__%w = self%w - other%w + sub__%x = self%x - other%x + sub__%y = self%y - other%y + sub__%z = self%z - other%z + end function sub__ @@ -215,13 +215,13 @@ end function sub__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function neg__(self) - class(quaternion), intent(in) :: self - - neg__%w = -self%w - neg__%x = -self%x - neg__%y = -self%y - neg__%z = -self%z - + class(quaternion), intent(in) :: self + + neg__%w = -self%w + neg__%x = -self%x + neg__%y = -self%y + neg__%z = -self%z + end function neg__ @@ -230,13 +230,13 @@ end function neg__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function mul_quat__(self,other) - class(quaternion), intent(in) :: self, other + class(quaternion), intent(in) :: self, other + + mul_quat__%w = self%w*other%w - self%x*other%x - self%y*other%y - self%z*other%z + mul_quat__%x = self%w*other%x + self%x*other%w + P * (self%y*other%z - self%z*other%y) + mul_quat__%y = self%w*other%y + self%y*other%w + P * (self%z*other%x - self%x*other%z) + mul_quat__%z = self%w*other%z + self%z*other%w + P * (self%x*other%y - self%y*other%x) - mul_quat__%w = self%w*other%w - self%x*other%x - self%y*other%y - self%z*other%z - mul_quat__%x = self%w*other%x + self%x*other%w + P * (self%y*other%z - self%z*other%y) - mul_quat__%y = self%w*other%y + self%y*other%w + P * (self%z*other%x - self%x*other%z) - mul_quat__%z = self%w*other%z + self%z*other%w + P * (self%x*other%y - self%y*other%x) - end function mul_quat__ @@ -245,14 +245,14 @@ end function mul_quat__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function mul_scal__(self,scal) - class(quaternion), intent(in) :: self - real(pReal), intent(in) :: scal + class(quaternion), intent(in) :: self + real(pReal), intent(in) :: scal + + mul_scal__%w = self%w*scal + mul_scal__%x = self%x*scal + mul_scal__%y = self%y*scal + mul_scal__%z = self%z*scal - mul_scal__%w = self%w*scal - mul_scal__%x = self%x*scal - mul_scal__%y = self%y*scal - mul_scal__%z = self%z*scal - end function mul_scal__ @@ -261,9 +261,9 @@ end function mul_scal__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function div_quat__(self,other) - class(quaternion), intent(in) :: self, other + class(quaternion), intent(in) :: self, other - div_quat__ = self * (conjg(other)/(abs(other)**2.0_pReal)) + div_quat__ = self * (conjg(other)/(abs(other)**2.0_pReal)) end function div_quat__ @@ -273,10 +273,10 @@ end function div_quat__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function div_scal__(self,scal) - class(quaternion), intent(in) :: self - real(pReal), intent(in) :: scal + class(quaternion), intent(in) :: self + 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 end function div_scal__ @@ -286,11 +286,11 @@ end function div_scal__ !--------------------------------------------------------------------------------------------------- logical elemental function eq__(self,other) - class(quaternion), intent(in) :: self,other + class(quaternion), intent(in) :: self,other + + eq__ = all(dEq([ self%w, self%x, self%y, self%z], & + [other%w,other%x,other%y,other%z])) - eq__ = all(dEq([ self%w, self%x, self%y, self%z], & - [other%w,other%x,other%y,other%z])) - end function eq__ @@ -299,10 +299,10 @@ end function eq__ !--------------------------------------------------------------------------------------------------- logical elemental function neq__(self,other) - class(quaternion), intent(in) :: self,other + class(quaternion), intent(in) :: self,other + + neq__ = .not. self%eq__(other) - neq__ = .not. self%eq__(other) - end function neq__ @@ -311,11 +311,11 @@ end function neq__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function pow_scal__(self,expon) - class(quaternion), intent(in) :: self - real(pReal), intent(in) :: expon - - pow_scal__ = exp(log(self)*expon) - + class(quaternion), intent(in) :: self + real(pReal), intent(in) :: expon + + pow_scal__ = exp(log(self)*expon) + end function pow_scal__ @@ -324,11 +324,11 @@ end function pow_scal__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function pow_quat__(self,expon) - class(quaternion), intent(in) :: self - type(quaternion), intent(in) :: expon - - pow_quat__ = exp(log(self)*expon) - + class(quaternion), intent(in) :: self + type(quaternion), intent(in) :: expon + + pow_quat__ = exp(log(self)*expon) + end function pow_quat__ @@ -338,15 +338,15 @@ end function pow_quat__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function exp__(self) - class(quaternion), intent(in) :: self - real(pReal) :: absImag + class(quaternion), intent(in) :: self + real(pReal) :: absImag - absImag = norm2([self%x, self%y, self%z]) + absImag = norm2([self%x, self%y, self%z]) - exp__ = exp(self%w) * [ cos(absImag), & - self%x/absImag * sin(absImag), & - self%y/absImag * sin(absImag), & - self%z/absImag * sin(absImag)] + exp__ = exp(self%w) * [ cos(absImag), & + self%x/absImag * sin(absImag), & + self%y/absImag * sin(absImag), & + self%z/absImag * sin(absImag)] end function exp__ @@ -357,16 +357,16 @@ end function exp__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function log__(self) - class(quaternion), intent(in) :: self - real(pReal) :: absImag + class(quaternion), intent(in) :: self + real(pReal) :: absImag - absImag = norm2([self%x, self%y, self%z]) + absImag = norm2([self%x, self%y, self%z]) + + log__ = [log(abs(self)), & + self%x/absImag * acos(self%w/abs(self)), & + self%y/absImag * acos(self%w/abs(self)), & + self%z/absImag * acos(self%w/abs(self))] - log__ = [log(abs(self)), & - self%x/absImag * acos(self%w/abs(self)), & - self%y/absImag * acos(self%w/abs(self)), & - self%z/absImag * acos(self%w/abs(self))] - end function log__ @@ -375,10 +375,10 @@ end function log__ !--------------------------------------------------------------------------------------------------- real(pReal) elemental function abs__(a) - class(quaternion), intent(in) :: a + class(quaternion), intent(in) :: a + + abs__ = norm2([a%w,a%x,a%y,a%z]) - abs__ = norm2([a%w,a%x,a%y,a%z]) - end function abs__ @@ -387,10 +387,10 @@ end function abs__ !--------------------------------------------------------------------------------------------------- real(pReal) elemental function dot_product__(a,b) - class(quaternion), intent(in) :: a,b + class(quaternion), intent(in) :: a,b + + dot_product__ = a%w*b%w + a%x*b%x + a%y*b%y + a%z*b%z - dot_product__ = a%w*b%w + a%x*b%x + a%y*b%y + a%z*b%z - end function dot_product__ @@ -399,10 +399,10 @@ end function dot_product__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function conjg__(a) - class(quaternion), intent(in) :: a + class(quaternion), intent(in) :: a + + conjg__ = quaternion([a%w, -a%x, -a%y, -a%z]) - conjg__ = quaternion([a%w, -a%x, -a%y, -a%z]) - end function conjg__ @@ -411,10 +411,10 @@ end function conjg__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function quat_homomorphed(a) - class(quaternion), intent(in) :: a + class(quaternion), intent(in) :: a + + quat_homomorphed = quaternion(-[a%w,a%x,a%y,a%z]) - quat_homomorphed = quaternion(-[a%w,a%x,a%y,a%z]) - end function quat_homomorphed end module quaternions