same functionality but tested
This commit is contained in:
parent
2969a53338
commit
8189b50509
27
src/math.f90
27
src/math.f90
|
@ -838,33 +838,6 @@ pure function math_Voigt66to3333(m66)
|
||||||
end function math_Voigt66to3333
|
end function math_Voigt66to3333
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
!> @brief action of a quaternion on a vector (rotate vector v with Q)
|
|
||||||
!> @details deprecated
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
|
||||||
pure function math_qRot(Q,v)
|
|
||||||
|
|
||||||
real(pReal), dimension(4), intent(in) :: Q
|
|
||||||
real(pReal), dimension(3), intent(in) :: v
|
|
||||||
real(pReal), dimension(3) :: math_qRot
|
|
||||||
real(pReal), dimension(4,4) :: T
|
|
||||||
integer :: i, j
|
|
||||||
|
|
||||||
do i = 1,4
|
|
||||||
do j = 1,i
|
|
||||||
T(i,j) = Q(i) * Q(j)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
math_qRot = [-v(1)*(T(3,3)+T(4,4)) + v(2)*(T(3,2)-T(4,1)) + v(3)*(T(4,2)+T(3,1)), &
|
|
||||||
v(1)*(T(3,2)+T(4,1)) - v(2)*(T(2,2)+T(4,4)) + v(3)*(T(4,3)-T(2,1)), &
|
|
||||||
v(1)*(T(4,2)-T(3,1)) + v(2)*(T(4,3)+T(2,1)) - v(3)*(T(2,2)+T(3,3))]
|
|
||||||
|
|
||||||
math_qRot = 2.0_pReal * math_qRot + v
|
|
||||||
|
|
||||||
end function math_qRot
|
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief rotation matrix from Bunge-Euler (3-1-3) angles (in radians)
|
!> @brief rotation matrix from Bunge-Euler (3-1-3) angles (in radians)
|
||||||
!> @details deprecated
|
!> @details deprecated
|
||||||
|
|
|
@ -1836,8 +1836,6 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e)
|
||||||
ns, & ! number of active slip systems
|
ns, & ! number of active slip systems
|
||||||
s1, & ! slip system index (me)
|
s1, & ! slip system index (me)
|
||||||
s2 ! slip system index (my neighbor)
|
s2 ! slip system index (my neighbor)
|
||||||
real(pReal), dimension(4) :: &
|
|
||||||
absoluteMisorientation ! absolute misorientation (without symmetry) between me and my neighbor
|
|
||||||
real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phaseAt(1,e))),&
|
real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phaseAt(1,e))),&
|
||||||
totalNslip(phase_plasticityInstance(material_phaseAt(1,e))),&
|
totalNslip(phase_plasticityInstance(material_phaseAt(1,e))),&
|
||||||
nIPneighbors) :: &
|
nIPneighbors) :: &
|
||||||
|
@ -1848,7 +1846,7 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e)
|
||||||
nThresholdValues
|
nThresholdValues
|
||||||
logical, dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,e)))) :: &
|
logical, dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,e)))) :: &
|
||||||
belowThreshold
|
belowThreshold
|
||||||
type(rotation) :: rot
|
type(rotation) :: mis
|
||||||
|
|
||||||
Nneighbors = nIPneighbors
|
Nneighbors = nIPneighbors
|
||||||
ph = material_phaseAt(1,e)
|
ph = material_phaseAt(1,e)
|
||||||
|
@ -1914,18 +1912,17 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e)
|
||||||
!* Finally the smallest compatibility value is decreased until the sum is exactly equal to one.
|
!* Finally the smallest compatibility value is decreased until the sum is exactly equal to one.
|
||||||
!* All values below the threshold are set to zero.
|
!* All values below the threshold are set to zero.
|
||||||
else
|
else
|
||||||
rot = orientation(1,i,e)%misorientation(orientation(1,neighbor_i,neighbor_e))
|
mis = orientation(1,i,e)%misorientation(orientation(1,neighbor_i,neighbor_e))
|
||||||
absoluteMisorientation = rot%asQuaternion()
|
|
||||||
mySlipSystems: do s1 = 1,ns
|
mySlipSystems: do s1 = 1,ns
|
||||||
neighborSlipSystems: do s2 = 1,ns
|
neighborSlipSystems: do s2 = 1,ns
|
||||||
my_compatibility(1,s2,s1,n) = math_inner(prm%slip_normal(1:3,s1), &
|
my_compatibility(1,s2,s1,n) = math_inner(prm%slip_normal(1:3,s1), &
|
||||||
math_qRot(absoluteMisorientation, prm%slip_normal(1:3,s2))) &
|
mis%rotate(prm%slip_normal(1:3,s2))) &
|
||||||
* abs(math_inner(prm%slip_direction(1:3,s1), &
|
* abs(math_inner(prm%slip_direction(1:3,s1), &
|
||||||
math_qRot(absoluteMisorientation, prm%slip_direction(1:3,s2))))
|
mis%rotate(prm%slip_direction(1:3,s2))))
|
||||||
my_compatibility(2,s2,s1,n) = abs(math_inner(prm%slip_normal(1:3,s1), &
|
my_compatibility(2,s2,s1,n) = abs(math_inner(prm%slip_normal(1:3,s1), &
|
||||||
math_qRot(absoluteMisorientation, prm%slip_normal(1:3,s2)))) &
|
mis%rotate(prm%slip_normal(1:3,s2)))) &
|
||||||
* abs(math_inner(prm%slip_direction(1:3,s1), &
|
* abs(math_inner(prm%slip_direction(1:3,s1), &
|
||||||
math_qRot(absoluteMisorientation, prm%slip_direction(1:3,s2))))
|
mis%rotate(prm%slip_direction(1:3,s2))))
|
||||||
enddo neighborSlipSystems
|
enddo neighborSlipSystems
|
||||||
|
|
||||||
my_compatibilitySum = 0.0_pReal
|
my_compatibilitySum = 0.0_pReal
|
||||||
|
|
Loading…
Reference in New Issue