This commit is contained in:
Martin Diehl 2019-05-28 09:27:52 +02:00
parent 6283ffa024
commit 0db4264265
2 changed files with 168 additions and 168 deletions

View File

@ -15,7 +15,7 @@ module config
implicit none implicit none
private private
type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: &
config_phase, & config_phase, &
config_microstructure, & config_microstructure, &
config_homogenization, & config_homogenization, &

View File

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