further simpilifcations

code/math.f90

@@ -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
+ if((ABS(P) < TOL).AND.(ABS(Q) < TOL)) then ! EV_2 = EV_1 = EV_3
-!   DREI GLEICHE EIGENWERTE
    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))
+   C = abs([values(1)-values(2),values(2)-values(3),values(3)-values(1)])
-   C2=ABS(values(2)-values(3))
-   C3=ABS(values(3)-values(1))
-
-   if (C1 < TOL) then
-!  values(1) is equal to values(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)
-     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)
-     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
-     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
+   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))
+     EB3=math_mul33x33(M1,M2)*D3
+     EB1=math_I3-EB3
+   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))
+     EB1=math_mul33x33(M2,M3)*D1
+     EB2=math_I3-EB1
+   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))
+     EB2=math_mul33x33(M1,M3)*D2
+     EB1=math_I3-EB2
+   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))
      EB1=math_mul33x33(M2,M3)*D1
      EB2=math_mul33x33(M1,M3)*D2
      EB3=math_mul33x33(M1,M2)*D3

code/plastic_dislotwin.f90

@@ -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