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
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue