further simpilifcations

This commit is contained in:
Martin Diehl 2016-02-26 19:37:10 +01:00
parent 17e75a1e0b
commit ca3e1f0da0
2 changed files with 12 additions and 38 deletions

View File

@ -2010,12 +2010,12 @@ function math_spectralDecompositionSym33(m)
implicit none
real(pReal), dimension(3,3) :: math_spectralDecompositionSym33
real(pReal), dimension(3) :: invariants, values
real(pReal), dimension(3) :: invariants, values,C
real(pReal), dimension(3,3), intent(in) :: m
real(pReal) :: P, Q, rho, phi, D1, D2, D3
real(pReal) :: P, Q, rho, phi
real(pReal), parameter :: TOL=1.e-14_pReal
real(pReal), dimension(3,3) :: M1, M2, M3,EB1, EB2, EB3
real(pReal) C1,C2,C3
real(pReal) :: D1, D2, D3
invariants = math_invariantsSym33(m)
@ -2025,8 +2025,7 @@ function math_spectralDecompositionSym33(m)
EB1=0.0_pReal
EB2=0.0_pReal
EB3=0.0_pReal
if((ABS(P) < TOL).AND.(ABS(Q) < TOL)) then
! DREI GLEICHE EIGENWERTE
if((ABS(P) < TOL).AND.(ABS(Q) < TOL)) then ! EV_2 = EV_1 = EV_3
values = invariants(1)/3.0_pReal
! this is not really correct, but this way U is calculated
! correctly in PDECOMPOSITION (correct is EB?=I)
@ -2041,49 +2040,26 @@ function math_spectralDecompositionSym33(m)
cos((phi+2.0_pReal*PI)/3.0_pReal), &
cos((phi+4.0_pReal*PI)/3.0_pReal) &
] + invariants(1)/3.0_pReal
C1=ABS(values(1)-values(2))
C2=ABS(values(2)-values(3))
C3=ABS(values(3)-values(1))
if (C1 < TOL) then
! values(1) is equal to values(2)
C = abs([values(1)-values(2),values(2)-values(3),values(3)-values(1)])
M1=M-values(1)*math_I3
M2=M-values(2)*math_I3
M3=M-values(3)*math_I3
if (C(1) < TOL) then ! EV_2 = EV_1, no contribution from EV_2
D3=1.0_pReal/(values(3)-values(1))/(values(3)-values(2))
M1=M-values(1)*math_I3
M2=M-values(2)*math_I3
EB3=math_mul33x33(M1,M2)*D3
EB1=math_I3-EB3
! both EB2 and values(2) are set to zero so that they do not
! contribute to U in PDECOMPOSITION
values(2)=0.0_pReal
elseif (C2 < TOL) then
! values(2) is equal to values(3)
elseif (C(2) < TOL) then ! EV_2 = EV_3, no contribution from EV_3
D1=1.0_pReal/(values(1)-values(2))/(values(1)-values(3))
M2=M-math_I3*values(2)
M3=M-math_I3*values(3)
EB1=math_mul33x33(M2,M3)*D1
EB2=math_I3-EB1
! both EB3 and values(3) are set to zero so that they do not
! contribute to U in PDECOMPOSITION
values(3)=0.0_pReal
elseif(C3 < TOL) then
! values(1) is equal to values(3)
elseif(C(3) < TOL) then ! EV_1 = EV_3, no contribution from EV_3
D2=1.0_pReal/(values(2)-values(1))/(values(2)-values(3))
M1=M-math_I3*values(1)
M3=M-math_I3*values(3)
EB2=math_mul33x33(M1,M3)*D2
EB1=math_I3-EB2
! both EB3 and values(3) are set to zero so that they do not
! contribute to U in PDECOMPOSITION
values(3)=0.0_pReal
else
! all three eigenvectors are different
else ! all three eigenvectors are different
D1=1.0_pReal/(values(1)-values(2))/(values(1)-values(3))
D2=1.0_pReal/(values(2)-values(1))/(values(2)-values(3))
D3=1.0_pReal/(values(3)-values(1))/(values(3)-values(2))
M1=M-values(1)*math_I3
M2=M-values(2)*math_I3
M3=M-values(3)*math_I3
EB1=math_mul33x33(M2,M3)*D1
EB2=math_mul33x33(M1,M3)*D2
EB3=math_mul33x33(M1,M2)*D3

View File

@ -1,6 +1,4 @@
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine incoprorating dislocation and twinning physics