same functionality but tested

This commit is contained in:
Martin Diehl 2019-12-02 12:58:23 +01:00
parent 2969a53338
commit 8189b50509
2 changed files with 6 additions and 36 deletions

View File

@ -838,33 +838,6 @@ pure function math_Voigt66to3333(m66)
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)
!> @details deprecated

View File

@ -1836,8 +1836,6 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e)
ns, & ! number of active slip systems
s1, & ! slip system index (me)
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))),&
totalNslip(phase_plasticityInstance(material_phaseAt(1,e))),&
nIPneighbors) :: &
@ -1848,7 +1846,7 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e)
nThresholdValues
logical, dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,e)))) :: &
belowThreshold
type(rotation) :: rot
type(rotation) :: mis
Nneighbors = nIPneighbors
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.
!* All values below the threshold are set to zero.
else
rot = orientation(1,i,e)%misorientation(orientation(1,neighbor_i,neighbor_e))
absoluteMisorientation = rot%asQuaternion()
mis = orientation(1,i,e)%misorientation(orientation(1,neighbor_i,neighbor_e))
mySlipSystems: do s1 = 1,ns
neighborSlipSystems: do s2 = 1,ns
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), &
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), &
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), &
math_qRot(absoluteMisorientation, prm%slip_direction(1:3,s2))))
mis%rotate(prm%slip_direction(1:3,s2))))
enddo neighborSlipSystems
my_compatibilitySum = 0.0_pReal