From facb1c2407c9d11435a1b8651199b8b39e5129ed Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 7 Oct 2018 20:03:45 +0200 Subject: [PATCH] unified error checking --- src/lattice.f90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 30563f4a8..6e1f90752 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -2604,16 +2604,19 @@ end function lattice_SchmidMatrix_slip !-------------------------------------------------------------------------------------------------- !> @brief Calculates Schmid matrix for active twin systems !-------------------------------------------------------------------------------------------------- -function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) +function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) + use prec, only: & + tol_math_check use IO, only: & IO_error use math, only: & + math_trace33, & math_tensorproduct33 implicit none integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family character(len=*), intent(in) :: structure !< lattice structure - real(pReal), dimension(3,3,sum(Ntwin)) :: lattice_SchmidMatrix_Twin + real(pReal), dimension(3,3,sum(Ntwin)) :: SchmidMatrix real(pReal), intent(in), optional :: & cOverA @@ -2632,8 +2635,9 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) end select do i = 1, sum(Ntwin) - lattice_SchmidMatrix_twin(1:3,1:3,i) = & - math_tensorproduct33(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,i) = math_tensorproduct33(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) + if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) & + call IO_error(0_pInt,i,ext_msg = 'dilatational Schmid matrix for twin') enddo end function lattice_SchmidMatrix_twin