unified error checking

This commit is contained in:
Martin Diehl 2018-10-07 20:03:45 +02:00
parent 0e17b17b90
commit facb1c2407
1 changed files with 8 additions and 4 deletions

View File

@ -2604,16 +2604,19 @@ end function lattice_SchmidMatrix_slip
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Calculates Schmid matrix for active twin systems !> @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: & use IO, only: &
IO_error IO_error
use math, only: & use math, only: &
math_trace33, &
math_tensorproduct33 math_tensorproduct33
implicit none implicit none
integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
character(len=*), intent(in) :: structure !< lattice structure 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 :: & real(pReal), intent(in), optional :: &
cOverA cOverA
@ -2632,8 +2635,9 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA)
end select end select
do i = 1, sum(Ntwin) do i = 1, sum(Ntwin)
lattice_SchmidMatrix_twin(1:3,1:3,i) = & SchmidMatrix(1:3,1:3,i) = math_tensorproduct33(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,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 enddo
end function lattice_SchmidMatrix_twin end function lattice_SchmidMatrix_twin