2013-10-08 21:57:26 +05:30
!--------------------------------------------------------------------------------------------------
! $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
!> @details to be done
!--------------------------------------------------------------------------------------------------
module constitutive_dislotwin
2013-11-27 13:34:05 +05:30
use prec , only : &
2013-10-08 21:57:26 +05:30
pReal , &
pInt
2011-04-13 17:21:46 +05:30
2013-10-08 21:57:26 +05:30
implicit none
private
2013-12-12 05:12:33 +05:30
integer ( pInt ) , dimension ( : ) , allocatable , public , protected :: &
2014-07-02 17:57:39 +05:30
constitutive_dislotwin_sizePostResults !< cumulative size of post results
2011-04-13 17:21:46 +05:30
2013-12-12 05:12:33 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable , target , public :: &
2013-10-08 21:57:26 +05:30
constitutive_dislotwin_sizePostResult !< size of each post result output
2012-01-11 22:26:35 +05:30
2013-12-12 05:12:33 +05:30
character ( len = 64 ) , dimension ( : , : ) , allocatable , target , public :: &
2013-10-08 21:57:26 +05:30
constitutive_dislotwin_output !< name of each post result output
2013-12-12 05:12:33 +05:30
character ( len = 12 ) , dimension ( 3 ) , parameter , private :: &
2013-10-08 21:57:26 +05:30
CONSTITUTIVE_DISLOTWIN_listBasicSlipStates = &
[ 'rhoEdge ' , 'rhoEdgeDip ' , 'accshearslip' ]
2013-12-12 05:12:33 +05:30
character ( len = 12 ) , dimension ( 2 ) , parameter , private :: &
2013-10-08 21:57:26 +05:30
CONSTITUTIVE_DISLOTWIN_listBasicTwinStates = &
[ 'twinFraction' , 'accsheartwin' ]
2013-12-12 05:12:33 +05:30
character ( len = 17 ) , dimension ( 4 ) , parameter , private :: &
2013-10-08 21:57:26 +05:30
CONSTITUTIVE_DISLOTWIN_listDependentSlipStates = &
[ 'invLambdaSlip ' , 'invLambdaSlipTwin' , 'meanFreePathSlip ' , 'tauSlipThreshold ' ]
2013-12-12 05:12:33 +05:30
character ( len = 16 ) , dimension ( 4 ) , parameter , private :: &
2013-10-08 21:57:26 +05:30
CONSTITUTIVE_DISLOTWIN_listDependentTwinStates = &
[ 'invLambdaTwin ' , 'meanFreePathTwin' , 'tauTwinThreshold' , 'twinVolume ' ]
2013-12-12 05:12:33 +05:30
real ( pReal ) , parameter , private :: &
2013-10-08 21:57:26 +05:30
kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin
2013-12-12 05:12:33 +05:30
integer ( pInt ) , dimension ( : ) , allocatable , private :: &
2013-10-08 21:57:26 +05:30
constitutive_dislotwin_Noutput !< number of outputs per instance of this plasticity
2013-12-12 05:12:33 +05:30
integer ( pInt ) , dimension ( : ) , allocatable , private :: &
2013-10-08 21:57:26 +05:30
constitutive_dislotwin_totalNslip , & !< total number of active slip systems for each instance
2014-07-22 13:13:03 +05:30
constitutive_dislotwin_totalNtwin , & !< total number of active twin systems for each instance
constitutive_dislotwin_totalNtrans !< number of active transformation systems
2013-10-08 21:57:26 +05:30
2013-12-12 05:12:33 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable , private :: &
2013-10-08 21:57:26 +05:30
constitutive_dislotwin_Nslip , & !< number of active slip systems for each family and instance
2014-07-22 13:13:03 +05:30
constitutive_dislotwin_Ntwin , & !< number of active twin systems for each family and instance
constitutive_dislotwin_Ntrans !< number of active transformation systems for each family and instance
2013-10-08 21:57:26 +05:30
2013-12-12 05:12:33 +05:30
real ( pReal ) , dimension ( : ) , allocatable , private :: &
2013-10-08 21:57:26 +05:30
constitutive_dislotwin_CAtomicVolume , & !< atomic volume in Bugers vector unit
constitutive_dislotwin_D0 , & !< prefactor for self-diffusion coefficient
constitutive_dislotwin_Qsd , & !< activation energy for dislocation climb
constitutive_dislotwin_GrainSize , & !< grain size
2014-03-12 05:25:40 +05:30
constitutive_dislotwin_pShearBand , & !< p-exponent in shearband velocity
constitutive_dislotwin_qShearBand , & !< q-exponent in shearband velocity
2013-10-08 21:57:26 +05:30
constitutive_dislotwin_MaxTwinFraction , & !< maximum allowed total twin volume fraction
constitutive_dislotwin_CEdgeDipMinDistance , & !<
constitutive_dislotwin_Cmfptwin , & !<
constitutive_dislotwin_Cthresholdtwin , & !<
constitutive_dislotwin_SolidSolutionStrength , & !< Strength due to elements in solid solution
constitutive_dislotwin_L0 , & !< Length of twin nuclei in Burgers vectors
constitutive_dislotwin_xc , & !< critical distance for formation of twin nucleus
constitutive_dislotwin_VcrossSlip , & !< cross slip volume
constitutive_dislotwin_sbResistance , & !< value for shearband resistance (might become an internal state variable at some point)
constitutive_dislotwin_sbVelocity , & !< value for shearband velocity_0
constitutive_dislotwin_sbQedge , & !< value for shearband systems Qedge
constitutive_dislotwin_SFE_0K , & !< stacking fault energy at zero K
constitutive_dislotwin_dSFE_dT , & !< temperature dependance of stacking fault energy
2014-03-14 05:20:55 +05:30
constitutive_dislotwin_dipoleFormationFactor , & !< scaling factor for dipole formation: 0: off, 1: on. other values not useful
2013-10-08 21:57:26 +05:30
constitutive_dislotwin_aTolRho , & !< absolute tolerance for integration of dislocation density
2014-07-22 13:13:03 +05:30
constitutive_dislotwin_aTolTwinFrac , & !< absolute tolerance for integration of twin volume fraction
constitutive_dislotwin_c1 , & !< strain induced martensite nucleation coefficient
constitutive_dislotwin_c2 , & !< phase boundary energy
constitutive_dislotwin_c3 , & !< Lagrange multiplier
constitutive_dislotwin_c5 , & !< phase transformation rate coefficient
constitutive_dislotwin_deltaG !< free energy difference between austensite and martensite [MPa]
2013-10-08 21:57:26 +05:30
2013-12-12 05:12:33 +05:30
real ( pReal ) , dimension ( : , : , : , : ) , allocatable , private :: &
2014-06-11 17:41:14 +05:30
constitutive_dislotwin_Ctwin66 !< twin elasticity matrix in Mandel notation for each instance
2013-12-12 05:12:33 +05:30
real ( pReal ) , dimension ( : , : , : , : , : , : ) , allocatable , private :: &
2014-06-11 17:41:14 +05:30
constitutive_dislotwin_Ctwin3333 !< twin elasticity matrix for each instance
2013-12-12 05:12:33 +05:30
real ( pReal ) , dimension ( : , : ) , allocatable , private :: &
2013-10-08 21:57:26 +05:30
constitutive_dislotwin_rhoEdge0 , & !< initial edge dislocation density per slip system for each family and instance
constitutive_dislotwin_rhoEdgeDip0 , & !< initial edge dipole density per slip system for each family and instance
constitutive_dislotwin_burgersPerSlipFamily , & !< absolute length of burgers vector [m] for each slip family and instance
constitutive_dislotwin_burgersPerSlipSystem , & !< absolute length of burgers vector [m] for each slip system and instance
constitutive_dislotwin_burgersPerTwinFamily , & !< absolute length of burgers vector [m] for each twin family and instance
constitutive_dislotwin_burgersPerTwinSystem , & !< absolute length of burgers vector [m] for each twin system and instance
constitutive_dislotwin_QedgePerSlipFamily , & !< activation energy for glide [J] for each slip family and instance
constitutive_dislotwin_QedgePerSlipSystem , & !< activation energy for glide [J] for each slip system and instance
constitutive_dislotwin_v0PerSlipFamily , & !< dislocation velocity prefactor [m/s] for each family and instance
constitutive_dislotwin_v0PerSlipSystem , & !< dislocation velocity prefactor [m/s] for each slip system and instance
2014-03-12 05:25:40 +05:30
constitutive_dislotwin_tau_peierlsPerSlipFamily , & !< Peierls stress [Pa] for each family and instance
2013-10-08 21:57:26 +05:30
constitutive_dislotwin_Ndot0PerTwinFamily , & !< twin nucleation rate [1/m³s] for each twin family and instance
constitutive_dislotwin_Ndot0PerTwinSystem , & !< twin nucleation rate [1/m³s] for each twin system and instance
constitutive_dislotwin_tau_r , & !< stress to bring partial close together for each twin system and instance
constitutive_dislotwin_twinsizePerTwinFamily , & !< twin thickness [m] for each twin family and instance
constitutive_dislotwin_twinsizePerTwinSystem , & !< twin thickness [m] for each twin system and instance
constitutive_dislotwin_CLambdaSlipPerSlipFamily , & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance
constitutive_dislotwin_CLambdaSlipPerSlipSystem , & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance
constitutive_dislotwin_interaction_SlipSlip , & !< coefficients for slip-slip interaction for each interaction type and instance
constitutive_dislotwin_interaction_SlipTwin , & !< coefficients for slip-twin interaction for each interaction type and instance
constitutive_dislotwin_interaction_TwinSlip , & !< coefficients for twin-slip interaction for each interaction type and instance
2014-03-12 05:25:40 +05:30
constitutive_dislotwin_interaction_TwinTwin , & !< coefficients for twin-twin interaction for each interaction type and instance
constitutive_dislotwin_pPerSlipFamily , & !< p-exponent in glide velocity
constitutive_dislotwin_qPerSlipFamily , & !< q-exponent in glide velocity
constitutive_dislotwin_rPerTwinFamily !< r-exponent in twin nucleation rate
2013-12-12 05:12:33 +05:30
real ( pReal ) , dimension ( : , : , : ) , allocatable , private :: &
2013-10-08 21:57:26 +05:30
constitutive_dislotwin_interactionMatrix_SlipSlip , & !< interaction matrix of the different slip systems for each instance
constitutive_dislotwin_interactionMatrix_SlipTwin , & !< interaction matrix of slip systems with twin systems for each instance
constitutive_dislotwin_interactionMatrix_TwinSlip , & !< interaction matrix of twin systems with slip systems for each instance
constitutive_dislotwin_interactionMatrix_TwinTwin , & !< interaction matrix of the different twin systems for each instance
constitutive_dislotwin_forestProjectionEdge !< matrix of forest projections of edge dislocations for each instance
2013-12-12 05:12:33 +05:30
real ( pReal ) , dimension ( : , : , : , : , : ) , allocatable , private :: &
2013-10-08 21:57:26 +05:30
constitutive_dislotwin_sbSv
2013-12-12 05:12:33 +05:30
enum , bind ( c )
enumerator :: undefined_ID , &
edge_density_ID , &
dipole_density_ID , &
shear_rate_slip_ID , &
accumulated_shear_slip_ID , &
mfp_slip_ID , &
resolved_stress_slip_ID , &
threshold_stress_slip_ID , &
edge_dipole_distance_ID , &
stress_exponent_ID , &
twin_fraction_ID , &
shear_rate_twin_ID , &
accumulated_shear_twin_ID , &
mfp_twin_ID , &
resolved_stress_twin_ID , &
threshold_stress_twin_ID , &
resolved_stress_shearband_ID , &
shear_rate_shearband_ID , &
sb_eigenvalues_ID , &
sb_eigenvectors_ID
end enum
integer ( kind ( undefined_ID ) ) , dimension ( : , : ) , allocatable , private :: &
2014-03-09 02:20:31 +05:30
constitutive_dislotwin_outputID !< ID of each post result output
2013-12-12 05:12:33 +05:30
2013-10-08 21:57:26 +05:30
public :: &
2013-10-14 16:24:45 +05:30
constitutive_dislotwin_init , &
constitutive_dislotwin_homogenizedC , &
2013-10-08 21:57:26 +05:30
constitutive_dislotwin_microstructure , &
2013-10-14 16:24:45 +05:30
constitutive_dislotwin_LpAndItsTangent , &
constitutive_dislotwin_dotState , &
2013-10-08 21:57:26 +05:30
constitutive_dislotwin_postResults
2014-07-02 17:57:39 +05:30
private :: &
constitutive_dislotwin_stateInit , &
constitutive_dislotwin_aTolState
2013-10-08 21:57:26 +05:30
contains
2011-04-13 17:21:46 +05:30
2013-03-28 13:10:30 +05:30
2013-10-08 21:57:26 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
2013-12-12 05:12:33 +05:30
subroutine constitutive_dislotwin_init ( fileUnit )
2014-03-09 02:20:31 +05:30
use , intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
2013-10-08 21:57:26 +05:30
use debug , only : &
debug_level , &
2013-10-14 16:24:45 +05:30
debug_constitutive , &
debug_levelBasic
2013-10-08 21:57:26 +05:30
use math , only : &
math_Mandel3333to66 , &
math_Voigt66to3333 , &
math_mul3x3
use mesh , only : &
mesh_maxNips , &
mesh_NcpElems
2013-12-19 14:19:47 +05:30
use IO , only : &
2014-02-10 20:01:19 +05:30
IO_read , &
IO_lc , &
IO_getTag , &
IO_isBlank , &
IO_stringPos , &
IO_stringValue , &
IO_floatValue , &
IO_intValue , &
IO_warning , &
IO_error , &
IO_timeStamp , &
IO_EOF
2013-12-19 14:19:47 +05:30
use material , only : &
homogenization_maxNgrains , &
phase_plasticity , &
phase_plasticityInstance , &
phase_Noutput , &
PLASTICITY_DISLOTWIN_label , &
PLASTICITY_DISLOTWIN_ID , &
2014-06-11 17:41:14 +05:30
material_phase , &
2014-07-02 17:57:39 +05:30
plasticState , &
2013-12-19 14:19:47 +05:30
MATERIAL_partPhase
2013-10-08 21:57:26 +05:30
use lattice
2014-06-11 17:41:14 +05:30
use numerics , only : &
numerics_integrator
2013-10-08 21:57:26 +05:30
implicit none
2013-12-12 05:12:33 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit
2013-10-08 21:57:26 +05:30
2013-10-09 11:42:16 +05:30
integer ( pInt ) , parameter :: MAXNCHUNKS = LATTICE_maxNinteraction + 1_pInt
integer ( pInt ) , dimension ( 1 + 2 * MAXNCHUNKS ) :: positions
2014-03-09 02:20:31 +05:30
integer ( pInt ) :: maxNinstance , mySize = 0_pInt , phase , maxTotalNslip , maxTotalNtwin , &
2014-02-28 15:48:40 +05:30
f , instance , j , k , l , m , n , o , p , q , r , s , ns , nt , &
2013-10-14 16:24:45 +05:30
Nchunks_SlipSlip , Nchunks_SlipTwin , Nchunks_TwinSlip , Nchunks_TwinTwin , &
2014-07-22 13:13:03 +05:30
Nchunks_SlipFamilies , Nchunks_TwinFamilies , Nchunks_TransFamilies , &
2013-10-14 16:24:45 +05:30
index_myFamily , index_otherFamily
2014-06-11 17:41:14 +05:30
integer ( pInt ) :: sizeState , sizeDotState
integer ( pInt ) :: NofMyPhase
2013-11-28 14:26:02 +05:30
character ( len = 65536 ) :: &
tag = '' , &
line = ''
2014-07-22 13:13:03 +05:30
real ( pReal ) , dimension ( : ) , allocatable :: tempPerSlip , tempPerTwin , tempPerTrans
2013-10-14 16:24:45 +05:30
2013-11-27 13:34:05 +05:30
write ( 6 , '(/,a)' ) ' <<<+- constitutive_' / / PLASTICITY_DISLOTWIN_label / / ' init -+>>>'
2013-05-28 23:01:55 +05:30
write ( 6 , '(a)' ) ' $Id$'
write ( 6 , '(a15,a)' ) ' Current time: ' , IO_timeStamp ( )
2012-02-01 00:48:55 +05:30
#include "compilation_info.f90"
2013-10-08 21:57:26 +05:30
2013-11-27 13:34:05 +05:30
maxNinstance = int ( count ( phase_plasticity == PLASTICITY_DISLOTWIN_ID ) , pInt )
2013-10-08 21:57:26 +05:30
if ( maxNinstance == 0_pInt ) return
if ( iand ( debug_level ( debug_constitutive ) , debug_levelBasic ) / = 0_pInt ) &
2014-03-09 02:20:31 +05:30
write ( 6 , '(a16,1x,i5,/)' ) '# instances:' , maxNinstance
2013-10-08 21:57:26 +05:30
2013-12-12 05:12:33 +05:30
allocate ( constitutive_dislotwin_sizePostResults ( maxNinstance ) , source = 0_pInt )
allocate ( constitutive_dislotwin_sizePostResult ( maxval ( phase_Noutput ) , maxNinstance ) , source = 0_pInt )
2013-10-08 21:57:26 +05:30
allocate ( constitutive_dislotwin_output ( maxval ( phase_Noutput ) , maxNinstance ) )
2013-10-14 16:24:45 +05:30
constitutive_dislotwin_output = ''
2013-12-12 05:12:33 +05:30
allocate ( constitutive_dislotwin_outputID ( maxval ( phase_Noutput ) , maxNinstance ) , source = undefined_ID )
allocate ( constitutive_dislotwin_Noutput ( maxNinstance ) , source = 0_pInt )
allocate ( constitutive_dislotwin_Nslip ( lattice_maxNslipFamily , maxNinstance ) , source = 0_pInt )
allocate ( constitutive_dislotwin_Ntwin ( lattice_maxNtwinFamily , maxNinstance ) , source = 0_pInt )
2014-07-22 13:13:03 +05:30
allocate ( constitutive_dislotwin_Ntrans ( lattice_maxNtransFamily , maxNinstance ) , source = 0_pInt )
2013-12-12 05:12:33 +05:30
allocate ( constitutive_dislotwin_totalNslip ( maxNinstance ) , source = 0_pInt )
allocate ( constitutive_dislotwin_totalNtwin ( maxNinstance ) , source = 0_pInt )
2014-07-22 13:13:03 +05:30
allocate ( constitutive_dislotwin_totalNtrans ( maxNinstance ) , source = 0_pInt )
2013-12-12 05:12:33 +05:30
allocate ( constitutive_dislotwin_CAtomicVolume ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_D0 ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_Qsd ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_GrainSize ( maxNinstance ) , source = 0.0_pReal )
2014-03-12 05:25:40 +05:30
allocate ( constitutive_dislotwin_pShearBand ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_qShearBand ( maxNinstance ) , source = 0.0_pReal )
2013-12-12 05:12:33 +05:30
allocate ( constitutive_dislotwin_MaxTwinFraction ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_CEdgeDipMinDistance ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_Cmfptwin ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_Cthresholdtwin ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_SolidSolutionStrength ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_L0 ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_xc ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_VcrossSlip ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_aTolRho ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_aTolTwinFrac ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_sbResistance ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_sbVelocity ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_sbQedge ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_SFE_0K ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_dSFE_dT ( maxNinstance ) , source = 0.0_pReal )
2014-03-14 05:20:55 +05:30
allocate ( constitutive_dislotwin_dipoleFormationFactor ( maxNinstance ) , source = 1.0_pReal ) !should be on by default
2014-07-22 13:13:03 +05:30
allocate ( constitutive_dislotwin_c1 ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_c2 ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_c3 ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_c5 ( maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_deltaG ( maxNinstance ) , source = 0.0_pReal )
2013-12-12 05:12:33 +05:30
allocate ( constitutive_dislotwin_rhoEdge0 ( lattice_maxNslipFamily , maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_rhoEdgeDip0 ( lattice_maxNslipFamily , maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_burgersPerSlipFamily ( lattice_maxNslipFamily , maxNinstance ) , &
source = 0.0_pReal )
allocate ( constitutive_dislotwin_burgersPerTwinFamily ( lattice_maxNtwinFamily , maxNinstance ) , &
source = 0.0_pReal )
allocate ( constitutive_dislotwin_QedgePerSlipFamily ( lattice_maxNslipFamily , maxNinstance ) , &
source = 0.0_pReal )
allocate ( constitutive_dislotwin_v0PerSlipFamily ( lattice_maxNslipFamily , maxNinstance ) , &
source = 0.0_pReal )
2014-03-12 05:25:40 +05:30
allocate ( constitutive_dislotwin_tau_peierlsPerSlipFamily ( lattice_maxNslipFamily , maxNinstance ) , &
source = 0.0_pReal )
allocate ( constitutive_dislotwin_pPerSlipFamily ( lattice_maxNslipFamily , maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_qPerSlipFamily ( lattice_maxNslipFamily , maxNinstance ) , source = 0.0_pReal )
2013-12-12 05:12:33 +05:30
allocate ( constitutive_dislotwin_Ndot0PerTwinFamily ( lattice_maxNtwinFamily , maxNinstance ) , &
source = 0.0_pReal )
allocate ( constitutive_dislotwin_twinsizePerTwinFamily ( lattice_maxNtwinFamily , maxNinstance ) , &
source = 0.0_pReal )
allocate ( constitutive_dislotwin_CLambdaSlipPerSlipFamily ( lattice_maxNslipFamily , maxNinstance ) , &
source = 0.0_pReal )
2014-03-12 05:25:40 +05:30
allocate ( constitutive_dislotwin_rPerTwinFamily ( lattice_maxNtwinFamily , maxNinstance ) , source = 0.0_pReal )
2013-12-12 05:12:33 +05:30
allocate ( constitutive_dislotwin_interaction_SlipSlip ( lattice_maxNinteraction , maxNinstance ) , &
source = 0.0_pReal )
allocate ( constitutive_dislotwin_interaction_SlipTwin ( lattice_maxNinteraction , maxNinstance ) , &
source = 0.0_pReal )
allocate ( constitutive_dislotwin_interaction_TwinSlip ( lattice_maxNinteraction , maxNinstance ) , &
source = 0.0_pReal )
allocate ( constitutive_dislotwin_interaction_TwinTwin ( lattice_maxNinteraction , maxNinstance ) , &
source = 0.0_pReal )
allocate ( constitutive_dislotwin_sbSv ( 6 , 6 , homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , &
source = 0.0_pReal )
2013-10-08 21:57:26 +05:30
2013-11-27 13:34:05 +05:30
2013-12-12 05:12:33 +05:30
rewind ( fileUnit )
2014-03-09 02:20:31 +05:30
phase = 0_pInt
do while ( trim ( line ) / = IO_EOF . and . IO_lc ( IO_getTag ( line , '<' , '>' ) ) / = MATERIAL_partPhase ) ! wind forward to <phase>
2013-12-12 05:12:33 +05:30
line = IO_read ( fileUnit )
2013-10-08 21:57:26 +05:30
enddo
2014-03-09 02:20:31 +05:30
parsingFile : do while ( trim ( line ) / = IO_EOF ) ! read through sections of phase part
2013-12-12 05:12:33 +05:30
line = IO_read ( fileUnit )
2014-03-09 02:20:31 +05:30
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
if ( IO_getTag ( line , '<' , '>' ) / = '' ) then ! stop at next part
line = IO_read ( fileUnit , . true . ) ! reset IO_read
2013-12-12 05:12:33 +05:30
exit
2014-03-09 02:20:31 +05:30
endif
if ( IO_getTag ( line , '[' , ']' ) / = '' ) then ! next phase section
phase = phase + 1_pInt ! advance phase section counter
if ( phase_plasticity ( phase ) == PLASTICITY_DISLOTWIN_ID ) then
Nchunks_SlipFamilies = count ( lattice_NslipSystem ( : , phase ) > 0_pInt )
Nchunks_TwinFamilies = count ( lattice_NtwinSystem ( : , phase ) > 0_pInt )
2014-07-22 13:13:03 +05:30
Nchunks_TransFamilies = count ( lattice_NtransSystem ( : , phase ) > 0_pInt )
2014-03-09 02:20:31 +05:30
Nchunks_SlipSlip = maxval ( lattice_interactionSlipSlip ( : , : , phase ) )
Nchunks_SlipTwin = maxval ( lattice_interactionSlipTwin ( : , : , phase ) )
Nchunks_TwinSlip = maxval ( lattice_interactionTwinSlip ( : , : , phase ) )
Nchunks_TwinTwin = maxval ( lattice_interactionTwinTwin ( : , : , phase ) )
2014-03-12 05:25:40 +05:30
if ( allocated ( tempPerSlip ) ) deallocate ( tempPerSlip )
if ( allocated ( tempPerTwin ) ) deallocate ( tempPerTwin )
2014-07-22 13:13:03 +05:30
if ( allocated ( tempPerTrans ) ) deallocate ( tempPerTrans )
2014-03-12 05:25:40 +05:30
allocate ( tempPerSlip ( Nchunks_SlipFamilies ) )
allocate ( tempPerTwin ( Nchunks_TwinFamilies ) )
2014-07-22 13:13:03 +05:30
allocate ( tempPerTrans ( Nchunks_TransFamilies ) )
2013-10-14 16:24:45 +05:30
endif
2014-03-09 02:20:31 +05:30
cycle ! skip to next line
2013-10-08 21:57:26 +05:30
endif
2014-07-02 17:57:39 +05:30
2014-03-09 02:20:31 +05:30
if ( phase > 0_pInt ) then ; if ( phase_plasticity ( phase ) == PLASTICITY_DISLOTWIN_ID ) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
instance = phase_plasticityInstance ( phase ) ! which instance of my plasticity is present phase
positions = IO_stringPos ( line , MAXNCHUNKS )
tag = IO_lc ( IO_stringValue ( line , positions , 1_pInt ) ) ! extract key
select case ( tag )
case ( '(output)' )
select case ( IO_lc ( IO_stringValue ( line , positions , 2_pInt ) ) )
case ( 'edge_density' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = edge_density_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'dipole_density' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = dipole_density_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'shear_rate_slip' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = shear_rate_slip_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'accumulated_shear_slip' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = accumulated_shear_slip_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'mfp_slip' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = mfp_slip_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'resolved_stress_slip' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = resolved_stress_slip_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'edge_dipole_distance' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = edge_dipole_distance_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'stress_exponent' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = stress_exponent_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'twin_fraction' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = twin_fraction_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'shear_rate_twin' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = shear_rate_twin_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'accumulated_shear_twin' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = accumulated_shear_twin_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'mfp_twin' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = mfp_twin_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'resolved_stress_twin' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = resolved_stress_twin_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'threshold_stress_twin' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = threshold_stress_twin_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'resolved_stress_shearband' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = resolved_stress_shearband_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'shear_rate_shearband' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = shear_rate_shearband_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'sb_eigenvalues' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = sb_eigenvalues_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
case ( 'sb_eigenvectors' )
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_Noutput ( instance ) = constitutive_dislotwin_Noutput ( instance ) + 1_pInt
2014-06-26 19:23:12 +05:30
constitutive_dislotwin_outputID ( constitutive_dislotwin_Noutput ( instance ) , instance ) = sb_eigenvectors_ID
2014-06-25 04:23:25 +05:30
constitutive_dislotwin_output ( constitutive_dislotwin_Noutput ( instance ) , instance ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2014-03-09 02:20:31 +05:30
end select
2014-03-12 05:25:40 +05:30
!--------------------------------------------------------------------------------------------------
2014-04-04 20:10:30 +05:30
! parameters depending on number of slip system families
2014-03-09 02:20:31 +05:30
case ( 'nslip' )
2014-03-12 05:25:40 +05:30
if ( positions ( 1 ) < Nchunks_SlipFamilies + 1_pInt ) &
2014-03-09 02:20:31 +05:30
call IO_warning ( 50_pInt , ext_msg = trim ( tag ) / / ' (' / / PLASTICITY_DISLOTWIN_label / / ')' )
2014-03-12 05:25:40 +05:30
if ( positions ( 1 ) > Nchunks_SlipFamilies + 1_pInt ) &
call IO_error ( 150_pInt , ext_msg = trim ( tag ) / / ' (' / / PLASTICITY_DISLOTWIN_label / / ')' )
2014-03-09 02:20:31 +05:30
Nchunks_SlipFamilies = positions ( 1 ) - 1_pInt
do j = 1_pInt , Nchunks_SlipFamilies
2014-04-04 20:10:30 +05:30
constitutive_dislotwin_Nslip ( j , instance ) = IO_intValue ( line , positions , 1_pInt + j )
2014-03-09 02:20:31 +05:30
enddo
2014-03-12 05:25:40 +05:30
case ( 'rhoedge0' , 'rhoedgedip0' , 'slipburgers' , 'qedge' , 'v0' , 'clambdaslip' , 'tau_peierls' , 'p_slip' , 'q_slip' )
2014-03-09 02:20:31 +05:30
do j = 1_pInt , Nchunks_SlipFamilies
2014-03-12 05:25:40 +05:30
tempPerSlip ( j ) = IO_floatValue ( line , positions , 1_pInt + j )
2014-03-09 02:20:31 +05:30
enddo
2014-03-12 05:25:40 +05:30
select case ( tag )
case ( 'rhoedge0' )
constitutive_dislotwin_rhoEdge0 ( 1 : Nchunks_SlipFamilies , instance ) = tempPerSlip ( 1 : Nchunks_SlipFamilies )
case ( 'rhoedgedip0' )
constitutive_dislotwin_rhoEdgeDip0 ( 1 : Nchunks_SlipFamilies , instance ) = tempPerSlip ( 1 : Nchunks_SlipFamilies )
case ( 'slipburgers' )
constitutive_dislotwin_burgersPerSlipFamily ( 1 : Nchunks_SlipFamilies , instance ) = tempPerSlip ( 1 : Nchunks_SlipFamilies )
case ( 'qedge' )
constitutive_dislotwin_QedgePerSlipFamily ( 1 : Nchunks_SlipFamilies , instance ) = tempPerSlip ( 1 : Nchunks_SlipFamilies )
case ( 'v0' )
constitutive_dislotwin_v0PerSlipFamily ( 1 : Nchunks_SlipFamilies , instance ) = tempPerSlip ( 1 : Nchunks_SlipFamilies )
case ( 'clambdaslip' )
constitutive_dislotwin_CLambdaSlipPerSlipFamily ( 1 : Nchunks_SlipFamilies , instance ) = tempPerSlip ( 1 : Nchunks_SlipFamilies )
case ( 'tau_peierls' )
if ( lattice_structure ( phase ) / = LATTICE_bcc_ID ) &
call IO_warning ( 42_pInt , ext_msg = trim ( tag ) / / ' for non-bcc (' / / PLASTICITY_DISLOTWIN_label / / ')' )
constitutive_dislotwin_tau_peierlsPerSlipFamily ( 1 : Nchunks_SlipFamilies , instance ) = tempPerSlip ( 1 : Nchunks_SlipFamilies )
case ( 'p_slip' )
constitutive_dislotwin_pPerSlipFamily ( 1 : Nchunks_SlipFamilies , instance ) = tempPerSlip ( 1 : Nchunks_SlipFamilies )
case ( 'q_slip' )
constitutive_dislotwin_qPerSlipFamily ( 1 : Nchunks_SlipFamilies , instance ) = tempPerSlip ( 1 : Nchunks_SlipFamilies )
end select
!--------------------------------------------------------------------------------------------------
! parameters depending on slip number of twin families
case ( 'ntwin' )
if ( positions ( 1 ) < Nchunks_TwinFamilies + 1_pInt ) &
2014-06-17 20:54:44 +05:30
call IO_warning ( 51_pInt , ext_msg = trim ( tag ) / / ' (' / / PLASTICITY_DISLOTWIN_label / / ')' )
2014-03-12 05:25:40 +05:30
if ( positions ( 1 ) > Nchunks_TwinFamilies + 1_pInt ) &
call IO_error ( 150_pInt , ext_msg = trim ( tag ) / / ' (' / / PLASTICITY_DISLOTWIN_label / / ')' )
Nchunks_TwinFamilies = positions ( 1 ) - 1_pInt
2014-03-09 02:20:31 +05:30
do j = 1_pInt , Nchunks_TwinFamilies
2014-03-12 05:25:40 +05:30
constitutive_dislotwin_Ntwin ( j , instance ) = IO_intValue ( line , positions , 1_pInt + j )
2014-03-09 02:20:31 +05:30
enddo
2014-03-12 05:25:40 +05:30
case ( 'ndot0' , 'twinsize' , 'twinburgers' , 'r_twin' )
2014-03-09 02:20:31 +05:30
do j = 1_pInt , Nchunks_TwinFamilies
2014-03-12 05:25:40 +05:30
tempPerTwin ( j ) = IO_floatValue ( line , positions , 1_pInt + j )
2014-03-09 02:20:31 +05:30
enddo
2014-03-12 05:25:40 +05:30
select case ( tag )
case ( 'ndot0' )
if ( lattice_structure ( phase ) == LATTICE_fcc_ID ) &
call IO_warning ( 42_pInt , ext_msg = trim ( tag ) / / ' for fcc (' / / PLASTICITY_DISLOTWIN_label / / ')' )
constitutive_dislotwin_Ndot0PerTwinFamily ( 1 : Nchunks_TwinFamilies , instance ) = tempPerTwin ( 1 : Nchunks_TwinFamilies )
case ( 'twinsize' )
constitutive_dislotwin_twinsizePerTwinFamily ( 1 : Nchunks_TwinFamilies , instance ) = tempPerTwin ( 1 : Nchunks_TwinFamilies )
case ( 'twinburgers' )
constitutive_dislotwin_burgersPerTwinFamily ( 1 : Nchunks_TwinFamilies , instance ) = tempPerTwin ( 1 : Nchunks_TwinFamilies )
case ( 'r_twin' )
constitutive_dislotwin_rPerTwinFamily ( 1 : Nchunks_TwinFamilies , instance ) = tempPerTwin ( 1 : Nchunks_TwinFamilies )
end select
2014-04-04 20:10:30 +05:30
!--------------------------------------------------------------------------------------------------
2014-07-22 13:13:03 +05:30
! parameters depending on number of transformation system families
case ( 'ntrans' )
if ( positions ( 1 ) < Nchunks_TransFamilies + 1_pInt ) &
call IO_warning ( 53_pInt , ext_msg = trim ( tag ) / / ' (' / / PLASTICITY_DISLOTWIN_label / / ')' )
if ( positions ( 1 ) > Nchunks_TransFamilies + 1_pInt ) &
call IO_error ( 150_pInt , ext_msg = trim ( tag ) / / ' (' / / PLASTICITY_DISLOTWIN_label / / ')' )
Nchunks_TransFamilies = positions ( 1 ) - 1_pInt
do j = 1_pInt , Nchunks_TransFamilies
constitutive_dislotwin_Ntrans ( j , instance ) = IO_intValue ( line , positions , 1_pInt + j )
enddo
!--------------------------------------------------------------------------------------------------
2014-04-04 20:10:30 +05:30
! parameters depending on number of interactions
case ( 'interaction_slipslip' , 'interactionslipslip' )
if ( positions ( 1 ) < 1_pInt + Nchunks_SlipSlip ) &
call IO_warning ( 52_pInt , ext_msg = trim ( tag ) / / ' (' / / PLASTICITY_DISLOTWIN_label / / ')' )
do j = 1_pInt , Nchunks_SlipSlip
constitutive_dislotwin_interaction_SlipSlip ( j , instance ) = IO_floatValue ( line , positions , 1_pInt + j )
enddo
case ( 'interaction_sliptwin' , 'interactionsliptwin' )
if ( positions ( 1 ) < 1_pInt + Nchunks_SlipTwin ) &
call IO_warning ( 52_pInt , ext_msg = trim ( tag ) / / ' (' / / PLASTICITY_DISLOTWIN_label / / ')' )
do j = 1_pInt , Nchunks_SlipTwin
constitutive_dislotwin_interaction_SlipTwin ( j , instance ) = IO_floatValue ( line , positions , 1_pInt + j )
enddo
case ( 'interaction_twinslip' , 'interactiontwinslip' )
if ( positions ( 1 ) < 1_pInt + Nchunks_TwinSlip ) &
call IO_warning ( 52_pInt , ext_msg = trim ( tag ) / / ' (' / / PLASTICITY_DISLOTWIN_label / / ')' )
do j = 1_pInt , Nchunks_TwinSlip
constitutive_dislotwin_interaction_TwinSlip ( j , instance ) = IO_floatValue ( line , positions , 1_pInt + j )
enddo
case ( 'interaction_twintwin' , 'interactiontwintwin' )
if ( positions ( 1 ) < 1_pInt + Nchunks_TwinTwin ) &
call IO_warning ( 52_pInt , ext_msg = trim ( tag ) / / ' (' / / PLASTICITY_DISLOTWIN_label / / ')' )
do j = 1_pInt , Nchunks_TwinTwin
constitutive_dislotwin_interaction_TwinTwin ( j , instance ) = IO_floatValue ( line , positions , 1_pInt + j )
enddo
!--------------------------------------------------------------------------------------------------
! parameters independent of number of slip/twin systems
2014-03-09 02:20:31 +05:30
case ( 'grainsize' )
constitutive_dislotwin_GrainSize ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'maxtwinfraction' )
constitutive_dislotwin_MaxTwinFraction ( instance ) = IO_floatValue ( line , positions , 2_pInt )
2014-03-12 05:25:40 +05:30
case ( 'p_shearband' )
constitutive_dislotwin_pShearBand ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'q_shearband' )
constitutive_dislotwin_qShearBand ( instance ) = IO_floatValue ( line , positions , 2_pInt )
2014-03-09 02:20:31 +05:30
case ( 'd0' )
constitutive_dislotwin_D0 ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'qsd' )
constitutive_dislotwin_Qsd ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'atol_rho' )
constitutive_dislotwin_aTolRho ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'atol_twinfrac' )
constitutive_dislotwin_aTolTwinFrac ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'cmfptwin' )
constitutive_dislotwin_Cmfptwin ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'cthresholdtwin' )
constitutive_dislotwin_Cthresholdtwin ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'solidsolutionstrength' )
constitutive_dislotwin_SolidSolutionStrength ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'l0' )
constitutive_dislotwin_L0 ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'xc' )
constitutive_dislotwin_xc ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'vcrossslip' )
constitutive_dislotwin_VcrossSlip ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'cedgedipmindistance' )
constitutive_dislotwin_CEdgeDipMinDistance ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'catomicvolume' )
constitutive_dislotwin_CAtomicVolume ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'sfe_0k' )
constitutive_dislotwin_SFE_0K ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'dsfe_dt' )
constitutive_dislotwin_dSFE_dT ( instance ) = IO_floatValue ( line , positions , 2_pInt )
2014-03-14 05:20:55 +05:30
case ( 'dipoleformationfactor' )
constitutive_dislotwin_dipoleFormationFactor ( instance ) = IO_floatValue ( line , positions , 2_pInt )
2014-03-09 02:20:31 +05:30
case ( 'shearbandresistance' )
constitutive_dislotwin_sbResistance ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'shearbandvelocity' )
constitutive_dislotwin_sbVelocity ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'qedgepersbsystem' )
constitutive_dislotwin_sbQedge ( instance ) = IO_floatValue ( line , positions , 2_pInt )
2014-07-22 13:13:03 +05:30
case ( 'c1' )
constitutive_dislotwin_c1 ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'c2' )
constitutive_dislotwin_c2 ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'c3' )
constitutive_dislotwin_c3 ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'c5' )
constitutive_dislotwin_c5 ( instance ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'deltag' )
constitutive_dislotwin_deltaG ( instance ) = IO_floatValue ( line , positions , 2_pInt )
2014-03-09 02:20:31 +05:30
end select
endif ; endif
enddo parsingFile
sanityChecks : do phase = 1_pInt , size ( phase_plasticity )
myPhase : if ( phase_plasticity ( phase ) == PLASTICITY_dislotwin_ID ) then
instance = phase_plasticityInstance ( phase )
if ( sum ( constitutive_dislotwin_Nslip ( : , instance ) ) < 0_pInt ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'Nslip (' / / PLASTICITY_DISLOTWIN_label / / ')' )
if ( sum ( constitutive_dislotwin_Ntwin ( : , instance ) ) < 0_pInt ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'Ntwin (' / / PLASTICITY_DISLOTWIN_label / / ')' )
do f = 1_pInt , lattice_maxNslipFamily
if ( constitutive_dislotwin_Nslip ( f , instance ) > 0_pInt ) then
if ( constitutive_dislotwin_rhoEdge0 ( f , instance ) < 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'rhoEdge0 (' / / PLASTICITY_DISLOTWIN_label / / ')' )
if ( constitutive_dislotwin_rhoEdgeDip0 ( f , instance ) < 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'rhoEdgeDip0 (' / / PLASTICITY_DISLOTWIN_label / / ')' )
if ( constitutive_dislotwin_burgersPerSlipFamily ( f , instance ) < = 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'slipBurgers (' / / PLASTICITY_DISLOTWIN_label / / ')' )
if ( constitutive_dislotwin_v0PerSlipFamily ( f , instance ) < = 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'v0 (' / / PLASTICITY_DISLOTWIN_label / / ')' )
2014-03-12 05:25:40 +05:30
if ( constitutive_dislotwin_tau_peierlsPerSlipFamily ( f , instance ) < 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'tau_peierls (' / / PLASTICITY_DISLOTWIN_label / / ')' )
2014-03-09 02:20:31 +05:30
endif
enddo
do f = 1_pInt , lattice_maxNtwinFamily
if ( constitutive_dislotwin_Ntwin ( f , instance ) > 0_pInt ) then
if ( constitutive_dislotwin_burgersPerTwinFamily ( f , instance ) < = 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'twinburgers (' / / PLASTICITY_DISLOTWIN_label / / ')' )
if ( constitutive_dislotwin_Ndot0PerTwinFamily ( f , instance ) < 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'ndot0 (' / / PLASTICITY_DISLOTWIN_label / / ')' )
endif
enddo
if ( constitutive_dislotwin_CAtomicVolume ( instance ) < = 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'cAtomicVolume (' / / PLASTICITY_DISLOTWIN_label / / ')' )
if ( constitutive_dislotwin_D0 ( instance ) < = 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'D0 (' / / PLASTICITY_DISLOTWIN_label / / ')' )
if ( constitutive_dislotwin_Qsd ( instance ) < = 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'Qsd (' / / PLASTICITY_DISLOTWIN_label / / ')' )
2014-03-12 05:25:40 +05:30
if ( sum ( constitutive_dislotwin_Ntwin ( : , instance ) ) > 0_pInt ) then
if ( constitutive_dislotwin_SFE_0K ( instance ) == 0.0_pReal . and . &
constitutive_dislotwin_dSFE_dT ( instance ) == 0.0_pReal . and . &
lattice_structure ( phase ) == LATTICE_fcc_ID ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'SFE0K (' / / PLASTICITY_DISLOTWIN_label / / ')' )
if ( constitutive_dislotwin_aTolRho ( instance ) < = 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'aTolRho (' / / PLASTICITY_DISLOTWIN_label / / ')' )
if ( constitutive_dislotwin_aTolTwinFrac ( instance ) < = 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'aTolTwinFrac (' / / PLASTICITY_DISLOTWIN_label / / ')' )
endif
2014-03-09 02:20:31 +05:30
if ( constitutive_dislotwin_sbResistance ( instance ) < 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'sbResistance (' / / PLASTICITY_DISLOTWIN_label / / ')' )
if ( constitutive_dislotwin_sbVelocity ( instance ) < 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'sbVelocity (' / / PLASTICITY_DISLOTWIN_label / / ')' )
2014-03-12 05:25:40 +05:30
if ( constitutive_dislotwin_sbVelocity ( instance ) > 0.0_pReal . and . &
constitutive_dislotwin_pShearBand ( instance ) < = 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'pShearBand (' / / PLASTICITY_DISLOTWIN_label / / ')' )
2014-03-14 05:20:55 +05:30
if ( constitutive_dislotwin_dipoleFormationFactor ( instance ) / = 0.0_pReal . and . &
constitutive_dislotwin_dipoleFormationFactor ( instance ) / = 1.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'dipoleFormationFactor (' / / PLASTICITY_DISLOTWIN_label / / ')' )
2014-03-12 05:25:40 +05:30
if ( constitutive_dislotwin_sbVelocity ( instance ) > 0.0_pReal . and . &
constitutive_dislotwin_qShearBand ( instance ) < = 0.0_pReal ) &
call IO_error ( 211_pInt , el = instance , ext_msg = 'qShearBand (' / / PLASTICITY_DISLOTWIN_label / / ')' )
2014-03-09 02:20:31 +05:30
!--------------------------------------------------------------------------------------------------
! Determine total number of active slip or twin systems
constitutive_dislotwin_Nslip ( : , instance ) = min ( lattice_NslipSystem ( : , phase ) , constitutive_dislotwin_Nslip ( : , instance ) )
constitutive_dislotwin_Ntwin ( : , instance ) = min ( lattice_NtwinSystem ( : , phase ) , constitutive_dislotwin_Ntwin ( : , instance ) )
2014-07-22 13:13:03 +05:30
constitutive_dislotwin_Ntrans ( : , instance ) = min ( lattice_NtransSystem ( : , phase ) , constitutive_dislotwin_Ntrans ( : , instance ) )
2014-03-09 02:20:31 +05:30
constitutive_dislotwin_totalNslip ( instance ) = sum ( constitutive_dislotwin_Nslip ( : , instance ) )
constitutive_dislotwin_totalNtwin ( instance ) = sum ( constitutive_dislotwin_Ntwin ( : , instance ) )
2014-07-22 13:13:03 +05:30
constitutive_dislotwin_totalNtrans ( instance ) = sum ( constitutive_dislotwin_Ntrans ( : , instance ) )
2014-03-09 02:20:31 +05:30
endif myPhase
enddo sanityChecks
2013-10-08 21:57:26 +05:30
!--------------------------------------------------------------------------------------------------
! allocation of variables whose size depends on the total number of active slip systems
maxTotalNslip = maxval ( constitutive_dislotwin_totalNslip )
maxTotalNtwin = maxval ( constitutive_dislotwin_totalNtwin )
2013-12-12 05:12:33 +05:30
allocate ( constitutive_dislotwin_burgersPerSlipSystem ( maxTotalNslip , maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_burgersPerTwinSystem ( maxTotalNtwin , maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_QedgePerSlipSystem ( maxTotalNslip , maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_v0PerSlipSystem ( maxTotalNslip , maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_Ndot0PerTwinSystem ( maxTotalNtwin , maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_tau_r ( maxTotalNtwin , maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_twinsizePerTwinSystem ( maxTotalNtwin , maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_CLambdaSlipPerSlipSystem ( maxTotalNslip , maxNinstance ) , source = 0.0_pReal )
2014-03-12 05:25:40 +05:30
allocate ( constitutive_dislotwin_interactionMatrix_SlipSlip ( maxval ( constitutive_dislotwin_totalNslip ) , & ! slip resistance from slip activity
maxval ( constitutive_dislotwin_totalNslip ) , &
maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_interactionMatrix_SlipTwin ( maxval ( constitutive_dislotwin_totalNslip ) , & ! slip resistance from twin activity
maxval ( constitutive_dislotwin_totalNtwin ) , &
maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_interactionMatrix_TwinSlip ( maxval ( constitutive_dislotwin_totalNtwin ) , & ! twin resistance from slip activity
maxval ( constitutive_dislotwin_totalNslip ) , &
maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_interactionMatrix_TwinTwin ( maxval ( constitutive_dislotwin_totalNtwin ) , & ! twin resistance from twin activity
maxval ( constitutive_dislotwin_totalNtwin ) , &
maxNinstance ) , source = 0.0_pReal )
2013-12-12 05:12:33 +05:30
allocate ( constitutive_dislotwin_forestProjectionEdge ( maxTotalNslip , maxTotalNslip , maxNinstance ) , &
source = 0.0_pReal )
2014-03-12 05:25:40 +05:30
allocate ( constitutive_dislotwin_Ctwin66 ( 6 , 6 , maxTotalNtwin , maxNinstance ) , source = 0.0_pReal )
allocate ( constitutive_dislotwin_Ctwin3333 ( 3 , 3 , 3 , 3 , maxTotalNtwin , maxNinstance ) , source = 0.0_pReal )
2014-03-09 02:20:31 +05:30
initializeInstances : do phase = 1_pInt , size ( phase_plasticity )
2014-07-02 17:57:39 +05:30
myPhase2 : if ( phase_plasticity ( phase ) == PLASTICITY_dislotwin_ID ) then
2014-06-11 17:41:14 +05:30
NofMyPhase = count ( material_phase == phase )
2014-03-09 02:20:31 +05:30
instance = phase_plasticityInstance ( phase )
2013-12-12 05:12:33 +05:30
2014-03-09 02:20:31 +05:30
ns = constitutive_dislotwin_totalNslip ( instance )
nt = constitutive_dislotwin_totalNtwin ( instance )
!--------------------------------------------------------------------------------------------------
! Determine size of postResults array
outputsLoop : do o = 1_pInt , constitutive_dislotwin_Noutput ( instance )
2014-02-28 15:48:40 +05:30
select case ( constitutive_dislotwin_outputID ( o , instance ) )
2013-12-12 05:12:33 +05:30
case ( edge_density_ID , &
dipole_density_ID , &
shear_rate_slip_ID , &
accumulated_shear_slip_ID , &
mfp_slip_ID , &
resolved_stress_slip_ID , &
threshold_stress_slip_ID , &
edge_dipole_distance_ID , &
stress_exponent_ID &
2013-10-14 16:24:45 +05:30
)
2014-03-09 02:20:31 +05:30
mySize = ns
2013-12-12 05:12:33 +05:30
case ( twin_fraction_ID , &
shear_rate_twin_ID , &
accumulated_shear_twin_ID , &
mfp_twin_ID , &
resolved_stress_twin_ID , &
threshold_stress_twin_ID &
2013-10-14 16:24:45 +05:30
)
2014-03-09 02:20:31 +05:30
mySize = nt
2013-12-12 05:12:33 +05:30
case ( resolved_stress_shearband_ID , &
shear_rate_shearband_ID &
2013-10-14 16:24:45 +05:30
)
2014-03-09 02:20:31 +05:30
mySize = 6_pInt
2013-12-12 05:12:33 +05:30
case ( sb_eigenvalues_ID )
2014-03-09 02:20:31 +05:30
mySize = 3_pInt
2013-12-12 05:12:33 +05:30
case ( sb_eigenvectors_ID )
2014-03-09 02:20:31 +05:30
mySize = 9_pInt
2013-10-14 16:24:45 +05:30
end select
2013-10-08 21:57:26 +05:30
2014-03-09 02:20:31 +05:30
if ( mySize > 0_pInt ) then ! any meaningful output found
constitutive_dislotwin_sizePostResult ( o , instance ) = mySize
constitutive_dislotwin_sizePostResults ( instance ) = constitutive_dislotwin_sizePostResults ( instance ) + mySize
endif
enddo outputsLoop
2014-07-02 17:57:39 +05:30
!--------------------------------------------------------------------------------------------------
! allocate state arrays
2014-06-11 17:41:14 +05:30
sizeDotState = int ( size ( CONSTITUTIVE_DISLOTWIN_listBasicSlipStates ) , pInt ) * ns &
+ int ( size ( CONSTITUTIVE_DISLOTWIN_listBasicTwinStates ) , pInt ) * nt
sizeState = sizeDotState &
+ int ( size ( CONSTITUTIVE_DISLOTWIN_listDependentSlipStates ) , pInt ) * ns &
+ int ( size ( CONSTITUTIVE_DISLOTWIN_listDependentTwinStates ) , pInt ) * nt
plasticState ( phase ) % sizeState = sizeState
plasticState ( phase ) % sizeDotState = sizeDotState
2014-07-08 20:28:23 +05:30
plasticState ( phase ) % nonlocal = . false .
2014-06-11 17:41:14 +05:30
allocate ( plasticState ( phase ) % aTolState ( sizeState ) , source = 0.0_pReal )
allocate ( plasticState ( phase ) % state0 ( sizeState , NofMyPhase ) , source = 0.0_pReal )
allocate ( plasticState ( phase ) % partionedState0 ( sizeState , NofMyPhase ) , source = 0.0_pReal )
allocate ( plasticState ( phase ) % subState0 ( sizeState , NofMyPhase ) , source = 0.0_pReal )
allocate ( plasticState ( phase ) % state ( sizeState , NofMyPhase ) , source = 0.0_pReal )
allocate ( plasticState ( phase ) % state_backup ( sizeState , NofMyPhase ) , source = 0.0_pReal )
allocate ( plasticState ( phase ) % dotState ( sizeDotState , NofMyPhase ) , source = 0.0_pReal )
2014-07-22 13:13:03 +05:30
allocate ( plasticState ( phase ) % deltaState ( sizeDotState , NofMyPhase ) , source = 0.0_pReal )
2014-06-11 17:41:14 +05:30
allocate ( plasticState ( phase ) % dotState_backup ( sizeDotState , NofMyPhase ) , source = 0.0_pReal )
if ( any ( numerics_integrator == 1_pInt ) ) then
allocate ( plasticState ( phase ) % previousDotState ( sizeDotState , NofMyPhase ) , source = 0.0_pReal )
allocate ( plasticState ( phase ) % previousDotState2 ( sizeDotState , NofMyPhase ) , source = 0.0_pReal )
endif
if ( any ( numerics_integrator == 4_pInt ) ) &
allocate ( plasticState ( phase ) % RK4dotState ( sizeDotState , NofMyPhase ) , source = 0.0_pReal )
if ( any ( numerics_integrator == 5_pInt ) ) &
allocate ( plasticState ( phase ) % RKCK45dotState ( 6 , sizeDotState , NofMyPhase ) , source = 0.0_pReal )
!* Process slip related parameters ------------------------------------------------
2014-03-09 02:20:31 +05:30
slipFamiliesLoop : do f = 1_pInt , lattice_maxNslipFamily
index_myFamily = sum ( constitutive_dislotwin_Nslip ( 1 : f - 1_pInt , instance ) ) ! index in truncated slip system list
slipSystemsLoop : do j = 1_pInt , constitutive_dislotwin_Nslip ( f , instance )
2013-12-12 05:12:33 +05:30
2013-10-14 16:24:45 +05:30
!* Burgers vector,
! dislocation velocity prefactor,
! mean free path prefactor,
! and minimum dipole distance
2014-03-09 02:20:31 +05:30
constitutive_dislotwin_burgersPerSlipSystem ( index_myFamily + j , instance ) = &
constitutive_dislotwin_burgersPerSlipFamily ( f , instance )
2013-10-14 16:24:45 +05:30
2014-03-09 02:20:31 +05:30
constitutive_dislotwin_QedgePerSlipSystem ( index_myFamily + j , instance ) = &
constitutive_dislotwin_QedgePerSlipFamily ( f , instance )
2013-10-08 21:57:26 +05:30
2014-03-09 02:20:31 +05:30
constitutive_dislotwin_v0PerSlipSystem ( index_myFamily + j , instance ) = &
constitutive_dislotwin_v0PerSlipFamily ( f , instance )
2013-10-08 21:57:26 +05:30
2014-03-09 02:20:31 +05:30
constitutive_dislotwin_CLambdaSlipPerSlipSystem ( index_myFamily + j , instance ) = &
constitutive_dislotwin_CLambdaSlipPerSlipFamily ( f , instance )
!* Calculation of forest projections for edge dislocations
!* Interaction matrices
do o = 1_pInt , lattice_maxNslipFamily
index_otherFamily = sum ( constitutive_dislotwin_Nslip ( 1 : o - 1_pInt , instance ) )
do k = 1_pInt , constitutive_dislotwin_Nslip ( o , instance ) ! loop over (active) systems in other family (slip)
constitutive_dislotwin_forestProjectionEdge ( index_myFamily + j , index_otherFamily + k , instance ) = &
abs ( math_mul3x3 ( lattice_sn ( : , sum ( lattice_NslipSystem ( 1 : f - 1 , phase ) ) + j , phase ) , &
lattice_st ( : , sum ( lattice_NslipSystem ( 1 : o - 1 , phase ) ) + k , phase ) ) )
constitutive_dislotwin_interactionMatrix_SlipSlip ( index_myFamily + j , index_otherFamily + k , instance ) = &
constitutive_dislotwin_interaction_SlipSlip ( lattice_interactionSlipSlip ( &
sum ( lattice_NslipSystem ( 1 : f - 1 , phase ) ) + j , &
sum ( lattice_NslipSystem ( 1 : o - 1 , phase ) ) + k , &
phase ) , instance )
enddo ; enddo
do o = 1_pInt , lattice_maxNtwinFamily
index_otherFamily = sum ( constitutive_dislotwin_Ntwin ( 1 : o - 1_pInt , instance ) )
do k = 1_pInt , constitutive_dislotwin_Ntwin ( o , instance ) ! loop over (active) systems in other family (twin)
constitutive_dislotwin_interactionMatrix_SlipTwin ( index_myFamily + j , index_otherFamily + k , instance ) = &
constitutive_dislotwin_interaction_SlipTwin ( lattice_interactionSlipTwin ( &
sum ( lattice_NslipSystem ( 1 : f - 1_pInt , phase ) ) + j , &
sum ( lattice_NtwinSystem ( 1 : o - 1_pInt , phase ) ) + k , &
phase ) , instance )
enddo ; enddo
enddo slipSystemsLoop
enddo slipFamiliesLoop
2013-10-14 16:24:45 +05:30
!* Process twin related parameters ------------------------------------------------
2014-03-09 02:20:31 +05:30
twinFamiliesLoop : do f = 1_pInt , lattice_maxNtwinFamily
index_myFamily = sum ( constitutive_dislotwin_Ntwin ( 1 : f - 1_pInt , instance ) ) ! index in truncated twin system list
twinSystemsLoop : do j = 1_pInt , constitutive_dislotwin_Ntwin ( f , instance )
2013-10-08 21:57:26 +05:30
2014-03-09 02:20:31 +05:30
!* Burgers vector,
! nucleation rate prefactor,
! and twin size
2013-10-08 21:57:26 +05:30
2014-03-09 02:20:31 +05:30
constitutive_dislotwin_burgersPerTwinSystem ( index_myFamily + j , instance ) = &
constitutive_dislotwin_burgersPerTwinFamily ( f , instance )
2014-02-28 15:48:40 +05:30
2014-03-09 02:20:31 +05:30
constitutive_dislotwin_Ndot0PerTwinSystem ( index_myFamily + j , instance ) = &
constitutive_dislotwin_Ndot0PerTwinFamily ( f , instance )
2014-02-28 15:48:40 +05:30
2014-03-09 02:20:31 +05:30
constitutive_dislotwin_twinsizePerTwinSystem ( index_myFamily + j , instance ) = &
constitutive_dislotwin_twinsizePerTwinFamily ( f , instance )
!* Rotate twin elasticity matrices
index_otherFamily = sum ( lattice_NtwinSystem ( 1 : f - 1_pInt , phase ) ) ! index in full lattice twin list
2014-03-12 05:25:40 +05:30
do l = 1_pInt , 3_pInt ; do m = 1_pInt , 3_pInt ; do n = 1_pInt , 3_pInt ; do o = 1_pInt , 3_pInt
do p = 1_pInt , 3_pInt ; do q = 1_pInt , 3_pInt ; do r = 1_pInt , 3_pInt ; do s = 1_pInt , 3_pInt
constitutive_dislotwin_Ctwin3333 ( l , m , n , o , index_myFamily + j , instance ) = &
constitutive_dislotwin_Ctwin3333 ( l , m , n , o , index_myFamily + j , instance ) + &
2014-03-09 02:20:31 +05:30
lattice_C3333 ( p , q , r , s , instance ) * &
lattice_Qtwin ( l , p , index_otherFamily + j , phase ) * &
lattice_Qtwin ( m , q , index_otherFamily + j , phase ) * &
lattice_Qtwin ( n , r , index_otherFamily + j , phase ) * &
lattice_Qtwin ( o , s , index_otherFamily + j , phase )
2014-03-12 05:25:40 +05:30
enddo ; enddo ; enddo ; enddo
enddo ; enddo ; enddo ; enddo
constitutive_dislotwin_Ctwin66 ( 1 : 6 , 1 : 6 , index_myFamily + j , instance ) = &
math_Mandel3333to66 ( constitutive_dislotwin_Ctwin3333 ( 1 : 3 , 1 : 3 , 1 : 3 , 1 : 3 , index_myFamily + j , instance ) )
2013-10-08 21:57:26 +05:30
2014-03-09 02:20:31 +05:30
!* Interaction matrices
do o = 1_pInt , lattice_maxNslipFamily
index_otherFamily = sum ( constitutive_dislotwin_Nslip ( 1 : o - 1_pInt , instance ) )
do k = 1_pInt , constitutive_dislotwin_Nslip ( o , instance ) ! loop over (active) systems in other family (slip)
constitutive_dislotwin_interactionMatrix_TwinSlip ( index_myFamily + j , index_otherFamily + k , instance ) = &
constitutive_dislotwin_interaction_TwinSlip ( lattice_interactionTwinSlip ( &
sum ( lattice_NtwinSystem ( 1 : f - 1_pInt , phase ) ) + j , &
sum ( lattice_NslipSystem ( 1 : o - 1_pInt , phase ) ) + k , &
phase ) , instance )
enddo ; enddo
do o = 1_pInt , lattice_maxNtwinFamily
index_otherFamily = sum ( constitutive_dislotwin_Ntwin ( 1 : o - 1_pInt , instance ) )
do k = 1_pInt , constitutive_dislotwin_Ntwin ( o , instance ) ! loop over (active) systems in other family (twin)
constitutive_dislotwin_interactionMatrix_TwinTwin ( index_myFamily + j , index_otherFamily + k , instance ) = &
constitutive_dislotwin_interaction_TwinTwin ( lattice_interactionTwinTwin ( &
sum ( lattice_NtwinSystem ( 1 : f - 1_pInt , phase ) ) + j , &
sum ( lattice_NtwinSystem ( 1 : o - 1_pInt , phase ) ) + k , &
phase ) , instance )
enddo ; enddo
enddo twinSystemsLoop
enddo twinFamiliesLoop
2014-07-02 17:57:39 +05:30
2014-06-11 17:41:14 +05:30
call constitutive_dislotwin_stateInit ( phase , instance )
call constitutive_dislotwin_aTolState ( phase , instance )
2014-07-02 17:57:39 +05:30
endif myPhase2
2013-10-08 21:57:26 +05:30
2014-03-09 02:20:31 +05:30
enddo initializeInstances
2013-02-06 14:15:08 +05:30
end subroutine constitutive_dislotwin_init
2011-04-13 17:21:46 +05:30
2014-06-11 17:41:14 +05:30
!--------------------------------------------------------------------------------------------------
2014-07-02 17:57:39 +05:30
!> @brief sets the relevant state values for a given instance of this plasticity
2014-06-11 17:41:14 +05:30
!--------------------------------------------------------------------------------------------------
2014-07-02 17:57:39 +05:30
subroutine constitutive_dislotwin_stateInit ( ph , instance )
2014-06-11 17:41:14 +05:30
use math , only : &
pi
use lattice , only : &
lattice_maxNslipFamily , &
lattice_structure , &
lattice_mu , &
lattice_bcc_ID
use material , only : &
plasticState
2014-07-02 17:57:39 +05:30
2014-06-11 17:41:14 +05:30
implicit none
2014-07-02 17:57:39 +05:30
integer ( pInt ) , intent ( in ) :: &
instance , & !< number specifying the instance of the plasticity
ph
2014-06-11 17:41:14 +05:30
2014-07-02 17:57:39 +05:30
real ( pReal ) , dimension ( plasticState ( ph ) % sizeState ) :: tempState
2014-06-11 17:41:14 +05:30
integer ( pInt ) :: i , j , f , ns , nt , index_myFamily
real ( pReal ) , dimension ( constitutive_dislotwin_totalNslip ( instance ) ) :: &
rhoEdge0 , &
rhoEdgeDip0 , &
invLambdaSlip0 , &
MeanFreePathSlip0 , &
tauSlipThreshold0
real ( pReal ) , dimension ( constitutive_dislotwin_totalNtwin ( instance ) ) :: &
MeanFreePathTwin0 , TwinVolume0
tempState = 0.0_pReal
ns = constitutive_dislotwin_totalNslip ( instance )
nt = constitutive_dislotwin_totalNtwin ( instance )
!--------------------------------------------------------------------------------------------------
! initialize basic slip state variables
do f = 1_pInt , lattice_maxNslipFamily
index_myFamily = sum ( constitutive_dislotwin_Nslip ( 1 : f - 1_pInt , instance ) ) ! index in truncated slip system list
rhoEdge0 ( index_myFamily + 1_pInt : &
index_myFamily + constitutive_dislotwin_Nslip ( f , instance ) ) = &
constitutive_dislotwin_rhoEdge0 ( f , instance )
rhoEdgeDip0 ( index_myFamily + 1_pInt : &
index_myFamily + constitutive_dislotwin_Nslip ( f , instance ) ) = &
constitutive_dislotwin_rhoEdgeDip0 ( f , instance )
enddo
tempState ( 1_pInt : ns ) = rhoEdge0
tempState ( ns + 1_pInt : 2_pInt * ns ) = rhoEdgeDip0
!--------------------------------------------------------------------------------------------------
! initialize dependent slip microstructural variables
forall ( i = 1_pInt : ns ) &
invLambdaSlip0 ( i ) = sqrt ( dot_product ( ( rhoEdge0 + rhoEdgeDip0 ) , constitutive_dislotwin_forestProjectionEdge ( 1 : ns , i , instance ) ) ) / &
constitutive_dislotwin_CLambdaSlipPerSlipSystem ( i , instance )
tempState ( 3_pInt * ns + 2_pInt * nt + 1 : 4_pInt * ns + 2_pInt * nt ) = invLambdaSlip0
forall ( i = 1_pInt : ns ) &
MeanFreePathSlip0 ( i ) = &
constitutive_dislotwin_GrainSize ( instance ) / ( 1.0_pReal + invLambdaSlip0 ( i ) * constitutive_dislotwin_GrainSize ( instance ) )
tempState ( 5_pInt * ns + 3_pInt * nt + 1 : 6_pInt * ns + 3_pInt * nt ) = MeanFreePathSlip0
forall ( i = 1_pInt : ns ) &
tauSlipThreshold0 ( i ) = &
2014-07-02 17:57:39 +05:30
lattice_mu ( ph ) * constitutive_dislotwin_burgersPerSlipSystem ( i , instance ) * &
2014-06-11 17:41:14 +05:30
sqrt ( dot_product ( ( rhoEdge0 + rhoEdgeDip0 ) , constitutive_dislotwin_interactionMatrix_SlipSlip ( i , 1 : ns , instance ) ) )
tempState ( 6_pInt * ns + 4_pInt * nt + 1 : 7_pInt * ns + 4_pInt * nt ) = tauSlipThreshold0
2011-04-13 17:21:46 +05:30
2014-06-11 17:41:14 +05:30
!--------------------------------------------------------------------------------------------------
! initialize dependent twin microstructural variables
forall ( j = 1_pInt : nt ) &
MeanFreePathTwin0 ( j ) = constitutive_dislotwin_GrainSize ( instance )
tempState ( 6_pInt * ns + 3_pInt * nt + 1_pInt : 6_pInt * ns + 4_pInt * nt ) = MeanFreePathTwin0
forall ( j = 1_pInt : nt ) &
TwinVolume0 ( j ) = &
( pi / 4.0_pReal ) * constitutive_dislotwin_twinsizePerTwinSystem ( j , instance ) * MeanFreePathTwin0 ( j ) ** ( 2.0_pReal )
tempState ( 7_pInt * ns + 5_pInt * nt + 1_pInt : 7_pInt * ns + 6_pInt * nt ) = TwinVolume0
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state0 = spread ( tempState , 2 , size ( plasticState ( ph ) % state ( 1 , : ) ) )
2014-06-11 17:41:14 +05:30
end subroutine constitutive_dislotwin_stateInit
!--------------------------------------------------------------------------------------------------
!> @brief sets the relevant state values for a given instance of this plasticity
!--------------------------------------------------------------------------------------------------
2014-07-02 17:57:39 +05:30
subroutine constitutive_dislotwin_aTolState ( ph , instance )
2014-06-11 17:41:14 +05:30
use material , only : &
plasticState
implicit none
integer ( pInt ) , intent ( in ) :: &
2014-07-02 17:57:39 +05:30
ph , &
2014-06-11 17:41:14 +05:30
instance ! number specifying the current instance of the plasticity
2013-10-08 21:57:26 +05:30
2013-05-20 02:02:06 +05:30
! Tolerance state for dislocation densities
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % aTolState ( 1_pInt : 2_pInt * constitutive_dislotwin_totalNslip ( instance ) ) = &
2014-02-28 15:48:40 +05:30
constitutive_dislotwin_aTolRho ( instance )
2013-07-01 18:36:01 +05:30
2013-05-20 02:02:06 +05:30
! Tolerance state for accumulated shear due to slip
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % aTolState ( 2_pInt * constitutive_dislotwin_totalNslip ( instance ) + 1_pInt : &
2014-02-28 15:48:40 +05:30
3_pInt * constitutive_dislotwin_totalNslip ( instance ) ) = 1e6_pReal
2013-05-20 02:02:06 +05:30
! Tolerance state for twin volume fraction
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % aTolState ( 3_pInt * constitutive_dislotwin_totalNslip ( instance ) + 1_pInt : &
2014-02-28 15:48:40 +05:30
3_pInt * constitutive_dislotwin_totalNslip ( instance ) + &
constitutive_dislotwin_totalNtwin ( instance ) ) = &
constitutive_dislotwin_aTolTwinFrac ( instance )
2011-04-13 17:21:46 +05:30
2013-05-20 02:02:06 +05:30
! Tolerance state for accumulated shear due to twin
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % aTolState ( 3_pInt * constitutive_dislotwin_totalNslip ( instance ) + &
2014-02-28 15:48:40 +05:30
constitutive_dislotwin_totalNtwin ( instance ) + 1_pInt : &
3_pInt * constitutive_dislotwin_totalNslip ( instance ) + &
2_pInt * constitutive_dislotwin_totalNtwin ( instance ) ) = 1e6_pReal
2011-04-13 17:21:46 +05:30
2014-07-02 17:57:39 +05:30
end subroutine constitutive_dislotwin_aTolState
2014-07-22 13:13:03 +05:30
2013-10-08 21:57:26 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief returns the homogenized elasticity matrix
!--------------------------------------------------------------------------------------------------
2014-07-02 17:57:39 +05:30
function constitutive_dislotwin_homogenizedC ( ipc , ip , el )
2013-10-08 21:57:26 +05:30
use prec , only : &
p_vec
use mesh , only : &
mesh_NcpElems , &
mesh_maxNips
use material , only : &
homogenization_maxNgrains , &
material_phase , &
2014-07-02 17:57:39 +05:30
phase_plasticityInstance , &
plasticState , &
mappingConstitutive
2014-03-09 02:20:31 +05:30
use lattice , only : &
lattice_C66
2013-10-08 21:57:26 +05:30
implicit none
real ( pReal ) , dimension ( 6 , 6 ) :: &
constitutive_dislotwin_homogenizedC
integer ( pInt ) , intent ( in ) :: &
2014-03-09 02:20:31 +05:30
ipc , & !< component-ID of integration point
ip , & !< integration point
el !< element
2014-07-02 17:57:39 +05:30
integer ( pInt ) :: instance , ns , nt , i , &
ph , &
of
2013-10-08 21:57:26 +05:30
real ( pReal ) :: sumf
2014-07-02 17:57:39 +05:30
2013-10-08 21:57:26 +05:30
!* Shortened notation
2014-07-02 17:57:39 +05:30
of = mappingConstitutive ( 1 , ipc , ip , el )
ph = mappingConstitutive ( 2 , ipc , ip , el )
instance = phase_plasticityInstance ( ph )
2014-02-28 15:48:40 +05:30
ns = constitutive_dislotwin_totalNslip ( instance )
nt = constitutive_dislotwin_totalNtwin ( instance )
2013-10-08 21:57:26 +05:30
!* Total twin volume fraction
2014-07-02 17:57:39 +05:30
sumf = sum ( plasticState ( ph ) % state ( ( 3_pInt * ns + 1_pInt ) : ( 3_pInt * ns + nt ) , of ) ) ! safe for nt == 0
2013-10-08 21:57:26 +05:30
!* Homogenized elasticity matrix
2014-07-02 17:57:39 +05:30
constitutive_dislotwin_homogenizedC = ( 1.0_pReal - sumf ) * lattice_C66 ( 1 : 6 , 1 : 6 , ph )
2013-10-08 21:57:26 +05:30
do i = 1_pInt , nt
2013-10-14 16:24:45 +05:30
constitutive_dislotwin_homogenizedC = &
2014-07-02 17:57:39 +05:30
constitutive_dislotwin_homogenizedC + plasticState ( ph ) % state ( 3_pInt * ns + i , of ) * lattice_C66 ( 1 : 6 , 1 : 6 , ph )
2013-10-08 21:57:26 +05:30
enddo
end function constitutive_dislotwin_homogenizedC
!--------------------------------------------------------------------------------------------------
!> @brief calculates derived quantities from state
!--------------------------------------------------------------------------------------------------
2014-07-02 17:57:39 +05:30
subroutine constitutive_dislotwin_microstructure ( temperature , ipc , ip , el )
2013-10-08 21:57:26 +05:30
use prec , only : &
p_vec
use math , only : &
pi
use mesh , only : &
mesh_NcpElems , &
mesh_maxNips
use material , only : &
homogenization_maxNgrains , &
material_phase , &
2014-07-02 17:57:39 +05:30
phase_plasticityInstance , &
plasticState , &
mappingConstitutive
2014-03-09 02:20:31 +05:30
use lattice , only : &
2014-03-12 05:25:40 +05:30
lattice_structure , &
2014-03-09 02:20:31 +05:30
lattice_mu , &
2014-03-12 05:25:40 +05:30
lattice_nu , &
2014-03-30 20:34:06 +05:30
lattice_bcc_ID , &
lattice_maxNslipFamily
2014-03-12 05:25:40 +05:30
2011-04-13 17:21:46 +05:30
2013-10-08 21:57:26 +05:30
implicit none
integer ( pInt ) , intent ( in ) :: &
ipc , & !< component-ID of integration point
ip , & !< integration point
el !< element
real ( pReal ) , intent ( in ) :: &
temperature !< temperature at IP
2014-07-02 17:57:39 +05:30
2013-10-08 21:57:26 +05:30
integer ( pInt ) :: &
2014-07-02 17:57:39 +05:30
instance , &
ns , nt , s , t , &
ph , &
of
2013-10-08 21:57:26 +05:30
real ( pReal ) :: &
sumf , sfe , x0
real ( pReal ) , dimension ( constitutive_dislotwin_totalNtwin ( phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) ) ) :: fOverStacksize
2014-07-02 17:57:39 +05:30
2013-10-08 21:57:26 +05:30
!* Shortened notation
2014-07-02 17:57:39 +05:30
of = mappingConstitutive ( 1 , ipc , ip , el )
ph = mappingConstitutive ( 2 , ipc , ip , el )
instance = phase_plasticityInstance ( ph )
2014-02-28 15:48:40 +05:30
ns = constitutive_dislotwin_totalNslip ( instance )
nt = constitutive_dislotwin_totalNtwin ( instance )
2013-10-08 21:57:26 +05:30
!* State: 1 : ns rho_edge
!* State: ns+1 : 2*ns rho_dipole
!* State: 2*ns+1 : 3*ns accumulated shear due to slip
!* State: 3*ns+1 : 3*ns+nt f
!* State: 3*ns+nt+1 : 3*ns+2*nt accumulated shear due to twin
!* State: 3*ns+2*nt+1 : 4*ns+2*nt 1/lambda_slip
!* State: 4*ns+2*nt+1 : 5*ns+2*nt 1/lambda_sliptwin
!* State: 5*ns+2*nt+1 : 5*ns+3*nt 1/lambda_twin
!* State: 5*ns+3*nt+1 : 6*ns+3*nt mfp_slip
!* State: 6*ns+3*nt+1 : 6*ns+4*nt mfp_twin
!* State: 6*ns+4*nt+1 : 7*ns+4*nt threshold_stress_slip
!* State: 7*ns+4*nt+1 : 7*ns+5*nt threshold_stress_twin
!* State: 7*ns+5*nt+1 : 7*ns+6*nt twin volume
!* Total twin volume fraction
2014-07-02 17:57:39 +05:30
sumf = sum ( plasticState ( ph ) % state ( ( 3 * ns + 1 ) : ( 3 * ns + nt ) , of ) ) ! safe for nt == 0
2013-10-08 21:57:26 +05:30
!* Stacking fault energy
2014-02-28 15:48:40 +05:30
sfe = constitutive_dislotwin_SFE_0K ( instance ) + &
constitutive_dislotwin_dSFE_dT ( instance ) * Temperature
2013-10-08 21:57:26 +05:30
!* rescaled twin volume fraction for topology
forall ( t = 1_pInt : nt ) &
2013-10-14 16:24:45 +05:30
fOverStacksize ( t ) = &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( 3_pInt * ns + t , of ) / constitutive_dislotwin_twinsizePerTwinSystem ( t , instance )
2013-10-08 21:57:26 +05:30
!* 1/mean free distance between 2 forest dislocations seen by a moving dislocation
forall ( s = 1_pInt : ns ) &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( 3_pInt * ns + 2_pInt * nt + s , of ) = &
sqrt ( dot_product ( ( plasticState ( ph ) % state ( 1 : ns , of ) + plasticState ( ph ) % state ( ns + 1_pInt : 2_pInt * ns , of ) ) , &
2014-02-28 15:48:40 +05:30
constitutive_dislotwin_forestProjectionEdge ( 1 : ns , s , instance ) ) ) / &
constitutive_dislotwin_CLambdaSlipPerSlipSystem ( s , instance )
2013-10-08 21:57:26 +05:30
!* 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation
!$OMP CRITICAL (evilmatmul)
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( ( 4_pInt * ns + 2_pInt * nt + 1_pInt ) : ( 5_pInt * ns + 2_pInt * nt ) , of ) = 0.0_pReal
2013-10-08 21:57:26 +05:30
if ( nt > 0_pInt . and . ns > 0_pInt ) &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( ( 4_pInt * ns + 2_pInt * nt + 1 ) : ( 5_pInt * ns + 2_pInt * nt ) , of ) = &
2014-02-28 15:48:40 +05:30
matmul ( constitutive_dislotwin_interactionMatrix_SlipTwin ( 1 : ns , 1 : nt , instance ) , fOverStacksize ( 1 : nt ) ) / ( 1.0_pReal - sumf )
2013-10-08 21:57:26 +05:30
!$OMP END CRITICAL (evilmatmul)
!* 1/mean free distance between 2 twin stacks from different systems seen by a growing twin
!$OMP CRITICAL (evilmatmul)
if ( nt > 0_pInt ) &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( ( 5_pInt * ns + 2_pInt * nt + 1_pInt ) : ( 5_pInt * ns + 3_pInt * nt ) , of ) = &
2014-02-28 15:48:40 +05:30
matmul ( constitutive_dislotwin_interactionMatrix_TwinTwin ( 1 : nt , 1 : nt , instance ) , fOverStacksize ( 1 : nt ) ) / ( 1.0_pReal - sumf )
2013-10-08 21:57:26 +05:30
!$OMP END CRITICAL (evilmatmul)
!* mean free path between 2 obstacles seen by a moving dislocation
do s = 1_pInt , ns
2013-10-14 16:24:45 +05:30
if ( nt > 0_pInt ) then
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( 5_pInt * ns + 3_pInt * nt + s , of ) = &
2014-02-28 15:48:40 +05:30
constitutive_dislotwin_GrainSize ( instance ) / ( 1.0_pReal + constitutive_dislotwin_GrainSize ( instance ) * &
2014-07-02 17:57:39 +05:30
( plasticState ( ph ) % state ( 3_pInt * ns + 2_pInt * nt + s , of ) + plasticState ( ph ) % state ( 4_pInt * ns + 2_pInt * nt + s , of ) ) )
2013-10-14 16:24:45 +05:30
else
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( 5_pInt * ns + s , of ) = &
2014-02-28 15:48:40 +05:30
constitutive_dislotwin_GrainSize ( instance ) / &
2014-07-02 17:57:39 +05:30
( 1.0_pReal + constitutive_dislotwin_GrainSize ( instance ) * ( plasticState ( ph ) % state ( 3_pInt * ns + s , of ) ) )
2013-10-14 16:24:45 +05:30
endif
2013-10-08 21:57:26 +05:30
enddo
2014-03-12 05:25:40 +05:30
2013-10-08 21:57:26 +05:30
!* mean free path between 2 obstacles seen by a growing twin
forall ( t = 1_pInt : nt ) &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( 6_pInt * ns + 3_pInt * nt + t , of ) = &
2014-02-28 15:48:40 +05:30
( constitutive_dislotwin_Cmfptwin ( instance ) * constitutive_dislotwin_GrainSize ( instance ) ) / &
2014-07-02 17:57:39 +05:30
( 1.0_pReal + constitutive_dislotwin_GrainSize ( instance ) * plasticState ( ph ) % state ( 5_pInt * ns + 2_pInt * nt + t , of ) )
2013-10-08 21:57:26 +05:30
!* threshold stress for dislocation motion
2014-03-30 20:34:06 +05:30
forall ( s = 1_pInt : ns ) &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( 6_pInt * ns + 4_pInt * nt + s , of ) = &
lattice_mu ( ph ) * constitutive_dislotwin_burgersPerSlipSystem ( s , instance ) * &
sqrt ( dot_product ( ( plasticState ( ph ) % state ( 1 : ns , of ) + plasticState ( ph ) % state ( ns + 1_pInt : 2_pInt * ns , of ) ) , &
2014-03-30 20:34:06 +05:30
constitutive_dislotwin_interactionMatrix_SlipSlip ( s , 1 : ns , instance ) ) )
2013-10-08 21:57:26 +05:30
!* threshold stress for growing twin
forall ( t = 1_pInt : nt ) &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( 7_pInt * ns + 4_pInt * nt + t , of ) = &
2014-02-28 15:48:40 +05:30
constitutive_dislotwin_Cthresholdtwin ( instance ) * &
( sfe / ( 3.0_pReal * constitutive_dislotwin_burgersPerTwinSystem ( t , instance ) ) + &
2014-07-02 17:57:39 +05:30
3.0_pReal * constitutive_dislotwin_burgersPerTwinSystem ( t , instance ) * lattice_mu ( ph ) / &
2014-02-28 15:48:40 +05:30
( constitutive_dislotwin_L0 ( instance ) * constitutive_dislotwin_burgersPerSlipSystem ( t , instance ) ) )
2013-10-08 21:57:26 +05:30
!* final twin volume after growth
forall ( t = 1_pInt : nt ) &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( 7_pInt * ns + 5_pInt * nt + t , of ) = &
( pi / 4.0_pReal ) * constitutive_dislotwin_twinsizePerTwinSystem ( t , instance ) * plasticState ( ph ) % state ( 6 * ns + 3 * nt + t , of ) ** ( 2.0_pReal )
2014-06-11 17:41:14 +05:30
2013-10-08 21:57:26 +05:30
!* equilibrium seperation of partial dislocations
do t = 1_pInt , nt
2014-07-02 17:57:39 +05:30
x0 = lattice_mu ( ph ) * constitutive_dislotwin_burgersPerTwinSystem ( t , instance ) ** ( 2.0_pReal ) / &
( sfe * 8.0_pReal * pi ) * ( 2.0_pReal + lattice_nu ( ph ) ) / ( 1.0_pReal - lattice_nu ( ph ) )
2014-02-28 15:48:40 +05:30
constitutive_dislotwin_tau_r ( t , instance ) = &
2014-07-02 17:57:39 +05:30
lattice_mu ( ph ) * constitutive_dislotwin_burgersPerTwinSystem ( t , instance ) / ( 2.0_pReal * pi ) * &
( 1 / ( x0 + constitutive_dislotwin_xc ( instance ) ) + cos ( pi / 3.0_pReal ) / x0 ) !!! used where??
2013-10-08 21:57:26 +05:30
enddo
2014-07-02 17:57:39 +05:30
2013-10-08 21:57:26 +05:30
end subroutine constitutive_dislotwin_microstructure
2011-04-13 17:21:46 +05:30
2013-10-08 21:57:26 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief calculates plastic velocity gradient and its tangent
!--------------------------------------------------------------------------------------------------
2014-07-02 17:57:39 +05:30
subroutine constitutive_dislotwin_LpAndItsTangent ( Lp , dLp_dTstar , Tstar_v , Temperature , ipc , ip , el )
2013-10-08 21:57:26 +05:30
use prec , only : &
2014-03-12 05:25:40 +05:30
p_vec , &
tol_math_check
2013-10-08 21:57:26 +05:30
use math , only : &
math_Plain3333to99 , &
math_Mandel6to33 , &
math_Mandel33to6 , &
math_spectralDecompositionSym33 , &
math_tensorproduct , &
math_symmetric33 , &
math_mul33x3
use mesh , only : &
mesh_NcpElems , &
mesh_maxNips
use material , only : &
homogenization_maxNgrains , &
material_phase , &
2014-07-02 17:57:39 +05:30
phase_plasticityInstance , &
plasticState , &
mappingConstitutive
2013-10-08 21:57:26 +05:30
use lattice , only : &
lattice_Sslip , &
lattice_Sslip_v , &
lattice_Stwin , &
lattice_Stwin_v , &
lattice_maxNslipFamily , &
lattice_maxNtwinFamily , &
lattice_NslipSystem , &
lattice_NtwinSystem , &
lattice_shearTwin , &
2014-03-09 02:20:31 +05:30
lattice_structure , &
lattice_fcc_twinNucleationSlipPair , &
2013-11-27 21:50:27 +05:30
LATTICE_fcc_ID
2013-10-14 16:24:45 +05:30
2013-10-08 21:57:26 +05:30
implicit none
2014-03-13 12:13:49 +05:30
integer ( pInt ) , intent ( in ) :: ipc , ip , el
real ( pReal ) , intent ( in ) :: Temperature
real ( pReal ) , dimension ( 6 ) , intent ( in ) :: Tstar_v
real ( pReal ) , dimension ( 3 , 3 ) , intent ( out ) :: Lp
real ( pReal ) , dimension ( 9 , 9 ) , intent ( out ) :: dLp_dTstar
2013-10-08 21:57:26 +05:30
2014-07-02 17:57:39 +05:30
integer ( pInt ) :: instance , ph , of , ns , nt , f , i , j , k , l , m , n , index_myFamily , s1 , s2
2013-10-08 21:57:26 +05:30
real ( pReal ) :: sumf , StressRatio_p , StressRatio_pminus1 , StressRatio_r , BoltzmannRatio , DotGamma0 , Ndot0
real ( pReal ) , dimension ( 3 , 3 , 3 , 3 ) :: dLp_dTstar3333
real ( pReal ) , dimension ( constitutive_dislotwin_totalNslip ( phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) ) ) :: &
2013-10-14 16:24:45 +05:30
gdot_slip , dgdot_dtauslip , tau_slip
2013-10-08 21:57:26 +05:30
real ( pReal ) , dimension ( constitutive_dislotwin_totalNtwin ( phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) ) ) :: &
2013-10-14 16:24:45 +05:30
gdot_twin , dgdot_dtautwin , tau_twin
2013-10-08 21:57:26 +05:30
real ( pReal ) , dimension ( 6 ) :: gdot_sb , dgdot_dtausb , tau_sb
real ( pReal ) , dimension ( 3 , 3 ) :: eigVectors , sb_Smatrix
real ( pReal ) , dimension ( 3 ) :: eigValues , sb_s , sb_m
real ( pReal ) , dimension ( 3 , 6 ) , parameter :: &
2013-10-14 16:24:45 +05:30
sb_sComposition = &
reshape ( real ( [ &
1 , 0 , 1 , &
1 , 0 , - 1 , &
1 , 1 , 0 , &
1 , - 1 , 0 , &
0 , 1 , 1 , &
0 , 1 , - 1 &
] , pReal ) , [ 3 , 6 ] ) , &
sb_mComposition = &
reshape ( real ( [ &
1 , 0 , - 1 , &
1 , 0 , + 1 , &
1 , - 1 , 0 , &
1 , 1 , 0 , &
0 , 1 , - 1 , &
0 , 1 , 1 &
] , pReal ) , [ 3 , 6 ] )
2014-07-02 17:57:39 +05:30
logical error
2013-10-08 21:57:26 +05:30
!* Shortened notation
2014-07-02 17:57:39 +05:30
of = mappingConstitutive ( 1 , ipc , ip , el )
ph = mappingConstitutive ( 2 , ipc , ip , el )
instance = phase_plasticityInstance ( ph )
2014-02-28 15:48:40 +05:30
ns = constitutive_dislotwin_totalNslip ( instance )
nt = constitutive_dislotwin_totalNtwin ( instance )
2014-06-11 17:41:14 +05:30
2013-10-08 21:57:26 +05:30
!* Total twin volume fraction
2014-07-02 17:57:39 +05:30
sumf = sum ( plasticState ( ph ) % state ( ( 3_pInt * ns + 1_pInt ) : ( 3_pInt * ns + nt ) , of ) ) ! safe for nt == 0
2013-10-08 21:57:26 +05:30
Lp = 0.0_pReal
dLp_dTstar3333 = 0.0_pReal
dLp_dTstar = 0.0_pReal
!* Dislocation glide part
gdot_slip = 0.0_pReal
dgdot_dtauslip = 0.0_pReal
j = 0_pInt
2013-12-12 05:12:33 +05:30
slipFamiliesLoop : do f = 1_pInt , lattice_maxNslipFamily
2014-07-02 17:57:39 +05:30
index_myFamily = sum ( lattice_NslipSystem ( 1 : f - 1_pInt , ph ) ) ! at which index starts my family
2014-02-28 15:48:40 +05:30
slipSystemsLoop : do i = 1_pInt , constitutive_dislotwin_Nslip ( f , instance )
2013-12-12 05:12:33 +05:30
j = j + 1_pInt
!* Calculation of Lp
!* Resolved shear stress on slip system
2014-07-02 17:57:39 +05:30
tau_slip ( j ) = dot_product ( Tstar_v , lattice_Sslip_v ( : , 1 , index_myFamily + i , ph ) )
2014-03-30 20:34:06 +05:30
2014-07-02 17:57:39 +05:30
if ( ( abs ( tau_slip ( j ) ) - plasticState ( ph ) % state ( 6 * ns + 4 * nt + j , of ) ) > tol_math_check ) then
2013-12-12 05:12:33 +05:30
!* Stress ratios
2014-07-02 17:57:39 +05:30
StressRatio_p = ( ( abs ( tau_slip ( j ) ) - plasticState ( ph ) % state ( 6 * ns + 4 * nt + j , of ) ) / &
2014-03-30 20:34:06 +05:30
( constitutive_dislotwin_SolidSolutionStrength ( instance ) + constitutive_dislotwin_tau_peierlsPerSlipFamily ( f , instance ) ) ) &
2014-03-12 05:25:40 +05:30
** constitutive_dislotwin_pPerSlipFamily ( f , instance )
2014-07-02 17:57:39 +05:30
StressRatio_pminus1 = ( ( abs ( tau_slip ( j ) ) - plasticState ( ph ) % state ( 6 * ns + 4 * nt + j , of ) ) / &
2014-03-30 20:34:06 +05:30
( constitutive_dislotwin_SolidSolutionStrength ( instance ) + constitutive_dislotwin_tau_peierlsPerSlipFamily ( f , instance ) ) ) &
2014-03-12 05:25:40 +05:30
** ( constitutive_dislotwin_pPerSlipFamily ( f , instance ) - 1.0_pReal )
2013-12-12 05:12:33 +05:30
!* Boltzmann ratio
2014-03-30 20:34:06 +05:30
BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem ( j , instance ) / ( kB * Temperature )
2013-12-12 05:12:33 +05:30
!* Initial shear rates
2014-03-30 20:34:06 +05:30
DotGamma0 = &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( j , of ) * constitutive_dislotwin_burgersPerSlipSystem ( j , instance ) * &
2014-03-30 20:34:06 +05:30
constitutive_dislotwin_v0PerSlipSystem ( j , instance )
!* Shear rates due to slip
gdot_slip ( j ) = ( 1.0_pReal - sumf ) * DotGamma0 &
* exp ( - BoltzmannRatio * ( 1 - StressRatio_p ) ** constitutive_dislotwin_qPerSlipFamily ( f , instance ) ) &
* sign ( 1.0_pReal , tau_slip ( j ) )
!* Derivatives of shear rates
dgdot_dtauslip ( j ) = &
abs ( gdot_slip ( j ) ) * BoltzmannRatio * constitutive_dislotwin_pPerSlipFamily ( f , instance ) &
* constitutive_dislotwin_qPerSlipFamily ( f , instance ) / &
( constitutive_dislotwin_SolidSolutionStrength ( instance ) + constitutive_dislotwin_tau_peierlsPerSlipFamily ( f , instance ) ) * &
StressRatio_pminus1 * ( 1 - StressRatio_p ) ** ( constitutive_dislotwin_qPerSlipFamily ( f , instance ) - 1.0_pReal )
endif
2013-12-12 05:12:33 +05:30
!* Plastic velocity gradient for dislocation glide
2014-07-02 17:57:39 +05:30
Lp = Lp + gdot_slip ( j ) * lattice_Sslip ( : , : , 1 , index_myFamily + i , ph )
2013-12-12 05:12:33 +05:30
!* Calculation of the tangent of Lp
forall ( k = 1_pInt : 3_pInt , l = 1_pInt : 3_pInt , m = 1_pInt : 3_pInt , n = 1_pInt : 3_pInt ) &
dLp_dTstar3333 ( k , l , m , n ) = &
dLp_dTstar3333 ( k , l , m , n ) + dgdot_dtauslip ( j ) * &
2014-07-02 17:57:39 +05:30
lattice_Sslip ( k , l , 1 , index_myFamily + i , ph ) * &
lattice_Sslip ( m , n , 1 , index_myFamily + i , ph )
2013-12-12 05:12:33 +05:30
enddo slipSystemsLoop
enddo slipFamiliesLoop
2013-10-08 21:57:26 +05:30
!* Shear banding (shearband) part
2014-02-28 15:48:40 +05:30
if ( constitutive_dislotwin_sbVelocity ( instance ) / = 0.0_pReal . and . &
constitutive_dislotwin_sbResistance ( instance ) / = 0.0_pReal ) then
2013-10-14 16:24:45 +05:30
gdot_sb = 0.0_pReal
dgdot_dtausb = 0.0_pReal
call math_spectralDecompositionSym33 ( math_Mandel6to33 ( Tstar_v ) , eigValues , eigVectors , error )
do j = 1_pInt , 6_pInt
sb_s = 0.5_pReal * sqrt ( 2.0_pReal ) * math_mul33x3 ( eigVectors , sb_sComposition ( 1 : 3 , j ) )
sb_m = 0.5_pReal * sqrt ( 2.0_pReal ) * math_mul33x3 ( eigVectors , sb_mComposition ( 1 : 3 , j ) )
sb_Smatrix = math_tensorproduct ( sb_s , sb_m )
2013-10-08 21:57:26 +05:30
constitutive_dislotwin_sbSv ( 1 : 6 , j , ipc , ip , el ) = math_Mandel33to6 ( math_symmetric33 ( sb_Smatrix ) )
2013-10-14 16:24:45 +05:30
!* Calculation of Lp
!* Resolved shear stress on shear banding system
2013-10-08 21:57:26 +05:30
tau_sb ( j ) = dot_product ( Tstar_v , constitutive_dislotwin_sbSv ( 1 : 6 , j , ipc , ip , el ) )
2013-10-14 16:24:45 +05:30
!* Stress ratios
2014-03-12 05:25:40 +05:30
if ( abs ( tau_sb ( j ) ) < tol_math_check ) then
StressRatio_p = 0.0_pReal
StressRatio_pminus1 = 0.0_pReal
else
StressRatio_p = ( abs ( tau_sb ( j ) ) / constitutive_dislotwin_sbResistance ( instance ) ) &
** constitutive_dislotwin_pShearBand ( instance )
StressRatio_pminus1 = ( abs ( tau_sb ( j ) ) / constitutive_dislotwin_sbResistance ( instance ) ) &
** ( constitutive_dislotwin_pShearBand ( instance ) - 1.0_pReal )
endif
2013-10-14 16:24:45 +05:30
!* Boltzmann ratio
2014-02-28 15:48:40 +05:30
BoltzmannRatio = constitutive_dislotwin_sbQedge ( instance ) / ( kB * Temperature )
2013-10-14 16:24:45 +05:30
!* Initial shear rates
2014-02-28 15:48:40 +05:30
DotGamma0 = constitutive_dislotwin_sbVelocity ( instance )
2013-10-08 21:57:26 +05:30
2013-10-14 16:24:45 +05:30
!* Shear rates due to shearband
2014-03-12 05:25:40 +05:30
gdot_sb ( j ) = DotGamma0 * exp ( - BoltzmannRatio * ( 1_pInt - StressRatio_p ) ** &
constitutive_dislotwin_qShearBand ( instance ) ) * sign ( 1.0_pReal , tau_sb ( j ) )
2013-10-14 16:24:45 +05:30
!* Derivatives of shear rates
dgdot_dtausb ( j ) = &
( ( abs ( gdot_sb ( j ) ) * BoltzmannRatio * &
2014-03-12 05:25:40 +05:30
constitutive_dislotwin_pShearBand ( instance ) * constitutive_dislotwin_qShearBand ( instance ) ) / &
constitutive_dislotwin_sbResistance ( instance ) ) * &
StressRatio_pminus1 * ( 1_pInt - StressRatio_p ) ** ( constitutive_dislotwin_qShearBand ( instance ) - 1.0_pReal )
2013-10-08 21:57:26 +05:30
2013-10-14 16:24:45 +05:30
!* Plastic velocity gradient for shear banding
Lp = Lp + gdot_sb ( j ) * sb_Smatrix
2013-10-08 21:57:26 +05:30
2013-10-14 16:24:45 +05:30
!* Calculation of the tangent of Lp
forall ( k = 1_pInt : 3_pInt , l = 1_pInt : 3_pInt , m = 1_pInt : 3_pInt , n = 1_pInt : 3_pInt ) &
dLp_dTstar3333 ( k , l , m , n ) = &
dLp_dTstar3333 ( k , l , m , n ) + dgdot_dtausb ( j ) * &
sb_Smatrix ( k , l ) * &
sb_Smatrix ( m , n )
enddo
2013-10-08 21:57:26 +05:30
end if
2012-05-16 20:13:26 +05:30
2013-10-08 21:57:26 +05:30
!* Mechanical twinning part
gdot_twin = 0.0_pReal
dgdot_dtautwin = 0.0_pReal
j = 0_pInt
2013-12-12 05:12:33 +05:30
twinFamiliesLoop : do f = 1_pInt , lattice_maxNtwinFamily
2014-07-02 17:57:39 +05:30
index_myFamily = sum ( lattice_NtwinSystem ( 1 : f - 1_pInt , ph ) ) ! at which index starts my family
2014-02-28 15:48:40 +05:30
twinSystemsLoop : do i = 1_pInt , constitutive_dislotwin_Ntwin ( f , instance )
2013-12-12 05:12:33 +05:30
j = j + 1_pInt
!* Calculation of Lp
!* Resolved shear stress on twin system
2014-03-12 05:25:40 +05:30
2014-07-02 17:57:39 +05:30
tau_twin ( j ) = dot_product ( Tstar_v , lattice_Stwin_v ( : , index_myFamily + i , ph ) )
2014-03-12 05:25:40 +05:30
2013-12-12 05:12:33 +05:30
!* Stress ratios
2014-03-12 05:25:40 +05:30
if ( tau_twin ( j ) > tol_math_check ) then
2014-07-02 17:57:39 +05:30
StressRatio_r = ( plasticState ( ph ) % state ( 7 * ns + 4 * nt + j , of ) / tau_twin ( j ) ) ** constitutive_dislotwin_rPerTwinFamily ( f , instance )
2013-12-12 05:12:33 +05:30
!* Shear rates and their derivatives due to twin
2014-07-02 17:57:39 +05:30
select case ( lattice_structure ( ph ) )
2013-12-12 05:12:33 +05:30
case ( LATTICE_fcc_ID )
2014-03-09 02:20:31 +05:30
s1 = lattice_fcc_twinNucleationSlipPair ( 1 , index_myFamily + i )
s2 = lattice_fcc_twinNucleationSlipPair ( 2 , index_myFamily + i )
2014-02-28 15:48:40 +05:30
if ( tau_twin ( j ) < constitutive_dislotwin_tau_r ( j , instance ) ) then
2014-07-02 17:57:39 +05:30
Ndot0 = ( abs ( gdot_slip ( s1 ) ) * ( plasticState ( ph ) % state ( s2 , of ) + plasticState ( ph ) % state ( ns + s2 , of ) ) + &
abs ( gdot_slip ( s2 ) ) * ( plasticState ( ph ) % state ( s1 , of ) + plasticState ( ph ) % state ( ns + s1 , of ) ) ) / &
2014-02-28 15:48:40 +05:30
( constitutive_dislotwin_L0 ( instance ) * constitutive_dislotwin_burgersPerSlipSystem ( j , instance ) ) * &
( 1.0_pReal - exp ( - constitutive_dislotwin_VcrossSlip ( instance ) / ( kB * Temperature ) * &
( constitutive_dislotwin_tau_r ( j , instance ) - tau_twin ( j ) ) ) )
2013-12-12 05:12:33 +05:30
else
Ndot0 = 0.0_pReal
end if
case default
2014-02-28 15:48:40 +05:30
Ndot0 = constitutive_dislotwin_Ndot0PerTwinSystem ( j , instance )
2013-12-12 05:12:33 +05:30
end select
gdot_twin ( j ) = &
2014-07-02 17:57:39 +05:30
( constitutive_dislotwin_MaxTwinFraction ( instance ) - sumf ) * lattice_shearTwin ( index_myFamily + i , ph ) * &
plasticState ( ph ) % state ( 7 * ns + 5 * nt + j , of ) * Ndot0 * exp ( - StressRatio_r )
2014-03-12 05:25:40 +05:30
dgdot_dtautwin ( j ) = ( ( gdot_twin ( j ) * constitutive_dislotwin_rPerTwinFamily ( f , instance ) ) / tau_twin ( j ) ) * StressRatio_r
2013-12-12 05:12:33 +05:30
endif
2013-10-08 21:57:26 +05:30
2013-12-12 05:12:33 +05:30
!* Plastic velocity gradient for mechanical twinning
2014-07-02 17:57:39 +05:30
Lp = Lp + gdot_twin ( j ) * lattice_Stwin ( : , : , index_myFamily + i , ph )
2013-10-08 21:57:26 +05:30
2013-12-12 05:12:33 +05:30
!* Calculation of the tangent of Lp
forall ( k = 1_pInt : 3_pInt , l = 1_pInt : 3_pInt , m = 1_pInt : 3_pInt , n = 1_pInt : 3_pInt ) &
dLp_dTstar3333 ( k , l , m , n ) = &
dLp_dTstar3333 ( k , l , m , n ) + dgdot_dtautwin ( j ) * &
2014-07-02 17:57:39 +05:30
lattice_Stwin ( k , l , index_myFamily + i , ph ) * &
lattice_Stwin ( m , n , index_myFamily + i , ph )
2013-12-12 05:12:33 +05:30
enddo twinSystemsLoop
enddo twinFamiliesLoop
2013-10-08 21:57:26 +05:30
dLp_dTstar = math_Plain3333to99 ( dLp_dTstar3333 )
end subroutine constitutive_dislotwin_LpAndItsTangent
2011-04-13 17:21:46 +05:30
2013-10-08 21:57:26 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief calculates the rate of change of microstructure
!--------------------------------------------------------------------------------------------------
2014-07-02 17:57:39 +05:30
subroutine constitutive_dislotwin_dotState ( Tstar_v , Temperature , ipc , ip , el )
2013-11-27 21:50:27 +05:30
use prec , only : &
2014-03-12 05:25:40 +05:30
p_vec , &
tol_math_check
2013-11-27 21:50:27 +05:30
use math , only : &
pi
use mesh , only : &
mesh_NcpElems , &
mesh_maxNips
use material , only : &
homogenization_maxNgrains , &
material_phase , &
2014-07-02 17:57:39 +05:30
phase_plasticityInstance , &
plasticState , &
mappingConstitutive
2013-11-27 21:50:27 +05:30
use lattice , only : &
lattice_Sslip_v , &
lattice_Stwin_v , &
lattice_maxNslipFamily , &
lattice_maxNtwinFamily , &
lattice_NslipSystem , &
lattice_NtwinSystem , &
lattice_sheartwin , &
2014-03-09 02:20:31 +05:30
lattice_mu , &
lattice_structure , &
lattice_fcc_twinNucleationSlipPair , &
2014-03-12 05:25:40 +05:30
LATTICE_fcc_ID , &
LATTICE_bcc_ID
2011-04-13 17:21:46 +05:30
2013-10-08 21:57:26 +05:30
implicit none
2014-03-13 12:13:49 +05:30
real ( pReal ) , dimension ( 6 ) , intent ( in ) :: &
2013-10-08 21:57:26 +05:30
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
2014-03-13 12:13:49 +05:30
real ( pReal ) , intent ( in ) :: &
2013-10-08 21:57:26 +05:30
temperature !< temperature at integration point
2014-03-13 12:13:49 +05:30
integer ( pInt ) , intent ( in ) :: &
2013-10-08 21:57:26 +05:30
ipc , & !< component-ID of integration point
ip , & !< integration point
el !< element
2014-07-02 17:57:39 +05:30
integer ( pInt ) :: instance , ns , nt , f , i , j , index_myFamily , s1 , s2 , &
ph , &
of
2014-03-09 02:20:31 +05:30
real ( pReal ) :: sumf , StressRatio_p , StressRatio_pminus1 , BoltzmannRatio , DotGamma0 , &
2013-10-14 16:24:45 +05:30
EdgeDipMinDistance , AtomicVolume , VacancyDiffusion , StressRatio_r , Ndot0
2013-10-08 21:57:26 +05:30
real ( pReal ) , dimension ( constitutive_dislotwin_totalNslip ( phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) ) ) :: &
gdot_slip , tau_slip , DotRhoMultiplication , EdgeDipDistance , DotRhoEdgeEdgeAnnihilation , DotRhoEdgeDipAnnihilation , &
ClimbVelocity , DotRhoEdgeDipClimb , DotRhoDipFormation
real ( pReal ) , dimension ( constitutive_dislotwin_totalNtwin ( phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) ) ) :: &
2013-10-14 16:24:45 +05:30
tau_twin
2013-10-08 21:57:26 +05:30
!* Shortened notation
2014-07-02 17:57:39 +05:30
of = mappingConstitutive ( 1 , ipc , ip , el )
ph = mappingConstitutive ( 2 , ipc , ip , el )
instance = phase_plasticityInstance ( ph )
2014-02-28 15:48:40 +05:30
ns = constitutive_dislotwin_totalNslip ( instance )
nt = constitutive_dislotwin_totalNtwin ( instance )
2014-07-02 17:57:39 +05:30
! allocate(constitutive_dislotwin_dotState(plasticState(ph)%sizeDotState))
2013-10-08 21:57:26 +05:30
!* Total twin volume fraction
2014-07-02 17:57:39 +05:30
sumf = sum ( plasticState ( ph ) % state ( ( 3_pInt * ns + 1_pInt ) : ( 3_pInt * ns + nt ) , of ) ) ! safe for nt == 0
plasticState ( ph ) % dotState ( : , of ) = 0.0_pReal
2013-10-08 21:57:26 +05:30
!* Dislocation density evolution
gdot_slip = 0.0_pReal
j = 0_pInt
do f = 1_pInt , lattice_maxNslipFamily ! loop over all slip families
2014-07-02 17:57:39 +05:30
index_myFamily = sum ( lattice_NslipSystem ( 1 : f - 1_pInt , ph ) ) ! at which index starts my family
2014-03-09 02:20:31 +05:30
do i = 1_pInt , constitutive_dislotwin_Nslip ( f , instance ) ! process each (active) slip system in family
j = j + 1_pInt
2013-10-08 21:57:26 +05:30
2014-03-09 02:20:31 +05:30
!* Resolved shear stress on slip system
2014-07-02 17:57:39 +05:30
tau_slip ( j ) = dot_product ( Tstar_v , lattice_Sslip_v ( : , 1 , index_myFamily + i , ph ) )
2014-03-12 05:25:40 +05:30
2014-07-02 17:57:39 +05:30
if ( ( abs ( tau_slip ( j ) ) - plasticState ( ph ) % state ( 6 * ns + 4 * nt + j , of ) ) > tol_math_check ) then
2014-03-30 20:34:06 +05:30
!* Stress ratios
2014-07-02 17:57:39 +05:30
StressRatio_p = ( ( abs ( tau_slip ( j ) ) - plasticState ( ph ) % state ( 6 * ns + 4 * nt + j , of ) ) / &
2014-03-30 20:34:06 +05:30
( constitutive_dislotwin_SolidSolutionStrength ( instance ) + constitutive_dislotwin_tau_peierlsPerSlipFamily ( f , instance ) ) ) &
** constitutive_dislotwin_pPerSlipFamily ( f , instance )
2014-07-02 17:57:39 +05:30
StressRatio_pminus1 = ( ( abs ( tau_slip ( j ) ) - plasticState ( ph ) % state ( 6 * ns + 4 * nt + j , of ) ) / &
2014-03-30 20:34:06 +05:30
( constitutive_dislotwin_SolidSolutionStrength ( instance ) + constitutive_dislotwin_tau_peierlsPerSlipFamily ( f , instance ) ) ) &
** ( constitutive_dislotwin_pPerSlipFamily ( f , instance ) - 1.0_pReal )
2014-03-09 02:20:31 +05:30
!* Boltzmann ratio
2014-03-30 20:34:06 +05:30
BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem ( j , instance ) / ( kB * Temperature )
2014-03-09 02:20:31 +05:30
!* Initial shear rates
2014-03-30 20:34:06 +05:30
DotGamma0 = &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( j , of ) * constitutive_dislotwin_burgersPerSlipSystem ( j , instance ) * &
2014-03-30 20:34:06 +05:30
constitutive_dislotwin_v0PerSlipSystem ( j , instance )
2013-10-08 21:57:26 +05:30
2014-03-09 02:20:31 +05:30
!* Shear rates due to slip
2014-03-30 20:34:06 +05:30
gdot_slip ( j ) = DotGamma0 * exp ( - BoltzmannRatio * ( 1_pInt - StressRatio_p ) ** &
2014-03-12 05:25:40 +05:30
constitutive_dislotwin_qPerSlipFamily ( f , instance ) ) * sign ( 1.0_pReal , tau_slip ( j ) )
2014-03-30 20:34:06 +05:30
endif
2014-03-09 02:20:31 +05:30
!* Multiplication
DotRhoMultiplication ( j ) = abs ( gdot_slip ( j ) ) / &
2014-07-02 17:57:39 +05:30
( constitutive_dislotwin_burgersPerSlipSystem ( j , instance ) * &
plasticState ( ph ) % state ( 5 * ns + 3 * nt + j , of ) )
2014-03-09 02:20:31 +05:30
!* Dipole formation
EdgeDipMinDistance = &
constitutive_dislotwin_CEdgeDipMinDistance ( instance ) * constitutive_dislotwin_burgersPerSlipSystem ( j , instance )
if ( tau_slip ( j ) == 0.0_pReal ) then
DotRhoDipFormation ( j ) = 0.0_pReal
else
EdgeDipDistance ( j ) = &
2014-07-02 17:57:39 +05:30
( 3.0_pReal * lattice_mu ( ph ) * constitutive_dislotwin_burgersPerSlipSystem ( j , instance ) ) / &
2014-03-09 02:20:31 +05:30
( 1 6.0_pReal * pi * abs ( tau_slip ( j ) ) )
2014-07-02 17:57:39 +05:30
if ( EdgeDipDistance ( j ) > plasticState ( ph ) % state ( 5 * ns + 3 * nt + j , of ) ) EdgeDipDistance ( j ) = plasticState ( ph ) % state ( 5 * ns + 3 * nt + j , of )
2014-03-17 21:12:46 +05:30
if ( EdgeDipDistance ( j ) < EdgeDipMinDistance ) EdgeDipDistance ( j ) = EdgeDipMinDistance
2014-03-09 02:20:31 +05:30
DotRhoDipFormation ( j ) = &
( ( 2.0_pReal * EdgeDipDistance ( j ) ) / constitutive_dislotwin_burgersPerSlipSystem ( j , instance ) ) * &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( j , of ) * abs ( gdot_slip ( j ) ) * constitutive_dislotwin_dipoleFormationFactor ( instance )
2014-03-09 02:20:31 +05:30
endif
2013-10-08 21:57:26 +05:30
2014-03-09 02:20:31 +05:30
!* Spontaneous annihilation of 2 single edge dislocations
DotRhoEdgeEdgeAnnihilation ( j ) = &
( ( 2.0_pReal * EdgeDipMinDistance ) / constitutive_dislotwin_burgersPerSlipSystem ( j , instance ) ) * &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( j , of ) * abs ( gdot_slip ( j ) )
2014-03-09 02:20:31 +05:30
!* Spontaneous annihilation of a single edge dislocation with a dipole constituent
DotRhoEdgeDipAnnihilation ( j ) = &
( ( 2.0_pReal * EdgeDipMinDistance ) / constitutive_dislotwin_burgersPerSlipSystem ( j , instance ) ) * &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( ns + j , of ) * abs ( gdot_slip ( j ) )
2014-03-09 02:20:31 +05:30
!* Dislocation dipole climb
AtomicVolume = &
constitutive_dislotwin_CAtomicVolume ( instance ) * constitutive_dislotwin_burgersPerSlipSystem ( j , instance ) ** ( 3.0_pReal )
VacancyDiffusion = &
constitutive_dislotwin_D0 ( instance ) * exp ( - constitutive_dislotwin_Qsd ( instance ) / ( kB * Temperature ) )
if ( tau_slip ( j ) == 0.0_pReal ) then
DotRhoEdgeDipClimb ( j ) = 0.0_pReal
else
ClimbVelocity ( j ) = &
2014-07-02 17:57:39 +05:30
( ( 3.0_pReal * lattice_mu ( ph ) * VacancyDiffusion * AtomicVolume ) / ( 2.0_pReal * pi * kB * Temperature ) ) * &
2014-03-09 02:20:31 +05:30
( 1 / ( EdgeDipDistance ( j ) + EdgeDipMinDistance ) )
DotRhoEdgeDipClimb ( j ) = &
2014-07-02 17:57:39 +05:30
( 4.0_pReal * ClimbVelocity ( j ) * plasticState ( ph ) % state ( ns + j , of ) ) / ( EdgeDipDistance ( j ) - EdgeDipMinDistance )
2014-03-09 02:20:31 +05:30
endif
!* Edge dislocation density rate of change
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % dotState ( j , of ) = &
2014-03-09 02:20:31 +05:30
DotRhoMultiplication ( j ) - DotRhoDipFormation ( j ) - DotRhoEdgeEdgeAnnihilation ( j )
2013-10-08 21:57:26 +05:30
2014-03-09 02:20:31 +05:30
!* Edge dislocation dipole density rate of change
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % dotState ( ns + j , of ) = &
2014-03-09 02:20:31 +05:30
DotRhoDipFormation ( j ) - DotRhoEdgeDipAnnihilation ( j ) - DotRhoEdgeDipClimb ( j )
2013-10-08 21:57:26 +05:30
2014-03-09 02:20:31 +05:30
!* Dotstate for accumulated shear due to slip
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % dotState ( 2_pInt * ns + j , of ) = gdot_slip ( j )
2013-10-08 21:57:26 +05:30
2014-03-09 02:20:31 +05:30
enddo
2013-10-08 21:57:26 +05:30
enddo
!* Twin volume fraction evolution
j = 0_pInt
do f = 1_pInt , lattice_maxNtwinFamily ! loop over all twin families
2014-07-02 17:57:39 +05:30
index_myFamily = sum ( lattice_NtwinSystem ( 1 : f - 1_pInt , ph ) ) ! at which index starts my family
2014-03-09 02:20:31 +05:30
do i = 1_pInt , constitutive_dislotwin_Ntwin ( f , instance ) ! process each (active) twin system in family
j = j + 1_pInt
2013-10-08 21:57:26 +05:30
2014-03-09 02:20:31 +05:30
!* Resolved shear stress on twin system
2014-07-02 17:57:39 +05:30
tau_twin ( j ) = dot_product ( Tstar_v , lattice_Stwin_v ( : , index_myFamily + i , ph ) )
2014-03-09 02:20:31 +05:30
!* Stress ratios
2014-03-12 05:25:40 +05:30
if ( tau_twin ( j ) > tol_math_check ) then
2014-07-02 17:57:39 +05:30
StressRatio_r = ( plasticState ( ph ) % state ( 7 * ns + 4 * nt + j , of ) / tau_twin ( j ) ) ** constitutive_dislotwin_rPerTwinFamily ( f , instance )
2014-03-09 02:20:31 +05:30
!* Shear rates and their derivatives due to twin
2014-03-12 05:25:40 +05:30
2014-07-02 17:57:39 +05:30
select case ( lattice_structure ( ph ) )
2014-03-09 02:20:31 +05:30
case ( LATTICE_fcc_ID )
s1 = lattice_fcc_twinNucleationSlipPair ( 1 , index_myFamily + i )
s2 = lattice_fcc_twinNucleationSlipPair ( 2 , index_myFamily + i )
if ( tau_twin ( j ) < constitutive_dislotwin_tau_r ( j , instance ) ) then
2014-07-02 17:57:39 +05:30
Ndot0 = ( abs ( gdot_slip ( s1 ) ) * ( plasticState ( ph ) % state ( s2 , of ) + plasticState ( ph ) % state ( ns + s2 , of ) ) + &
abs ( gdot_slip ( s2 ) ) * ( plasticState ( ph ) % state ( s1 , of ) + plasticState ( ph ) % state ( ns + s1 , of ) ) ) / &
2014-03-09 02:20:31 +05:30
( constitutive_dislotwin_L0 ( instance ) * constitutive_dislotwin_burgersPerSlipSystem ( j , instance ) ) * &
( 1.0_pReal - exp ( - constitutive_dislotwin_VcrossSlip ( instance ) / ( kB * Temperature ) * &
( constitutive_dislotwin_tau_r ( j , instance ) - tau_twin ( j ) ) ) )
else
Ndot0 = 0.0_pReal
end if
case default
Ndot0 = constitutive_dislotwin_Ndot0PerTwinSystem ( j , instance )
end select
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % dotState ( 3_pInt * ns + j , of ) = &
2014-03-09 02:20:31 +05:30
( constitutive_dislotwin_MaxTwinFraction ( instance ) - sumf ) * &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( 7_pInt * ns + 5_pInt * nt + j , of ) * Ndot0 * exp ( - StressRatio_r )
2014-03-09 02:20:31 +05:30
!* Dotstate for accumulated shear due to twin
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % dotState ( 3_pInt * ns + nt + j , of ) = plasticState ( ph ) % dotState ( 3_pInt * ns + j , of ) * &
lattice_sheartwin ( index_myfamily + i , ph )
2014-03-09 02:20:31 +05:30
endif
enddo
2013-10-08 21:57:26 +05:30
enddo
2014-06-11 17:41:14 +05:30
2014-07-02 17:57:39 +05:30
end subroutine constitutive_dislotwin_dotState
2011-04-13 17:21:46 +05:30
2013-10-08 21:57:26 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief return array of constitutive results
!--------------------------------------------------------------------------------------------------
2014-07-02 17:57:39 +05:30
function constitutive_dislotwin_postResults ( Tstar_v , Temperature , ipc , ip , el )
2013-10-08 21:57:26 +05:30
use prec , only : &
2014-03-12 05:25:40 +05:30
p_vec , &
tol_math_check
2013-10-08 21:57:26 +05:30
use math , only : &
pi , &
math_Mandel6to33 , &
math_spectralDecompositionSym33
use mesh , only : &
mesh_NcpElems , &
mesh_maxNips
use material , only : &
homogenization_maxNgrains , &
material_phase , &
phase_plasticityInstance , &
2014-07-02 17:57:39 +05:30
phase_Noutput , &
plasticState , &
mappingConstitutive
2013-10-08 21:57:26 +05:30
use lattice , only : &
lattice_Sslip_v , &
lattice_Stwin_v , &
lattice_maxNslipFamily , &
lattice_maxNtwinFamily , &
lattice_NslipSystem , &
lattice_NtwinSystem , &
lattice_shearTwin , &
2014-03-09 02:20:31 +05:30
lattice_mu , &
lattice_structure , &
lattice_fcc_twinNucleationSlipPair , &
2013-11-27 21:50:27 +05:30
LATTICE_fcc_ID
2011-04-13 17:21:46 +05:30
2013-10-08 21:57:26 +05:30
implicit none
2014-03-13 12:13:49 +05:30
real ( pReal ) , dimension ( 6 ) , intent ( in ) :: &
2013-10-08 21:57:26 +05:30
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
2014-03-13 12:13:49 +05:30
real ( pReal ) , intent ( in ) :: &
2013-10-16 18:34:59 +05:30
temperature !< temperature at integration point
2014-03-13 12:13:49 +05:30
integer ( pInt ) , intent ( in ) :: &
2013-10-08 21:57:26 +05:30
ipc , & !< component-ID of integration point
ip , & !< integration point
el !< element
2014-07-02 17:57:39 +05:30
2013-10-08 21:57:26 +05:30
real ( pReal ) , dimension ( constitutive_dislotwin_sizePostResults ( phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) ) ) :: &
constitutive_dislotwin_postResults
integer ( pInt ) :: &
2014-03-09 02:20:31 +05:30
instance , phase , &
2013-10-08 21:57:26 +05:30
ns , nt , &
f , o , i , c , j , index_myFamily , &
2014-07-02 17:57:39 +05:30
s1 , s2 , &
ph , &
of
2013-10-08 21:57:26 +05:30
real ( pReal ) :: sumf , tau , StressRatio_p , StressRatio_pminus1 , BoltzmannRatio , DotGamma0 , StressRatio_r , Ndot0 , dgdot_dtauslip
real ( preal ) , dimension ( constitutive_dislotwin_totalNslip ( phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) ) ) :: &
gdot_slip
real ( pReal ) , dimension ( 3 , 3 ) :: eigVectors
real ( pReal ) , dimension ( 3 ) :: eigValues
logical :: error
2014-07-02 17:57:39 +05:30
2013-10-08 21:57:26 +05:30
!* Shortened notation
2014-07-02 17:57:39 +05:30
of = mappingConstitutive ( 1 , ipc , ip , el )
ph = mappingConstitutive ( 2 , ipc , ip , el )
instance = phase_plasticityInstance ( ph )
2014-02-28 15:48:40 +05:30
ns = constitutive_dislotwin_totalNslip ( instance )
nt = constitutive_dislotwin_totalNtwin ( instance )
2014-06-11 17:41:14 +05:30
2013-10-08 21:57:26 +05:30
!* Total twin volume fraction
2014-07-02 17:57:39 +05:30
sumf = sum ( plasticState ( ph ) % state ( ( 3_pInt * ns + 1_pInt ) : ( 3_pInt * ns + nt ) , of ) ) ! safe for nt == 0
2013-10-08 21:57:26 +05:30
!* Required output
c = 0_pInt
constitutive_dislotwin_postResults = 0.0_pReal
!* Spectral decomposition of stress
call math_spectralDecompositionSym33 ( math_Mandel6to33 ( Tstar_v ) , eigValues , eigVectors , error )
2014-06-25 04:23:25 +05:30
do o = 1_pInt , constitutive_dislotwin_Noutput ( instance )
2014-02-28 15:48:40 +05:30
select case ( constitutive_dislotwin_outputID ( o , instance ) )
2013-10-08 21:57:26 +05:30
2013-12-12 05:12:33 +05:30
case ( edge_density_ID )
2014-07-02 17:57:39 +05:30
constitutive_dislotwin_postResults ( c + 1_pInt : c + ns ) = plasticState ( ph ) % state ( 1_pInt : ns , of )
2013-10-14 16:24:45 +05:30
c = c + ns
2013-12-12 05:12:33 +05:30
case ( dipole_density_ID )
2014-07-02 17:57:39 +05:30
constitutive_dislotwin_postResults ( c + 1_pInt : c + ns ) = plasticState ( ph ) % state ( ns + 1_pInt : 2_pInt * ns , of )
2013-10-14 16:24:45 +05:30
c = c + ns
2013-12-12 05:12:33 +05:30
case ( shear_rate_slip_ID )
2013-10-14 16:24:45 +05:30
j = 0_pInt
2014-07-02 17:57:39 +05:30
do f = 1_pInt , lattice_maxNslipFamily ! loop over all slip families
index_myFamily = sum ( lattice_NslipSystem ( 1 : f - 1_pInt , ph ) ) ! at which index starts my family
do i = 1_pInt , constitutive_dislotwin_Nslip ( f , instance ) ! process each (active) slip system in family
2013-10-14 16:24:45 +05:30
j = j + 1_pInt
2013-10-08 21:57:26 +05:30
2013-10-14 16:24:45 +05:30
!* Resolved shear stress on slip system
2014-07-02 17:57:39 +05:30
tau = dot_product ( Tstar_v , lattice_Sslip_v ( : , 1 , index_myFamily + i , ph ) )
2013-10-14 16:24:45 +05:30
!* Stress ratios
2014-07-02 17:57:39 +05:30
if ( ( abs ( tau ) - plasticState ( ph ) % state ( 6 * ns + 4 * nt + j , of ) ) > tol_math_check ) then
2014-03-30 20:34:06 +05:30
!* Stress ratios
2014-07-02 17:57:39 +05:30
StressRatio_p = ( ( abs ( tau ) - plasticState ( ph ) % state ( 6 * ns + 4 * nt + j , of ) ) / &
2014-03-30 20:34:06 +05:30
( constitutive_dislotwin_SolidSolutionStrength ( instance ) + &
constitutive_dislotwin_tau_peierlsPerSlipFamily ( f , instance ) ) ) &
** constitutive_dislotwin_pPerSlipFamily ( f , instance )
2014-07-02 17:57:39 +05:30
StressRatio_pminus1 = ( ( abs ( tau ) - plasticState ( ph ) % state ( 6 * ns + 4 * nt + j , of ) ) / &
2014-03-30 20:34:06 +05:30
( constitutive_dislotwin_SolidSolutionStrength ( instance ) + &
constitutive_dislotwin_tau_peierlsPerSlipFamily ( f , instance ) ) ) &
** ( constitutive_dislotwin_pPerSlipFamily ( f , instance ) - 1.0_pReal )
2013-10-14 16:24:45 +05:30
!* Boltzmann ratio
2014-03-30 20:34:06 +05:30
BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem ( j , instance ) / ( kB * Temperature )
2013-10-14 16:24:45 +05:30
!* Initial shear rates
2014-03-30 20:34:06 +05:30
DotGamma0 = &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( j , of ) * constitutive_dislotwin_burgersPerSlipSystem ( j , instance ) * &
2014-03-30 20:34:06 +05:30
constitutive_dislotwin_v0PerSlipSystem ( j , instance )
2013-10-08 21:57:26 +05:30
2013-10-14 16:24:45 +05:30
!* Shear rates due to slip
2014-03-30 20:34:06 +05:30
constitutive_dislotwin_postResults ( c + j ) = &
DotGamma0 * exp ( - BoltzmannRatio * ( 1_pInt - StressRatio_p ) ** &
2014-03-12 05:25:40 +05:30
constitutive_dislotwin_qPerSlipFamily ( f , instance ) ) * sign ( 1.0_pReal , tau )
2014-03-30 20:34:06 +05:30
else
constitutive_dislotwin_postResults ( c + j ) = 0.0_pReal
endif
2013-10-14 16:24:45 +05:30
enddo ; enddo
c = c + ns
2013-12-12 05:12:33 +05:30
case ( accumulated_shear_slip_ID )
2013-10-14 16:24:45 +05:30
constitutive_dislotwin_postResults ( c + 1_pInt : c + ns ) = &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( ( 2_pInt * ns + 1_pInt ) : ( 3_pInt * ns ) , of )
2013-10-14 16:24:45 +05:30
c = c + ns
2013-12-12 05:12:33 +05:30
case ( mfp_slip_ID )
2013-10-14 16:24:45 +05:30
constitutive_dislotwin_postResults ( c + 1_pInt : c + ns ) = &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( ( 5_pInt * ns + 3_pInt * nt + 1_pInt ) : ( 6_pInt * ns + 3_pInt * nt ) , of )
2013-10-14 16:24:45 +05:30
c = c + ns
2013-12-12 05:12:33 +05:30
case ( resolved_stress_slip_ID )
2013-10-14 16:24:45 +05:30
j = 0_pInt
2014-07-02 17:57:39 +05:30
do f = 1_pInt , lattice_maxNslipFamily ! loop over all slip families
index_myFamily = sum ( lattice_NslipSystem ( 1 : f - 1_pInt , ph ) ) ! at which index starts my family
do i = 1_pInt , constitutive_dislotwin_Nslip ( f , instance ) ! process each (active) slip system in family
2013-10-14 16:24:45 +05:30
j = j + 1_pInt
constitutive_dislotwin_postResults ( c + j ) = &
2014-07-02 17:57:39 +05:30
dot_product ( Tstar_v , lattice_Sslip_v ( : , 1 , index_myFamily + i , ph ) )
2013-10-14 16:24:45 +05:30
enddo ; enddo
c = c + ns
2013-12-12 05:12:33 +05:30
case ( threshold_stress_slip_ID )
2013-10-14 16:24:45 +05:30
constitutive_dislotwin_postResults ( c + 1_pInt : c + ns ) = &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( ( 6_pInt * ns + 4_pInt * nt + 1_pInt ) : ( 7_pInt * ns + 4_pInt * nt ) , of )
2013-10-14 16:24:45 +05:30
c = c + ns
2013-12-12 05:12:33 +05:30
case ( edge_dipole_distance_ID )
2013-10-14 16:24:45 +05:30
j = 0_pInt
2014-07-02 17:57:39 +05:30
do f = 1_pInt , lattice_maxNslipFamily ! loop over all slip families
index_myFamily = sum ( lattice_NslipSystem ( 1 : f - 1_pInt , ph ) ) ! at which index starts my family
do i = 1_pInt , constitutive_dislotwin_Nslip ( f , instance ) ! process each (active) slip system in family
2013-10-14 16:24:45 +05:30
j = j + 1_pInt
constitutive_dislotwin_postResults ( c + j ) = &
2014-07-02 17:57:39 +05:30
( 3.0_pReal * lattice_mu ( ph ) * constitutive_dislotwin_burgersPerSlipSystem ( j , instance ) ) / &
( 1 6.0_pReal * pi * abs ( dot_product ( Tstar_v , lattice_Sslip_v ( : , 1 , index_myFamily + i , ph ) ) ) )
constitutive_dislotwin_postResults ( c + j ) = min ( constitutive_dislotwin_postResults ( c + j ) , &
plasticState ( ph ) % state ( 5 * ns + 3 * nt + j , of ) )
! constitutive_dislotwin_postResults(c+j)=max(constitutive_dislotwin_postResults(c+j),&
! plasticState(ph)%state(4*ns+2*nt+j, of))
2013-10-14 16:24:45 +05:30
enddo ; enddo
c = c + ns
2013-12-12 05:12:33 +05:30
case ( resolved_stress_shearband_ID )
2014-07-02 17:57:39 +05:30
do j = 1_pInt , 6_pInt ! loop over all shearband families
constitutive_dislotwin_postResults ( c + j ) = dot_product ( Tstar_v , &
constitutive_dislotwin_sbSv ( 1 : 6 , j , ipc , ip , el ) )
2013-10-14 16:24:45 +05:30
enddo
c = c + 6_pInt
2013-12-12 05:12:33 +05:30
case ( shear_rate_shearband_ID )
2014-07-02 17:57:39 +05:30
do j = 1_pInt , 6_pInt ! loop over all shearbands
2013-10-14 16:24:45 +05:30
!* Resolved shear stress on shearband system
2013-10-08 21:57:26 +05:30
tau = dot_product ( Tstar_v , constitutive_dislotwin_sbSv ( 1 : 6 , j , ipc , ip , el ) )
2013-10-14 16:24:45 +05:30
!* Stress ratios
2014-03-12 05:25:40 +05:30
if ( abs ( tau ) < tol_math_check ) then
StressRatio_p = 0.0_pReal
StressRatio_pminus1 = 0.0_pReal
else
StressRatio_p = ( abs ( tau ) / constitutive_dislotwin_sbResistance ( instance ) ) ** &
constitutive_dislotwin_pShearBand ( instance )
StressRatio_pminus1 = ( abs ( tau ) / constitutive_dislotwin_sbResistance ( instance ) ) ** &
( constitutive_dislotwin_pShearBand ( instance ) - 1.0_pReal )
endif
2013-10-14 16:24:45 +05:30
!* Boltzmann ratio
2014-02-28 15:48:40 +05:30
BoltzmannRatio = constitutive_dislotwin_sbQedge ( instance ) / ( kB * Temperature )
2013-10-14 16:24:45 +05:30
!* Initial shear rates
2014-02-28 15:48:40 +05:30
DotGamma0 = constitutive_dislotwin_sbVelocity ( instance )
2014-03-12 05:25:40 +05:30
! Shear rate due to shear band
2013-10-14 16:24:45 +05:30
constitutive_dislotwin_postResults ( c + j ) = &
2014-03-12 05:25:40 +05:30
DotGamma0 * exp ( - BoltzmannRatio * ( 1_pInt - StressRatio_p ) ** constitutive_dislotwin_qShearBand ( instance ) ) * &
sign ( 1.0_pReal , tau )
2013-10-14 16:24:45 +05:30
enddo
c = c + 6_pInt
2013-12-12 05:12:33 +05:30
case ( twin_fraction_ID )
2014-07-02 17:57:39 +05:30
constitutive_dislotwin_postResults ( c + 1_pInt : c + nt ) = plasticState ( ph ) % state ( ( 3_pInt * ns + 1_pInt ) : ( 3_pInt * ns + nt ) , of )
2013-10-14 16:24:45 +05:30
c = c + nt
2013-12-12 05:12:33 +05:30
case ( shear_rate_twin_ID )
2013-10-14 16:24:45 +05:30
if ( nt > 0_pInt ) then
j = 0_pInt
2014-07-02 17:57:39 +05:30
do f = 1_pInt , lattice_maxNslipFamily ! loop over all slip families
index_myFamily = sum ( lattice_NslipSystem ( 1 : f - 1_pInt , ph ) ) ! at which index starts my family
do i = 1_pInt , constitutive_dislotwin_Nslip ( f , instance ) ! process each (active) slip system in family
2013-10-14 16:24:45 +05:30
j = j + 1_pInt
2013-10-08 21:57:26 +05:30
2013-10-14 16:24:45 +05:30
!* Resolved shear stress on slip system
2014-07-02 17:57:39 +05:30
tau = dot_product ( Tstar_v , lattice_Sslip_v ( : , 1 , index_myFamily + i , ph ) )
2013-10-14 16:24:45 +05:30
!* Stress ratios
2014-07-02 17:57:39 +05:30
if ( ( abs ( tau ) - plasticState ( ph ) % state ( 6 * ns + 4 * nt + j , of ) ) > tol_math_check ) then
2014-03-30 20:34:06 +05:30
!* Stress ratios
2014-07-02 17:57:39 +05:30
StressRatio_p = ( ( abs ( tau ) - plasticState ( ph ) % state ( 6 * ns + 4 * nt + j , of ) ) / &
2014-03-30 20:34:06 +05:30
( constitutive_dislotwin_SolidSolutionStrength ( instance ) + &
constitutive_dislotwin_tau_peierlsPerSlipFamily ( f , instance ) ) ) &
** constitutive_dislotwin_pPerSlipFamily ( f , instance )
2014-07-02 17:57:39 +05:30
StressRatio_pminus1 = ( ( abs ( tau ) - plasticState ( ph ) % state ( 6 * ns + 4 * nt + j , of ) ) / &
2014-03-30 20:34:06 +05:30
( constitutive_dislotwin_SolidSolutionStrength ( instance ) + &
constitutive_dislotwin_tau_peierlsPerSlipFamily ( f , instance ) ) ) &
** ( constitutive_dislotwin_pPerSlipFamily ( f , instance ) - 1.0_pReal )
2013-10-14 16:24:45 +05:30
!* Boltzmann ratio
2014-03-30 20:34:06 +05:30
BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem ( j , instance ) / ( kB * Temperature )
2013-10-14 16:24:45 +05:30
!* Initial shear rates
2014-03-30 20:34:06 +05:30
DotGamma0 = &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( j , of ) * constitutive_dislotwin_burgersPerSlipSystem ( j , instance ) * &
2014-03-30 20:34:06 +05:30
constitutive_dislotwin_v0PerSlipSystem ( j , instance )
2013-10-08 21:57:26 +05:30
2013-10-14 16:24:45 +05:30
!* Shear rates due to slip
2014-03-30 20:34:06 +05:30
gdot_slip ( j ) = DotGamma0 * exp ( - BoltzmannRatio * ( 1_pInt - StressRatio_p ) ** &
constitutive_dislotwin_qPerSlipFamily ( f , instance ) ) * sign ( 1.0_pReal , tau )
else
gdot_slip ( j ) = 0.0_pReal
endif
2013-10-14 16:24:45 +05:30
enddo ; enddo
j = 0_pInt
2014-07-02 17:57:39 +05:30
do f = 1_pInt , lattice_maxNtwinFamily ! loop over all twin families
index_myFamily = sum ( lattice_NtwinSystem ( 1 : f - 1_pInt , ph ) ) ! at which index starts my family
do i = 1 , constitutive_dislotwin_Ntwin ( f , instance ) ! process each (active) twin system in family
2013-10-14 16:24:45 +05:30
j = j + 1_pInt
2013-10-08 21:57:26 +05:30
2013-10-14 16:24:45 +05:30
!* Resolved shear stress on twin system
2014-07-02 17:57:39 +05:30
tau = dot_product ( Tstar_v , lattice_Stwin_v ( : , index_myFamily + i , ph ) )
2013-10-14 16:24:45 +05:30
!* Stress ratios
2014-07-02 17:57:39 +05:30
StressRatio_r = ( plasticState ( ph ) % state ( 7_pInt * ns + 4_pInt * nt + j , of ) / &
tau ) ** constitutive_dislotwin_rPerTwinFamily ( f , instance )
2013-10-08 21:57:26 +05:30
2013-10-14 16:24:45 +05:30
!* Shear rates due to twin
if ( tau > 0.0_pReal ) then
2014-07-02 17:57:39 +05:30
select case ( lattice_structure ( ph ) )
2013-11-27 21:50:27 +05:30
case ( LATTICE_fcc_ID )
2014-03-09 02:20:31 +05:30
s1 = lattice_fcc_twinNucleationSlipPair ( 1 , index_myFamily + i )
s2 = lattice_fcc_twinNucleationSlipPair ( 2 , index_myFamily + i )
2014-02-28 15:48:40 +05:30
if ( tau < constitutive_dislotwin_tau_r ( j , instance ) ) then
2014-07-02 17:57:39 +05:30
Ndot0 = ( abs ( gdot_slip ( s1 ) ) * ( plasticState ( ph ) % state ( s2 , of ) + plasticState ( ph ) % state ( ns + s2 , of ) ) + &
abs ( gdot_slip ( s2 ) ) * ( plasticState ( ph ) % state ( s1 , of ) + plasticState ( ph ) % state ( ns + s1 , of ) ) ) / &
2014-02-28 15:48:40 +05:30
( constitutive_dislotwin_L0 ( instance ) * &
constitutive_dislotwin_burgersPerSlipSystem ( j , instance ) ) * &
( 1.0_pReal - exp ( - constitutive_dislotwin_VcrossSlip ( instance ) / ( kB * Temperature ) * &
( constitutive_dislotwin_tau_r ( j , instance ) - tau ) ) )
2013-10-14 16:24:45 +05:30
else
Ndot0 = 0.0_pReal
end if
case default
2014-02-28 15:48:40 +05:30
Ndot0 = constitutive_dislotwin_Ndot0PerTwinSystem ( j , instance )
2013-10-14 16:24:45 +05:30
end select
constitutive_dislotwin_postResults ( c + j ) = &
2014-07-02 17:57:39 +05:30
( constitutive_dislotwin_MaxTwinFraction ( instance ) - sumf ) * lattice_shearTwin ( index_myFamily + i , ph ) * &
plasticState ( ph ) % state ( 7_pInt * ns + 5_pInt * nt + j , of ) * Ndot0 * exp ( - StressRatio_r )
2013-10-14 16:24:45 +05:30
endif
2013-10-08 21:57:26 +05:30
2013-10-14 16:24:45 +05:30
enddo ; enddo
endif
c = c + nt
2013-12-12 05:12:33 +05:30
case ( accumulated_shear_twin_ID )
2014-07-02 17:57:39 +05:30
constitutive_dislotwin_postResults ( c + 1_pInt : c + nt ) = plasticState ( ph ) % &
state ( ( 3_pInt * ns + nt + 1_pInt ) : ( 3_pInt * ns + 2_pInt * nt ) , of )
2013-10-14 16:24:45 +05:30
c = c + nt
2013-12-12 05:12:33 +05:30
case ( mfp_twin_ID )
2014-07-02 17:57:39 +05:30
constitutive_dislotwin_postResults ( c + 1_pInt : c + nt ) = plasticState ( ph ) % &
state ( ( 6_pInt * ns + 3_pInt * nt + 1_pInt ) : ( 6_pInt * ns + 4_pInt * nt ) , of )
2013-10-14 16:24:45 +05:30
c = c + nt
2013-12-12 05:12:33 +05:30
case ( resolved_stress_twin_ID )
2013-10-14 16:24:45 +05:30
if ( nt > 0_pInt ) then
j = 0_pInt
2014-07-02 17:57:39 +05:30
do f = 1_pInt , lattice_maxNtwinFamily ! loop over all slip families
index_myFamily = sum ( lattice_NtwinSystem ( 1 : f - 1_pInt , ph ) ) ! at which index starts my family
do i = 1_pInt , constitutive_dislotwin_Ntwin ( f , instance ) ! process each (active) slip system in family
2013-10-14 16:24:45 +05:30
j = j + 1_pInt
2014-07-02 17:57:39 +05:30
constitutive_dislotwin_postResults ( c + j ) = dot_product ( Tstar_v , lattice_Stwin_v ( : , index_myFamily + i , ph ) )
2013-10-14 16:24:45 +05:30
enddo ; enddo
endif
c = c + nt
2013-12-12 05:12:33 +05:30
case ( threshold_stress_twin_ID )
2014-07-02 17:57:39 +05:30
constitutive_dislotwin_postResults ( c + 1_pInt : c + nt ) = plasticState ( ph ) % &
state ( ( 7_pInt * ns + 4_pInt * nt + 1_pInt ) : ( 7_pInt * ns + 5_pInt * nt ) , of )
2013-10-14 16:24:45 +05:30
c = c + nt
2013-12-12 05:12:33 +05:30
case ( stress_exponent_ID )
2013-10-14 16:24:45 +05:30
j = 0_pInt
2014-07-02 17:57:39 +05:30
do f = 1_pInt , lattice_maxNslipFamily ! loop over all slip families
index_myFamily = sum ( lattice_NslipSystem ( 1 : f - 1_pInt , ph ) ) ! at which index starts my family
do i = 1_pInt , constitutive_dislotwin_Nslip ( f , instance ) ! process each (active) slip system in family
2014-03-09 02:20:31 +05:30
j = j + 1_pInt
2014-03-12 05:25:40 +05:30
2014-03-09 02:20:31 +05:30
!* Resolved shear stress on slip system
2014-07-02 17:57:39 +05:30
tau = dot_product ( Tstar_v , lattice_Sslip_v ( : , 1 , index_myFamily + i , ph ) )
if ( ( abs ( tau ) - plasticState ( ph ) % state ( 6 * ns + 4 * nt + j , of ) ) > tol_math_check ) then
2014-03-30 20:34:06 +05:30
!* Stress ratios
2014-07-02 17:57:39 +05:30
StressRatio_p = ( ( abs ( tau ) - plasticState ( ph ) % state ( 6 * ns + 4 * nt + j , of ) ) / &
2014-03-30 20:34:06 +05:30
( constitutive_dislotwin_SolidSolutionStrength ( instance ) + &
constitutive_dislotwin_tau_peierlsPerSlipFamily ( f , instance ) ) ) &
** constitutive_dislotwin_pPerSlipFamily ( f , instance )
2014-07-02 17:57:39 +05:30
StressRatio_pminus1 = ( ( abs ( tau ) - plasticState ( ph ) % state ( 6 * ns + 4 * nt + j , of ) ) / &
2014-03-30 20:34:06 +05:30
( constitutive_dislotwin_SolidSolutionStrength ( instance ) + &
constitutive_dislotwin_tau_peierlsPerSlipFamily ( f , instance ) ) ) &
** ( constitutive_dislotwin_pPerSlipFamily ( f , instance ) - 1.0_pReal )
2014-03-09 02:20:31 +05:30
!* Boltzmann ratio
2014-03-30 20:34:06 +05:30
BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem ( j , instance ) / ( kB * Temperature )
2014-03-09 02:20:31 +05:30
!* Initial shear rates
2014-03-30 20:34:06 +05:30
DotGamma0 = &
2014-07-02 17:57:39 +05:30
plasticState ( ph ) % state ( j , of ) * constitutive_dislotwin_burgersPerSlipSystem ( j , instance ) * &
2014-03-30 20:34:06 +05:30
constitutive_dislotwin_v0PerSlipSystem ( j , instance )
2014-03-12 05:25:40 +05:30
2014-03-09 02:20:31 +05:30
!* Shear rates due to slip
2014-03-30 20:34:06 +05:30
gdot_slip ( j ) = DotGamma0 * exp ( - BoltzmannRatio * ( 1_pInt - StressRatio_p ) ** &
2014-03-12 05:25:40 +05:30
constitutive_dislotwin_qPerSlipFamily ( f , instance ) ) * sign ( 1.0_pReal , tau )
2014-03-09 02:20:31 +05:30
!* Derivatives of shear rates
2014-03-30 20:34:06 +05:30
dgdot_dtauslip = &
abs ( gdot_slip ( j ) ) * BoltzmannRatio * constitutive_dislotwin_pPerSlipFamily ( f , instance ) &
* constitutive_dislotwin_qPerSlipFamily ( f , instance ) / &
( constitutive_dislotwin_SolidSolutionStrength ( instance ) + &
constitutive_dislotwin_tau_peierlsPerSlipFamily ( f , instance ) ) * &
StressRatio_pminus1 * ( 1 - StressRatio_p ) ** ( constitutive_dislotwin_qPerSlipFamily ( f , instance ) - 1.0_pReal )
else
gdot_slip ( j ) = 0.0_pReal
dgdot_dtauslip = 0.0_pReal
endif
2014-03-12 05:25:40 +05:30
2014-03-09 02:20:31 +05:30
!* Stress exponent
if ( gdot_slip ( j ) == 0.0_pReal ) then
constitutive_dislotwin_postResults ( c + j ) = 0.0_pReal
else
constitutive_dislotwin_postResults ( c + j ) = ( tau / gdot_slip ( j ) ) * dgdot_dtauslip
endif
enddo ; enddo
c = c + ns
2013-12-12 05:12:33 +05:30
case ( sb_eigenvalues_ID )
2013-10-14 16:24:45 +05:30
forall ( j = 1_pInt : 3_pInt ) &
constitutive_dislotwin_postResults ( c + j ) = eigValues ( j )
c = c + 3_pInt
2013-12-12 05:12:33 +05:30
case ( sb_eigenvectors_ID )
2013-11-27 13:34:05 +05:30
constitutive_dislotwin_postResults ( c + 1_pInt : c + 9_pInt ) = reshape ( eigVectors , [ 9 ] )
2013-10-14 16:24:45 +05:30
c = c + 9_pInt
end select
2013-10-08 21:57:26 +05:30
enddo
end function constitutive_dislotwin_postResults
end module constitutive_dislotwin