223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

avoid type conversion 

more systematic checking of correct input parameters
This commit is contained in:
Martin Diehl 2018-10-08 08:27:12 +02:00
parent 302cf9b6c2
commit 5efcad952a
1 changed files with 109 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

205
src/lattice.f90
View File

@ -2139,6 +2139,7 @@ end function lattice_characteristicShear_Twin
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Calculates rotated elasticity matrices for twinning !> @brief Calculates rotated elasticity matrices for twinning
!> ToDo: Completely untested
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function lattice_C66_twin(Ntwin,C66,structure,CoverA) function lattice_C66_twin(Ntwin,C66,structure,CoverA)
use IO, only: & use IO, only: &
@ -2164,11 +2165,11 @@ function lattice_C66_twin(Ntwin,C66,structure,CoverA)
select case(structure) select case(structure)
case('fcc') case('fcc')
coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_FCC_NSLIPSYSTEM,int(LATTICE_FCC_SYSTEMTWIN,pInt),structure) coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_FCC_NSLIPSYSTEM,LATTICE_FCC_SYSTEMTWIN,structure)
case('bcc') case('bcc')
coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_BCC_NSLIPSYSTEM,int(LATTICE_BCC_SYSTEMTWIN,pInt),structure) coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_BCC_NSLIPSYSTEM,LATTICE_BCC_SYSTEMTWIN,structure)
case('hex','hexagonal') !ToDo: "No alias policy": long or short? case('hex','hexagonal') !ToDo: "No alias policy": long or short?
coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_HEX_NSLIPSYSTEM,int(LATTICE_HEX_SYSTEMTWIN,pInt),'hex',cOverA) coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_HEX_NSLIPSYSTEM,LATTICE_HEX_SYSTEMTWIN,'hex',cOverA)
case default case default
call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_C66_twin)') call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_C66_twin)')
end select end select
@ -2182,6 +2183,7 @@ end function
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Calculates rotated elasticity matrices for transformation !> @brief Calculates rotated elasticity matrices for transformation
!> ToDo: Completely untested and incomplete
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function lattice_C66_trans(Ntrans,C_parent66,structure_parent, & function lattice_C66_trans(Ntrans,C_parent66,structure_parent, &
C_target66,structure_target) C_target66,structure_target)
@ -2245,7 +2247,7 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_parent, &
enddo enddo
if (trim(structure_parent) == 'fcc' .and. trim(structure_target) == 'hex') then if (trim(structure_parent) == 'fcc' .and. trim(structure_target) == 'hex') then
do i = 1_pInt,sum(Ntrans)!!!!!!!!!!!!!! NEED TO BE FIXED do i = 1_pInt,sum(Ntrans)!!!!!!!!!!!!!! ToDo: NEED TO BE FIXED
R = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & ! Pitsch rotation R = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & ! Pitsch rotation
lattice_fccTobcc_systemTrans(4,i)*INRAD) lattice_fccTobcc_systemTrans(4,i)*INRAD)
B = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & ! Rotation of fcc to Bain coordinate system B = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & ! Rotation of fcc to Bain coordinate system
@ -2295,6 +2297,7 @@ end function
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Non-schmid tensor !> @brief Non-schmid tensor
!> ToDo: Clean description needed
! Schmid matrices with non-Schmid contributions according to Koester_etal2012, Acta Materialia 60 (2012) ! Schmid matrices with non-Schmid contributions according to Koester_etal2012, Acta Materialia 60 (2012)
! 3894–3901, eq. (17) ("n1" is replaced by either "np" or "nn" according to either positive or negative slip direction) ! 3894–3901, eq. (17) ("n1" is replaced by either "np" or "nn" according to either positive or negative slip direction)
! "np" and "nn" according to Gröger_etal2008, Acta Materialia 56 (2008) 5412–5425, table 1 ! "np" and "nn" according to Gröger_etal2008, Acta Materialia 56 (2008) 5412–5425, table 1
@ -2320,7 +2323,7 @@ function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSc
integer(pInt) :: i integer(pInt) :: i
if (abs(sense) /= 1_pInt) write(6,*) 'mist' if (abs(sense) /= 1_pInt) write(6,*) 'mist'
coordinateSystem = buildCoordinateSystem(Nslip,LATTICE_BCC_NSLIPSYSTEM,int(LATTICE_BCC_SYSTEMSLIP,pInt),'bcc') coordinateSystem = buildCoordinateSystem(Nslip,LATTICE_BCC_NSLIPSYSTEM,LATTICE_BCC_SYSTEMSLIP,'bcc')
coordinateSystem(1:3,1,1:sum(Nslip)) = coordinateSystem(1:3,1,1:sum(Nslip)) *real(sense,pReal) coordinateSystem(1:3,1,1:sum(Nslip)) = coordinateSystem(1:3,1,1:sum(Nslip)) *real(sense,pReal)
nonSchmidMatrix = lattice_SchmidMatrix_slip(Nslip,'bcc') nonSchmidMatrix = lattice_SchmidMatrix_slip(Nslip,'bcc')
@ -2349,7 +2352,7 @@ end function lattice_nonSchmidMatrix
!> @brief Populates slip-slip interaction matrix !> @brief Populates slip-slip interaction matrix
!> details: only active slip systems are considered !> details: only active slip systems are considered
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function lattice_interaction_SlipSlip(Nslip,interactionValues,structure) function lattice_interaction_SlipSlip(Nslip,interactionValues,structure) result(interactionMatrix)
use IO, only: & use IO, only: &
IO_error IO_error
@ -2357,33 +2360,32 @@ function lattice_interaction_SlipSlip(Nslip,interactionValues,structure)
integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family
real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values slip-slip real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values slip-slip
character(len=*), intent(in) :: structure !< lattice structure character(len=*), intent(in) :: structure !< lattice structure
real(pReal), dimension(sum(Nslip),sum(Nslip)) :: lattice_interaction_SlipSlip real(pReal), dimension(sum(Nslip),sum(Nslip)) :: interactionMatrix
integer(pInt), dimension(:), allocatable :: NslipMax integer(pInt), dimension(:), allocatable :: NslipMax
integer(pInt), dimension(:,:), allocatable :: interactionSlipSlip integer(pInt), dimension(:,:), allocatable :: interactionTypes
select case(structure) select case(structure)
case('fcc') case('fcc')
interactionSlipSlip = LATTICE_FCC_INTERACTIONSLIPSLIP interactionTypes = LATTICE_FCC_INTERACTIONSLIPSLIP
NslipMax = LATTICE_FCC_NSLIPSYSTEM NslipMax = LATTICE_FCC_NSLIPSYSTEM
case('bcc') case('bcc')
interactionSlipSlip = LATTICE_BCC_INTERACTIONSLIPSLIP interactionTypes = LATTICE_BCC_INTERACTIONSLIPSLIP
NslipMax = LATTICE_BCC_NSLIPSYSTEM NslipMax = LATTICE_BCC_NSLIPSYSTEM
case('hex','hexagonal') !ToDo: "No alias policy": long or short? case('hex','hexagonal') !ToDo: "No alias policy": long or short?
interactionSlipSlip = LATTICE_HEX_INTERACTIONSLIPSLIP interactionTypes = LATTICE_HEX_INTERACTIONSLIPSLIP
NslipMax = LATTICE_HEX_NSLIPSYSTEM NslipMax = LATTICE_HEX_NSLIPSYSTEM
case('bct') case('bct')
interactionSlipSlip = LATTICE_BCT_INTERACTIONSLIPSLIP interactionTypes = LATTICE_BCT_INTERACTIONSLIPSLIP
NslipMax = LATTICE_BCT_NSLIPSYSTEM NslipMax = LATTICE_BCT_NSLIPSYSTEM
case default case default
call IO_error(132_pInt,ext_msg=trim(structure)//' (slip slip interaction)') call IO_error(132_pInt,ext_msg=trim(structure)//' (slip slip interaction)')
end select end select
if (any(NslipMax(1:size(Nslip)) - Nslip < 0_pInt)) & if (size(interactionValues) > maxval(interactionTypes)) &
call IO_error(145_pInt,ext_msg='Nslip '//trim(structure)) call IO_error(0_pInt) ! ToDo
lattice_interaction_SlipSlip = & interactionMatrix = buildInteraction(Nslip,Nslip,NslipMax,NslipMax,interactionValues,interactionTypes)
buildInteraction(Nslip,Nslip,NslipMax,NslipMax,interactionValues,interactionSlipSlip)
end function lattice_interaction_SlipSlip end function lattice_interaction_SlipSlip
@ -2392,7 +2394,7 @@ end function lattice_interaction_SlipSlip
!> @brief Populates twin-twin interaction matrix !> @brief Populates twin-twin interaction matrix
!> details: only active twin systems are considered !> details: only active twin systems are considered
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function lattice_interaction_TwinTwin(Ntwin,interactionValues,structure) function lattice_interaction_TwinTwin(Ntwin,interactionValues,structure) result(interactionMatrix)
use IO, only: & use IO, only: &
IO_error IO_error
@ -2400,30 +2402,29 @@ function lattice_interaction_TwinTwin(Ntwin,interactionValues,structure)
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
real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin
character(len=*), intent(in) :: structure !< lattice structure character(len=*), intent(in) :: structure !< lattice structure
real(pReal), dimension(sum(Ntwin),sum(Ntwin)) :: lattice_interaction_TwinTwin real(pReal), dimension(sum(Ntwin),sum(Ntwin)) :: interactionMatrix
integer(pInt), dimension(:), allocatable :: NtwinMax integer(pInt), dimension(:), allocatable :: NtwinMax
integer(pInt), dimension(:,:), allocatable :: interactionTwinTwin integer(pInt), dimension(:,:), allocatable :: interactionTypes
select case(structure) select case(structure)
case('fcc') case('fcc')
interactionTwinTwin = LATTICE_FCC_INTERACTIONTWINTWIN interactionTypes = LATTICE_FCC_INTERACTIONTWINTWIN
NtwinMax = LATTICE_FCC_NTWINSYSTEM NtwinMax = LATTICE_FCC_NTWINSYSTEM
case('bcc') case('bcc')
interactionTwinTwin = LATTICE_BCC_INTERACTIONTWINTWIN interactionTypes = LATTICE_BCC_INTERACTIONTWINTWIN
NtwinMax = LATTICE_BCC_NTWINSYSTEM NtwinMax = LATTICE_BCC_NTWINSYSTEM
case('hex','hexagonal') !ToDo: "No alias policy": long or short? case('hex','hexagonal') !ToDo: "No alias policy": long or short?
interactionTwinTwin = LATTICE_HEX_INTERACTIONTWINTWIN interactionTypes = LATTICE_HEX_INTERACTIONTWINTWIN
NtwinMax = LATTICE_HEX_NTWINSYSTEM NtwinMax = LATTICE_HEX_NTWINSYSTEM
case default case default
call IO_error(132_pInt,ext_msg=trim(structure)//' (twin twin interaction)') call IO_error(132_pInt,ext_msg=trim(structure)//' (twin twin interaction)')
end select end select
if (any(NtwinMax(1:size(Ntwin)) - Ntwin < 0_pInt)) & if (size(interactionValues) > maxval(interactionTypes)) &
call IO_error(145_pInt,ext_msg='Ntwin '//trim(structure)) call IO_error(0_pInt) ! ToDo
lattice_interaction_TwinTwin = & interactionMatrix = buildInteraction(Ntwin,Ntwin,NtwinMax,NtwinMax,interactionValues,interactionTypes)
buildInteraction(Ntwin,Ntwin,NtwinMax,NtwinMax,interactionValues,interactionTwinTwin)
end function lattice_interaction_TwinTwin end function lattice_interaction_TwinTwin
@ -2432,7 +2433,7 @@ end function lattice_interaction_TwinTwin
!> @brief Populates slip-twin interaction matrix !> @brief Populates slip-twin interaction matrix
!> details: only active slip and twin systems are considered !> details: only active slip and twin systems are considered
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure) function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure) result(interactionMatrix)
use IO, only: & use IO, only: &
IO_error IO_error
@ -2441,36 +2442,33 @@ function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure)
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
real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin
character(len=*), intent(in) :: structure !< lattice structure character(len=*), intent(in) :: structure !< lattice structure
real(pReal), dimension(sum(Nslip),sum(Ntwin)) :: lattice_interaction_SlipTwin real(pReal), dimension(sum(Nslip),sum(Ntwin)) :: interactionMatrix
integer(pInt), dimension(:), allocatable :: NslipMax integer(pInt), dimension(:), allocatable :: NslipMax
integer(pInt), dimension(:), allocatable :: NtwinMax integer(pInt), dimension(:), allocatable :: NtwinMax
integer(pInt), dimension(:,:), allocatable :: interactionSlipTwin integer(pInt), dimension(:,:), allocatable :: interactionTypes
select case(structure) select case(structure)
case('fcc') case('fcc')
interactionSlipTwin = LATTICE_FCC_INTERACTIONSLIPTWIN interactionTypes = LATTICE_FCC_INTERACTIONSLIPTWIN
NslipMax = LATTICE_FCC_NSLIPSYSTEM NslipMax = LATTICE_FCC_NSLIPSYSTEM
NtwinMax = LATTICE_FCC_NTWINSYSTEM NtwinMax = LATTICE_FCC_NTWINSYSTEM
case('bcc') case('bcc')
interactionSlipTwin = LATTICE_BCC_INTERACTIONSLIPTWIN interactionTypes = LATTICE_BCC_INTERACTIONSLIPTWIN
NslipMax = LATTICE_BCC_NSLIPSYSTEM NslipMax = LATTICE_BCC_NSLIPSYSTEM
NtwinMax = LATTICE_BCC_NTWINSYSTEM NtwinMax = LATTICE_BCC_NTWINSYSTEM
case('hex','hexagonal') !ToDo: "No alias policy": long or short? case('hex','hexagonal') !ToDo: "No alias policy": long or short?
interactionSlipTwin = LATTICE_HEX_INTERACTIONSLIPTWIN interactionTypes = LATTICE_HEX_INTERACTIONSLIPTWIN
NslipMax = LATTICE_HEX_NSLIPSYSTEM NslipMax = LATTICE_HEX_NSLIPSYSTEM
NtwinMax = LATTICE_HEX_NTWINSYSTEM NtwinMax = LATTICE_HEX_NTWINSYSTEM
case default case default
call IO_error(132_pInt,ext_msg=trim(structure)//' (slip twin interaction)') call IO_error(132_pInt,ext_msg=trim(structure)//' (slip twin interaction)')
end select end select
if (any(NslipMax(1:size(Nslip)) - Nslip < 0_pInt)) & if (size(interactionValues) > maxval(interactionTypes)) &
call IO_error(145_pInt,ext_msg='Nslip '//trim(structure)) call IO_error(0_pInt) ! ToDo
if (any(NtwinMax(1:size(Ntwin)) - Ntwin < 0_pInt)) &
call IO_error(145_pInt,ext_msg='Ntwin '//trim(structure))
lattice_interaction_SlipTwin = & interactionMatrix = buildInteraction(Nslip,Ntwin,NslipMax,NtwinMax,interactionValues,interactionTypes)
buildInteraction(Nslip,Ntwin,NslipMax,NtwinMax,interactionValues,interactionSlipTwin)
end function lattice_interaction_SlipTwin end function lattice_interaction_SlipTwin
@ -2479,7 +2477,7 @@ end function lattice_interaction_SlipTwin
!> @brief Populates twin-slip interaction matrix !> @brief Populates twin-slip interaction matrix
!> details: only active twin and slip systems are considered !> details: only active twin and slip systems are considered
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function lattice_interaction_TwinSlip(Ntwin,Nslip,interactionValues,structure) function lattice_interaction_TwinSlip(Ntwin,Nslip,interactionValues,structure) result(interactionMatrix)
use IO, only: & use IO, only: &
IO_error IO_error
@ -2488,36 +2486,33 @@ function lattice_interaction_TwinSlip(Ntwin,Nslip,interactionValues,structure)
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
real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin
character(len=*), intent(in) :: structure !< lattice structure character(len=*), intent(in) :: structure !< lattice structure
real(pReal), dimension(sum(Ntwin),sum(Nslip)) :: lattice_interaction_TwinSlip real(pReal), dimension(sum(Ntwin),sum(Nslip)) :: interactionMatrix
integer(pInt), dimension(:), allocatable :: NslipMax integer(pInt), dimension(:), allocatable :: NslipMax
integer(pInt), dimension(:), allocatable :: NtwinMax integer(pInt), dimension(:), allocatable :: NtwinMax
integer(pInt), dimension(:,:), allocatable :: interactionTwinSlip integer(pInt), dimension(:,:), allocatable :: interactionTypes
select case(structure) select case(structure)
case('fcc') case('fcc')
interactionTwinSlip = LATTICE_FCC_INTERACTIONTWINSLIP interactionTypes = LATTICE_FCC_INTERACTIONTWINSLIP
NtwinMax = LATTICE_FCC_NTWINSYSTEM NtwinMax = LATTICE_FCC_NTWINSYSTEM
NslipMax = LATTICE_FCC_NSLIPSYSTEM NslipMax = LATTICE_FCC_NSLIPSYSTEM
case('bcc') case('bcc')
interactionTwinSlip = LATTICE_BCC_INTERACTIONTWINSLIP interactionTypes = LATTICE_BCC_INTERACTIONTWINSLIP
NtwinMax = LATTICE_BCC_NTWINSYSTEM NtwinMax = LATTICE_BCC_NTWINSYSTEM
NslipMax = LATTICE_BCC_NSLIPSYSTEM NslipMax = LATTICE_BCC_NSLIPSYSTEM
case('hex','hexagonal') !ToDo: "No alias policy": long or short? case('hex','hexagonal') !ToDo: "No alias policy": long or short?
interactionTwinSlip = LATTICE_HEX_INTERACTIONTWINSLIP interactionTypes = LATTICE_HEX_INTERACTIONTWINSLIP
NtwinMax = LATTICE_HEX_NTWINSYSTEM NtwinMax = LATTICE_HEX_NTWINSYSTEM
NslipMax = LATTICE_HEX_NSLIPSYSTEM NslipMax = LATTICE_HEX_NSLIPSYSTEM
case default case default
call IO_error(132_pInt,ext_msg=trim(structure)//' (twin slip interaction)') call IO_error(132_pInt,ext_msg=trim(structure)//' (twin slip interaction)')
end select end select
if (any(NslipMax(1:size(Nslip)) - Nslip < 0_pInt)) & if (size(interactionValues) > maxval(interactionTypes)) &
call IO_error(145_pInt,ext_msg='Nslip '//trim(structure)) call IO_error(0_pInt) ! ToDo
if (any(NtwinMax(1:size(Ntwin)) - Ntwin < 0_pInt)) &
call IO_error(145_pInt,ext_msg='Ntwin '//trim(structure))
lattice_interaction_TwinSlip = & interactionMatrix = buildInteraction(Ntwin,Nslip,NtwinMax,NslipMax,interactionValues,interactionTypes)
buildInteraction(Ntwin,Nslip,NtwinMax,NslipMax,interactionValues,interactionTwinSlip)
end function lattice_interaction_TwinSlip end function lattice_interaction_TwinSlip
@ -2526,7 +2521,7 @@ end function lattice_interaction_TwinSlip
!> @brief Populates trans-trans interaction matrix !> @brief Populates trans-trans interaction matrix
!> details: only active transformation systems are considered !> details: only active transformation systems are considered
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function lattice_interaction_TransTrans(Ntrans,interactionValues,structure,targetStructure) function lattice_interaction_TransTrans(Ntrans,interactionValues,structure,targetStructure) result(interactionMatrix)
use IO, only: & use IO, only: &
IO_error IO_error
@ -2536,23 +2531,22 @@ function lattice_interaction_TransTrans(Ntrans,interactionValues,structure,targe
character(len=*), intent(in) :: & character(len=*), intent(in) :: &
structure, & !< lattice structure of parent crystal structure, & !< lattice structure of parent crystal
targetStructure !< lattice structure of transformed crystal targetStructure !< lattice structure of transformed crystal
real(pReal), dimension(sum(Ntrans),sum(Ntrans)) :: lattice_interaction_TransTrans real(pReal), dimension(sum(Ntrans),sum(Ntrans)) :: interactionMatrix
integer(pInt), dimension(:), allocatable :: NtransMax integer(pInt), dimension(:), allocatable :: NtransMax
integer(pInt), dimension(:,:), allocatable :: interactionTransTrans integer(pInt), dimension(:,:), allocatable :: interactionTypes
if (trim(structure) == 'fcc' .and. trim(targetStructure) == 'hex') then if (trim(structure) == 'fcc' .and. trim(targetStructure) == 'hex') then
interactionTransTrans = lattice_fccToHex_interactionTransTrans interactionTypes = lattice_fccToHex_interactionTransTrans
NtransMax = lattice_fcc_Ntrans NtransMax = lattice_fcc_Ntrans
else else
call IO_error(132_pInt,ext_msg=trim(structure)//' => '//trim(targetStructure)) call IO_error(132_pInt,ext_msg=trim(structure)//' => '//trim(targetStructure))
end if end if
if (any(NtransMax(1:size(Ntrans)) - Ntrans < 0_pInt)) & if (size(interactionValues) > maxval(interactionTypes)) &
call IO_error(145_pInt,ext_msg='Ntrans '//trim(structure)) call IO_error(0_pInt) ! ToDo
lattice_interaction_TransTrans = & interactionMatrix = buildInteraction(Ntrans,Ntrans,NtransMax,NtransMax,interactionValues,interactionTypes)
buildInteraction(Ntrans,Ntrans,NtransMax,NtransMax,interactionValues,interactionTransTrans)
end function lattice_interaction_TransTrans end function lattice_interaction_TransTrans
@ -2577,21 +2571,31 @@ function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix)
cOverA cOverA
real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem
real(pReal), dimension(:,:), allocatable :: slipSystems
integer(pInt), dimension(:), allocatable :: NslipMax
integer(pInt) :: i integer(pInt) :: i
select case(structure) select case(structure)
case('fcc') case('fcc')
coordinateSystem = buildCoordinateSystem(Nslip,LATTICE_BCC_NSLIPSYSTEM,int(LATTICE_FCC_SYSTEMSLIP,pInt),structure) NslipMax = LATTICE_BCC_NSLIPSYSTEM
slipSystems = LATTICE_FCC_SYSTEMSLIP
case('bcc') case('bcc')
coordinateSystem = buildCoordinateSystem(Nslip,LATTICE_FCC_NSLIPSYSTEM,int(LATTICE_BCC_SYSTEMSLIP,pInt),structure) NslipMax = LATTICE_FCC_NSLIPSYSTEM
slipSystems = LATTICE_BCC_SYSTEMSLIP
case('hex','hexagonal') !ToDo: "No alias policy": long or short? case('hex','hexagonal') !ToDo: "No alias policy": long or short?
coordinateSystem = buildCoordinateSystem(Nslip,LATTICE_HEX_NSLIPSYSTEM,int(LATTICE_HEX_SYSTEMSLIP,pInt),'hex',cOverA) NslipMax = LATTICE_HEX_NSLIPSYSTEM
slipSystems = LATTICE_HEX_SYSTEMSLIP
case('bct') case('bct')
coordinateSystem = buildCoordinateSystem(Nslip,LATTICE_BCT_NSLIPSYSTEM,int(LATTICE_BCT_SYSTEMSLIP,pInt),structure,cOverA) NslipMax = LATTICE_BCT_NSLIPSYSTEM
slipSystems = LATTICE_BCT_SYSTEMSLIP
case default case default
call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_SchmidMatrix_slip)') call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_SchmidMatrix_slip)')
end select end select
if (any(NslipMax(1:size(Nslip)) - Nslip < 0_pInt) .or. any(Nslip < 0_pInt)) &
call IO_error(145_pInt,ext_msg='Nslip '//trim(structure))
coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,structure)
do i = 1, sum(Nslip) do i = 1, sum(Nslip)
SchmidMatrix(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) & if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) &
@ -2621,19 +2625,28 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix)
cOverA cOverA
real(pReal), dimension(3,3,sum(Ntwin)) :: coordinateSystem real(pReal), dimension(3,3,sum(Ntwin)) :: coordinateSystem
real(pReal), dimension(:,:), allocatable :: twinSystems
integer(pInt), dimension(:), allocatable :: NtwinMax
integer(pInt) :: i integer(pInt) :: i
select case(structure) select case(structure)
case('fcc') case('fcc')
coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_FCC_NTWINSYSTEM,int(LATTICE_FCC_SYSTEMTWIN,pInt),structure) NtwinMax = LATTICE_FCC_NTWINSYSTEM
twinSystems = LATTICE_FCC_SYSTEMTWIN
case('bcc') case('bcc')
coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_BCC_NTWINSYSTEM,int(LATTICE_BCC_SYSTEMTWIN,pInt),structure) NtwinMax = LATTICE_BCC_NTWINSYSTEM
twinSystems = LATTICE_BCC_SYSTEMTWIN
case('hex','hexagonal') !ToDo: "No alias policy": long or short? case('hex','hexagonal') !ToDo: "No alias policy": long or short?
coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_HEX_NTWINSYSTEM,int(LATTICE_HEX_SYSTEMTWIN,pInt),'hex',cOverA) NtwinMax = LATTICE_HEX_NTWINSYSTEM
twinSystems = LATTICE_HEX_SYSTEMTWIN
case default case default
call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_SchmidMatrix_twin)') call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_SchmidMatrix_twin)')
end select end select
if (any(NtwinMax(1:size(Ntwin)) - Ntwin < 0_pInt) .or. any(Ntwin < 0_pInt)) &
call IO_error(145_pInt,ext_msg='Ntwin '//trim(structure))
coordinateSystem = buildCoordinateSystem(Ntwin,NtwinMax,twinSystems,structure)
do i = 1, sum(Ntwin) do i = 1, sum(Ntwin)
SchmidMatrix(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) & if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) &
@ -2690,7 +2703,7 @@ function buildCoordinateSystem(active,maximum,system,structure,cOverA)
integer(pInt), dimension(:), intent(in) :: & integer(pInt), dimension(:), intent(in) :: &
active, & active, &
maximum maximum
integer(pInt), dimension(:,:), intent(in) :: & real(pReal), dimension(:,:), intent(in) :: &
system system
character(len=*), intent(in) :: & character(len=*), intent(in) :: &
structure !< lattice structure structure !< lattice structure
@ -2716,23 +2729,23 @@ function buildCoordinateSystem(active,maximum,system,structure,cOverA)
select case(trim(structure)) select case(trim(structure))
case ('fcc','bcc') case ('fcc','bcc')
direction = real(system(1:3,j),pReal) direction = system(1:3,j)
normal = real(system(4:6,j),pReal) normal = system(4:6,j)
case ('hex') case ('hex')
! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)]) ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)])
direction = [ real(system(1,j),pReal)*1.5_pReal, & direction = [ system(1,j)*1.5_pReal, &
(real(system(1,j),pReal)+2.0_pReal*real(system(2,j),pReal))*sqrt(0.75_pReal), & (system(1,j)+2.0_pReal*system(2,j))*sqrt(0.75_pReal), &
real(system(4,j),pReal)*CoverA ] system(4,j)*CoverA ]
! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a))
normal = [ real(system(5,j),pReal), & normal = [ system(5,j), &
(real(system(5,j),pReal)+2.0_pReal*real(system(6,j),pReal))/ sqrt(3.0_pReal), & (system(5,j)+2.0_pReal*system(6,j))/ sqrt(3.0_pReal), &
real(system(8,j),pReal)/CoverA ] system(8,j)/CoverA ]
case ('bct') case ('bct')
direction = [real(system(1:2,j),pReal),real(system(3,i),pReal)*CoverA] direction = [system(1:2,j),system(3,i)*CoverA]
normal = [real(system(4:5,j),pReal),real(system(6,i),pReal)/CoverA] normal = [system(4:5,j),system(6,i)/CoverA]
end select end select