!-------------------------------------------------------------------------------------------------- !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Su Leen Wong, Max-Planck-Institut für Eisenforschung GmbH !> @author Nan Jia, Max-Planck-Institut für Eisenforschung GmbH !> @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 plastic_dislotwin use prec, only: & pReal implicit none private integer, dimension(:,:), allocatable, target, public :: & plastic_dislotwin_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & plastic_dislotwin_output !< name of each post result output real(pReal), parameter, private :: & kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin enum, bind(c) enumerator :: & undefined_ID, & rho_mob_ID, & rho_dip_ID, & dot_gamma_sl_ID, & gamma_sl_ID, & Lambda_sl_ID, & resolved_stress_slip_ID, & threshold_stress_slip_ID, & edge_dipole_distance_ID, & f_tw_ID, & Lambda_tw_ID, & resolved_stress_twin_ID, & tau_hat_tw_ID, & f_tr_ID end enum type, private :: tParameters real(pReal) :: & mu, & nu, & D0, & !< prefactor for self-diffusion coefficient Qsd, & !< activation energy for dislocation climb D, & ! @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_init use prec, only: & pStringLen, & dEq0, & dNeq0, & dNeq use debug, only: & debug_level,& debug_constitutive,& debug_levelBasic use math, only: & math_expand,& PI use IO, only: & IO_error use material use config, only: & config_phase use lattice integer :: & Ninstance, & p, i, & NipcMyPhase, outputSize, & sizeState, sizeDotState, & startIndex, endIndex integer, dimension(0), parameter :: emptyIntArray = [integer::] real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID character(len=pStringLen) :: & extmsg = '' character(len=65536), dimension(:), allocatable :: & outputs write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOTWIN_label//' init -+>>>' write(6,'(/,a)') ' Ma and Roters, Acta Materialia 52(12):3603–3612, 2004' write(6,'(a)') ' https://doi.org/10.1016/j.actamat.2004.04.012' write(6,'(/,a)') ' Roters et al., Computational Materials Science 39:91–95, 2007' write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2006.04.014' write(6,'(/,a)') ' Wong et al., Acta Materialia 118:140–151, 2016' write(6,'(a,/)') ' https://doi.org/10.1016/j.actamat.2016.07.032' Ninstance = count(phase_plasticity == PLASTICITY_DISLOTWIN_ID) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(plastic_dislotwin_sizePostResult(maxval(phase_Noutput),Ninstance),source=0) allocate(plastic_dislotwin_output(maxval(phase_Noutput),Ninstance)) plastic_dislotwin_output = '' allocate(param(Ninstance)) allocate(state(Ninstance)) allocate(dotState(Ninstance)) allocate(dependentState(Ninstance)) do p = 1, size(phase_plasticity) if (phase_plasticity(p) /= PLASTICITY_DISLOTWIN_ID) cycle associate(prm => param(phase_plasticityInstance(p)), & dot => dotState(phase_plasticityInstance(p)), & stt => state(phase_plasticityInstance(p)), & dst => dependentState(phase_plasticityInstance(p)), & config => config_phase(p)) prm%aTol_rho = config%getFloat('atol_rho', defaultVal=0.0_pReal) prm%aTol_f_tw = config%getFloat('atol_twinfrac', defaultVal=0.0_pReal) prm%aTol_f_tr = config%getFloat('atol_transfrac', defaultVal=0.0_pReal) ! This data is read in already in lattice prm%mu = lattice_mu(p) prm%nu = lattice_nu(p) prm%C66 = lattice_C66(1:6,1:6,p) !-------------------------------------------------------------------------------------------------- ! slip related parameters prm%N_sl = config%getInts('nslip',defaultVal=emptyIntArray) prm%sum_N_sl = sum(prm%N_sl) slipActive: if (prm%sum_N_sl > 0) then prm%P_sl = lattice_SchmidMatrix_slip(prm%N_sl,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) prm%h_sl_sl = lattice_interaction_SlipBySlip(prm%N_sl, & config%getFloats('interaction_slipslip'), & config%getString('lattice_structure')) prm%forestProjection = lattice_forestProjection (prm%N_sl,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) prm%fccTwinTransNucleation = merge(.true., .false., lattice_structure(p) == LATTICE_FCC_ID) & .and. (prm%N_sl(1) == 12) if(prm%fccTwinTransNucleation) & prm%fcc_twinNucleationSlipPair = lattice_fcc_twinNucleationSlipPair prm%rho_mob_0 = config%getFloats('rhoedge0', requiredSize=size(prm%N_sl)) prm%rho_dip_0 = config%getFloats('rhoedgedip0',requiredSize=size(prm%N_sl)) prm%v0 = config%getFloats('v0', requiredSize=size(prm%N_sl)) prm%b_sl = config%getFloats('slipburgers',requiredSize=size(prm%N_sl)) prm%Delta_F = config%getFloats('qedge', requiredSize=size(prm%N_sl)) prm%CLambdaSlip = config%getFloats('clambdaslip',requiredSize=size(prm%N_sl)) prm%p = config%getFloats('p_slip', requiredSize=size(prm%N_sl)) prm%q = config%getFloats('q_slip', requiredSize=size(prm%N_sl)) prm%B = config%getFloats('b', requiredSize=size(prm%N_sl), & defaultVal=[(0.0_pReal, i=1,size(prm%N_sl))]) prm%tau_0 = config%getFloat('solidsolutionstrength') prm%CEdgeDipMinDistance = config%getFloat('cedgedipmindistance') prm%D0 = config%getFloat('d0') prm%Qsd = config%getFloat('qsd') prm%atomicVolume = config%getFloat('catomicvolume') * prm%b_sl**3.0_pReal ! expand: family => system prm%rho_mob_0 = math_expand(prm%rho_mob_0, prm%N_sl) prm%rho_dip_0 = math_expand(prm%rho_dip_0, prm%N_sl) prm%v0 = math_expand(prm%v0, prm%N_sl) prm%b_sl = math_expand(prm%b_sl,prm%N_sl) prm%Delta_F = math_expand(prm%Delta_F, prm%N_sl) prm%CLambdaSlip = math_expand(prm%CLambdaSlip, prm%N_sl) prm%p = math_expand(prm%p, prm%N_sl) prm%q = math_expand(prm%q, prm%N_sl) prm%B = math_expand(prm%B, prm%N_sl) prm%atomicVolume = math_expand(prm%atomicVolume,prm%N_sl) ! sanity checks if ( prm%D0 <= 0.0_pReal) extmsg = trim(extmsg)//' D0' if ( prm%Qsd <= 0.0_pReal) extmsg = trim(extmsg)//' Qsd' if (any(prm%rho_mob_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_mob_0' if (any(prm%rho_dip_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_dip_0' if (any(prm%v0 < 0.0_pReal)) extmsg = trim(extmsg)//' v0' if (any(prm%b_sl <= 0.0_pReal)) extmsg = trim(extmsg)//' b_sl' if (any(prm%Delta_F <= 0.0_pReal)) extmsg = trim(extmsg)//' Delta_F' if (any(prm%CLambdaSlip <= 0.0_pReal)) extmsg = trim(extmsg)//' CLambdaSlip' if (any(prm%B < 0.0_pReal)) extmsg = trim(extmsg)//' B' if (any(prm%p<=0.0_pReal .or. prm%p>1.0_pReal)) extmsg = trim(extmsg)//' p' if (any(prm%q< 1.0_pReal .or. prm%q>2.0_pReal)) extmsg = trim(extmsg)//' q' else slipActive allocate(prm%b_sl(0)) endif slipActive !-------------------------------------------------------------------------------------------------- ! twin related parameters prm%N_tw = config%getInts('ntwin', defaultVal=emptyIntArray) prm%sum_N_tw = sum(prm%N_tw) if (prm%sum_N_tw > 0) then prm%P_tw = lattice_SchmidMatrix_twin(prm%N_tw,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) prm%h_tw_tw = lattice_interaction_TwinByTwin(prm%N_tw,& config%getFloats('interaction_twintwin'), & config%getString('lattice_structure')) prm%b_tw = config%getFloats('twinburgers', requiredSize=size(prm%N_tw)) prm%t_tw = config%getFloats('twinsize', requiredSize=size(prm%N_tw)) prm%r = config%getFloats('r_twin', requiredSize=size(prm%N_tw)) prm%xc_twin = config%getFloat('xc_twin') prm%L_tw = config%getFloat('l0_twin') prm%i_tw = config%getFloat('cmfptwin') prm%gamma_char = lattice_characteristicShear_Twin(prm%N_tw,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) prm%C66_tw = lattice_C66_twin(prm%N_tw,prm%C66,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) if (.not. prm%fccTwinTransNucleation) then prm%dot_N_0_tw = config%getFloats('ndot0_twin') prm%dot_N_0_tw = math_expand(prm%dot_N_0_tw,prm%N_tw) endif ! expand: family => system prm%b_tw = math_expand(prm%b_tw,prm%N_tw) prm%t_tw = math_expand(prm%t_tw,prm%N_tw) prm%r = math_expand(prm%r,prm%N_tw) else allocate(prm%t_tw(0)) allocate(prm%b_tw(0)) allocate(prm%r(0)) endif !-------------------------------------------------------------------------------------------------- ! transformation related parameters prm%N_tr = config%getInts('ntrans', defaultVal=emptyIntArray) prm%sum_N_tr = sum(prm%N_tr) if (prm%sum_N_tr > 0) then prm%b_tr = config%getFloats('transburgers') prm%b_tr = math_expand(prm%b_tr,prm%N_tr) prm%h = config%getFloat('transstackheight', defaultVal=0.0_pReal) ! ToDo: How to handle that??? prm%i_tr = config%getFloat('cmfptrans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? prm%gamma_fcc_hex = config%getFloat('deltag') prm%xc_trans = config%getFloat('xc_trans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? prm%L_tr = config%getFloat('l0_trans') prm%h_tr_tr = lattice_interaction_TransByTrans(prm%N_tr,& config%getFloats('interaction_transtrans'), & config%getString('lattice_structure')) prm%C66_tr = lattice_C66_trans(prm%N_tr,prm%C66, & config%getString('trans_lattice_structure'), & 0.0_pReal, & config%getFloat('a_bcc', defaultVal=0.0_pReal), & config%getFloat('a_fcc', defaultVal=0.0_pReal)) prm%P_tr = lattice_SchmidMatrix_trans(prm%N_tr, & config%getString('trans_lattice_structure'), & 0.0_pReal, & config%getFloat('a_bcc', defaultVal=0.0_pReal), & config%getFloat('a_fcc', defaultVal=0.0_pReal)) if (lattice_structure(p) /= LATTICE_fcc_ID) then prm%dot_N_0_tr = config%getFloats('ndot0_trans') prm%dot_N_0_tr = math_expand(prm%dot_N_0_tr,prm%N_tr) endif prm%t_tr = config%getFloats('lamellarsize') prm%t_tr = math_expand(prm%t_tr,prm%N_tr) prm%s = config%getFloats('s_trans',defaultVal=[0.0_pReal]) prm%s = math_expand(prm%s,prm%N_tr) else allocate(prm%t_tr(0)) allocate(prm%b_tr(0)) endif if (sum(prm%N_tw) > 0 .or. prm%sum_N_tr > 0) then prm%SFE_0K = config%getFloat('sfe_0k') prm%dSFE_dT = config%getFloat('dsfe_dt') prm%V_cs = config%getFloat('vcrossslip') endif if (prm%sum_N_sl > 0 .and. prm%sum_N_tw > 0) then prm%h_sl_tw = lattice_interaction_SlipByTwin(prm%N_sl,prm%N_tw,& config%getFloats('interaction_sliptwin'), & config%getString('lattice_structure')) if (prm%fccTwinTransNucleation .and. prm%sum_N_tw > 12) write(6,*) 'mist' ! ToDo: implement better test. The model will fail also if N_tw is [6,6] endif if (prm%sum_N_sl > 0 .and. prm%sum_N_tr > 0) then prm%h_sl_tr = lattice_interaction_SlipByTrans(prm%N_sl,prm%N_tr,& config%getFloats('interaction_sliptrans'), & config%getString('lattice_structure')) if (prm%fccTwinTransNucleation .and. prm%sum_N_tr > 12) write(6,*) 'mist' ! ToDo: implement better test. The model will fail also if N_tr is [6,6] endif !-------------------------------------------------------------------------------------------------- ! shearband related parameters prm%sbVelocity = config%getFloat('shearbandvelocity',defaultVal=0.0_pReal) if (prm%sbVelocity > 0.0_pReal) then prm%sbResistance = config%getFloat('shearbandresistance') prm%sbQedge = config%getFloat('qedgepersbsystem') prm%p_sb = config%getFloat('p_shearband') prm%q_sb = config%getFloat('q_shearband') ! sanity checks if (prm%sbResistance < 0.0_pReal) extmsg = trim(extmsg)//' shearbandresistance' if (prm%sbQedge < 0.0_pReal) extmsg = trim(extmsg)//' qedgepersbsystem' if (prm%p_sb <= 0.0_pReal) extmsg = trim(extmsg)//' p_shearband' if (prm%q_sb <= 0.0_pReal) extmsg = trim(extmsg)//' q_shearband' endif prm%D = config%getFloat('grainsize') if (config%keyExists('dipoleformationfactor')) call IO_error(1,ext_msg='use /nodipoleformation/') prm%dipoleformation = .not. config%keyExists('/nodipoleformation/') !if (Ndot0PerTwinFamily(f,p) < 0.0_pReal) & ! call IO_error(211,el=p,ext_msg='dot_N_0_tw ('//PLASTICITY_DISLOTWIN_label//')') if (any(prm%atomicVolume <= 0.0_pReal)) & call IO_error(211,el=p,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOTWIN_label//')') if (prm%sum_N_tw > 0) then if (prm%aTol_rho <= 0.0_pReal) & call IO_error(211,el=p,ext_msg='aTol_rho ('//PLASTICITY_DISLOTWIN_label//')') if (prm%aTol_f_tw <= 0.0_pReal) & call IO_error(211,el=p,ext_msg='aTol_f_tw ('//PLASTICITY_DISLOTWIN_label//')') endif if (prm%sum_N_tr > 0) then if (prm%aTol_f_tr <= 0.0_pReal) & call IO_error(211,el=p,ext_msg='aTol_f_tr ('//PLASTICITY_DISLOTWIN_label//')') endif outputs = config%getStrings('(output)', defaultVal=emptyStringArray) allocate(prm%outputID(0)) do i= 1, size(outputs) outputID = undefined_ID select case(outputs(i)) case ('edge_density') outputID = merge(rho_mob_ID,undefined_ID,prm%sum_N_sl > 0) outputSize = prm%sum_N_sl case ('dipole_density') outputID = merge(rho_dip_ID,undefined_ID,prm%sum_N_sl > 0) outputSize = prm%sum_N_sl case ('shear_rate_slip','shearrate_slip') outputID = merge(dot_gamma_sl_ID,undefined_ID,prm%sum_N_sl > 0) outputSize = prm%sum_N_sl case ('accumulated_shear_slip') outputID = merge(gamma_sl_ID,undefined_ID,prm%sum_N_sl > 0) outputSize = prm%sum_N_sl case ('mfp_slip') outputID = merge(Lambda_sl_ID,undefined_ID,prm%sum_N_sl > 0) outputSize = prm%sum_N_sl case ('resolved_stress_slip') outputID = merge(resolved_stress_slip_ID,undefined_ID,prm%sum_N_sl > 0) outputSize = prm%sum_N_sl case ('threshold_stress_slip') outputID= merge(threshold_stress_slip_ID,undefined_ID,prm%sum_N_sl > 0) outputSize = prm%sum_N_sl case ('twin_fraction') outputID = merge(f_tw_ID,undefined_ID,prm%sum_N_tw >0) outputSize = prm%sum_N_tw case ('mfp_twin') outputID = merge(Lambda_tw_ID,undefined_ID,prm%sum_N_tw >0) outputSize = prm%sum_N_tw case ('resolved_stress_twin') outputID = merge(resolved_stress_twin_ID,undefined_ID,prm%sum_N_tw >0) outputSize = prm%sum_N_tw case ('threshold_stress_twin') outputID = merge(tau_hat_tw_ID,undefined_ID,prm%sum_N_tw >0) outputSize = prm%sum_N_tw case ('strain_trans_fraction') outputID = f_tr_ID outputSize = prm%sum_N_tr end select if (outputID /= undefined_ID) then plastic_dislotwin_output(i,phase_plasticityInstance(p)) = outputs(i) plastic_dislotwin_sizePostResult(i,phase_plasticityInstance(p)) = outputSize prm%outputID = [prm%outputID, outputID] endif enddo !-------------------------------------------------------------------------------------------------- ! allocate state arrays NipcMyPhase = count(material_phase == p) sizeDotState = size(['rho_mob ','rho_dip ','gamma_sl']) * prm%sum_N_sl & + size(['f_tw']) * prm%sum_N_tw & + size(['f_tr']) * prm%sum_N_tr sizeState = sizeDotState call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,0, & prm%sum_N_sl,prm%sum_N_tw,prm%sum_N_tr) plasticState(p)%sizePostResults = sum(plastic_dislotwin_sizePostResult(:,phase_plasticityInstance(p))) !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and aTolState startIndex = 1 endIndex = prm%sum_N_sl stt%rho_mob=>plasticState(p)%state(startIndex:endIndex,:) stt%rho_mob= spread(prm%rho_mob_0,2,NipcMyPhase) dot%rho_mob=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTol_rho startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl stt%rho_dip=>plasticState(p)%state(startIndex:endIndex,:) stt%rho_dip= spread(prm%rho_dip_0,2,NipcMyPhase) dot%rho_dip=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTol_rho startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl stt%gamma_sl=>plasticState(p)%state(startIndex:endIndex,:) dot%gamma_sl=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = 1.0e6_pReal !ToDo: better make optional parameter ! global alias plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%accumulatedSlip => plasticState(p)%state(startIndex:endIndex,:) startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_tw stt%f_tw=>plasticState(p)%state(startIndex:endIndex,:) dot%f_tw=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTol_f_tw startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_tr stt%f_tr=>plasticState(p)%state(startIndex:endIndex,:) dot%f_tr=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTol_f_tr allocate(dst%Lambda_sl (prm%sum_N_sl, NipcMyPhase),source=0.0_pReal) allocate(dst%tau_pass (prm%sum_N_sl, NipcMyPhase),source=0.0_pReal) allocate(dst%Lambda_tw (prm%sum_N_tw, NipcMyPhase),source=0.0_pReal) allocate(dst%tau_hat_tw (prm%sum_N_tw, NipcMyPhase),source=0.0_pReal) allocate(dst%tau_r_tw (prm%sum_N_tw, NipcMyPhase),source=0.0_pReal) allocate(dst%f_tw (prm%sum_N_tw, NipcMyPhase),source=0.0_pReal) allocate(dst%Lambda_tr (prm%sum_N_tr,NipcMyPhase),source=0.0_pReal) allocate(dst%tau_hat_tr (prm%sum_N_tr,NipcMyPhase),source=0.0_pReal) allocate(dst%tau_r_tr (prm%sum_N_tr,NipcMyPhase),source=0.0_pReal) allocate(dst%f_tr (prm%sum_N_tr,NipcMyPhase),source=0.0_pReal) plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally end associate enddo end subroutine plastic_dislotwin_init !-------------------------------------------------------------------------------------------------- !> @brief returns the homogenized elasticity matrix !-------------------------------------------------------------------------------------------------- function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC) use material, only: & material_phase, & phase_plasticityInstance, & phasememberAt real(pReal), dimension(6,6) :: & homogenizedC integer, intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element integer :: i, & of real(pReal) :: f_unrotated of = phasememberAt(ipc,ip,el) associate(prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))),& stt => state(phase_plasticityInstance(material_phase(ipc,ip,el)))) f_unrotated = 1.0_pReal & - sum(stt%f_tw(1:prm%sum_N_tw,of)) & - sum(stt%f_tr(1:prm%sum_N_tr,of)) homogenizedC = f_unrotated * prm%C66 do i=1,prm%sum_N_tw homogenizedC = homogenizedC & + stt%f_tw(i,of)*prm%C66_tw(1:6,1:6,i) enddo do i=1,prm%sum_N_tr homogenizedC = homogenizedC & + stt%f_tr(i,of)*prm%C66_tr(1:6,1:6,i) enddo end associate end function plastic_dislotwin_homogenizedC !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) use prec, only: & tol_math_check, & dNeq0 use math, only: & math_eigenValuesVectorsSym, & math_outer, & math_symmetric33, & math_mul33xx33 real(pReal), dimension(3,3), intent(out) :: Lp real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp real(pReal), dimension(3,3), intent(in) :: Mp integer, intent(in) :: instance,of real(pReal), intent(in) :: T integer :: i,k,l,m,n real(pReal) :: f_unrotated,StressRatio_p,& BoltzmannRatio, & ddot_gamma_dtau, & tau real(pReal), dimension(param(instance)%sum_N_sl) :: & dot_gamma_sl,ddot_gamma_dtau_slip real(pReal), dimension(param(instance)%sum_N_tw) :: & dot_gamma_twin,ddot_gamma_dtau_twin real(pReal), dimension(param(instance)%sum_N_tr) :: & dot_gamma_tr,ddot_gamma_dtau_trans real(pReal):: dot_gamma_sb real(pReal), dimension(3,3) :: eigVectors, P_sb real(pReal), dimension(3) :: eigValues logical :: error real(pReal), dimension(3,6), parameter :: & 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]) associate(prm => param(instance), stt => state(instance)) f_unrotated = 1.0_pReal & - sum(stt%f_tw(1:prm%sum_N_tw,of)) & - sum(stt%f_tr(1:prm%sum_N_tr,of)) Lp = 0.0_pReal dLp_dMp = 0.0_pReal call kinetics_slip(Mp,T,instance,of,dot_gamma_sl,ddot_gamma_dtau_slip) slipContribution: do i = 1, prm%sum_N_sl Lp = Lp + dot_gamma_sl(i)*prm%P_sl(1:3,1:3,i) forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + ddot_gamma_dtau_slip(i) * prm%P_sl(k,l,i) * prm%P_sl(m,n,i) enddo slipContribution !ToDo: Why do this before shear banding? Lp = Lp * f_unrotated dLp_dMp = dLp_dMp * f_unrotated shearBandingContribution: if(dNeq0(prm%sbVelocity)) then BoltzmannRatio = prm%sbQedge/(kB*T) call math_eigenValuesVectorsSym(Mp,eigValues,eigVectors,error) do i = 1,6 P_sb = 0.5_pReal * math_outer(matmul(eigVectors,sb_sComposition(1:3,i)),& matmul(eigVectors,sb_mComposition(1:3,i))) tau = math_mul33xx33(Mp,P_sb) significantShearBandStress: if (abs(tau) > tol_math_check) then StressRatio_p = (abs(tau)/prm%sbResistance)**prm%p_sb dot_gamma_sb = sign(prm%sbVelocity*exp(-BoltzmannRatio*(1-StressRatio_p)**prm%q_sb), tau) ddot_gamma_dtau = abs(dot_gamma_sb)*BoltzmannRatio* prm%p_sb*prm%q_sb/ prm%sbResistance & * (abs(tau)/prm%sbResistance)**(prm%p_sb-1.0_pReal) & * (1.0_pReal-StressRatio_p)**(prm%q_sb-1.0_pReal) Lp = Lp + dot_gamma_sb * P_sb forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + ddot_gamma_dtau * P_sb(k,l) * P_sb(m,n) endif significantShearBandStress enddo endif shearBandingContribution call kinetics_twin(Mp,T,dot_gamma_sl,instance,of,dot_gamma_twin,ddot_gamma_dtau_twin) twinContibution: do i = 1, prm%sum_N_tw Lp = Lp + dot_gamma_twin(i)*prm%P_tw(1:3,1:3,i) * f_unrotated forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + ddot_gamma_dtau_twin(i)* prm%P_tw(k,l,i)*prm%P_tw(m,n,i) * f_unrotated enddo twinContibution call kinetics_trans(Mp,T,dot_gamma_sl,instance,of,dot_gamma_tr,ddot_gamma_dtau_trans) transContibution: do i = 1, prm%sum_N_tr Lp = Lp + dot_gamma_tr(i)*prm%P_tr(1:3,1:3,i) * f_unrotated forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + ddot_gamma_dtau_trans(i)* prm%P_tr(k,l,i)*prm%P_tr(m,n,i) * f_unrotated enddo transContibution end associate end subroutine plastic_dislotwin_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_dotState(Mp,T,instance,of) use prec, only: & tol_math_check, & dEq0 use math, only: & math_clip, & math_mul33xx33, & PI real(pReal), dimension(3,3), intent(in):: & Mp !< Mandel stress real(pReal), intent(in) :: & T !< temperature at integration point integer, intent(in) :: & instance, & of integer :: i real(pReal) :: f_unrotated,& VacancyDiffusion,& rho_dip_distance, ClimbVelocity, & tau real(pReal), dimension(param(instance)%sum_N_sl) :: & dot_rho_dip_formation, & dot_rho_dip_climb, & rho_dip_distance_min, & dot_gamma_sl real(pReal), dimension(param(instance)%sum_N_tw) :: & dot_gamma_twin real(pReal), dimension(param(instance)%sum_N_tr) :: & dot_gamma_tr associate(prm => param(instance), stt => state(instance), & dot => dotstate(instance), dst => dependentState(instance)) f_unrotated = 1.0_pReal & - sum(stt%f_tw(1:prm%sum_N_tw,of)) & - sum(stt%f_tr(1:prm%sum_N_tr,of)) VacancyDiffusion = prm%D0*exp(-prm%Qsd/(kB*T)) call kinetics_slip(Mp,T,instance,of,dot_gamma_sl) dot%gamma_sl(:,of) = abs(dot_gamma_sl) rho_dip_distance_min = prm%CEdgeDipMinDistance*prm%b_sl slipState: do i = 1, prm%sum_N_sl tau = math_mul33xx33(Mp,prm%P_sl(1:3,1:3,i)) significantSlipStress: if (dEq0(tau)) then dot_rho_dip_formation(i) = 0.0_pReal dot_rho_dip_climb(i) = 0.0_pReal else significantSlipStress rho_dip_distance = 3.0_pReal*prm%mu*prm%b_sl(i)/(16.0_pReal*PI*abs(tau)) rho_dip_distance = math_clip(rho_dip_distance, right = dst%Lambda_sl(i,of)) rho_dip_distance = math_clip(rho_dip_distance, left = rho_dip_distance_min(i)) if (prm%dipoleFormation) then dot_rho_dip_formation(i) = 2.0_pReal*(rho_dip_distance-rho_dip_distance_min(i))/prm%b_sl(i) & * stt%rho_mob(i,of)*abs(dot_gamma_sl(i)) else dot_rho_dip_formation(i) = 0.0_pReal endif if (dEq0(rho_dip_distance-rho_dip_distance_min(i))) then dot_rho_dip_climb(i) = 0.0_pReal else ClimbVelocity = 3.0_pReal*prm%mu*VacancyDiffusion*prm%atomicVolume(i) & / (2.0_pReal*PI*kB*T*(rho_dip_distance+rho_dip_distance_min(i))) dot_rho_dip_climb(i) = 4.0_pReal*ClimbVelocity*stt%rho_dip(i,of) & / (rho_dip_distance-rho_dip_distance_min(i)) endif endif significantSlipStress enddo slipState dot%rho_mob(:,of) = abs(dot_gamma_sl)/(prm%b_sl*dst%Lambda_sl(:,of)) & - dot_rho_dip_formation & - 2.0_pReal*rho_dip_distance_min/prm%b_sl * stt%rho_mob(:,of)*abs(dot_gamma_sl) dot%rho_dip(:,of) = dot_rho_dip_formation & - 2.0_pReal*rho_dip_distance_min/prm%b_sl * stt%rho_dip(:,of)*abs(dot_gamma_sl) & - dot_rho_dip_climb call kinetics_twin(Mp,T,dot_gamma_sl,instance,of,dot_gamma_twin) dot%f_tw(:,of) = f_unrotated*dot_gamma_twin/prm%gamma_char call kinetics_trans(Mp,T,dot_gamma_sl,instance,of,dot_gamma_tr) dot%f_tw(:,of) = f_unrotated*dot_gamma_tr end associate end subroutine plastic_dislotwin_dotState !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_dependentState(T,instance,of) use math, only: & PI integer, intent(in) :: & instance, & of real(pReal), intent(in) :: & T integer :: & i real(pReal) :: & sumf_twin,SFE,sumf_trans real(pReal), dimension(param(instance)%sum_N_sl) :: & inv_lambda_sl_sl, & !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation inv_lambda_sl_tw, & !* 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation inv_lambda_sl_tr !* 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation real(pReal), dimension(param(instance)%sum_N_tw) :: & inv_lambda_tw_tw !* 1/mean free distance between 2 twin stacks from different systems seen by a growing twin real(pReal), dimension(param(instance)%sum_N_tr) :: & inv_lambda_tr_tr !* 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite (1/lambda_trans) real(pReal), dimension(:), allocatable :: & x0, & f_over_t_tw, & f_over_t_tr associate(prm => param(instance),& stt => state(instance),& dst => dependentState(instance)) sumf_twin = sum(stt%f_tw(1:prm%sum_N_tw,of)) sumf_trans = sum(stt%f_tr(1:prm%sum_N_tr,of)) SFE = prm%SFE_0K + prm%dSFE_dT * T !* rescaled volume fraction for topology f_over_t_tw = stt%f_tw(1:prm%sum_N_tw,of)/prm%t_tw !ToDo: this is per system f_over_t_tr = sumf_trans/prm%t_tr !ToDo: But this not ... !Todo: Physically ok, but naming could be adjusted forall (i = 1:prm%sum_N_sl) & inv_lambda_sl_sl(i) = & sqrt(dot_product((stt%rho_mob(1:prm%sum_N_sl,of)+stt%rho_dip(1:prm%sum_N_sl,of)),& prm%forestProjection(1:prm%sum_N_sl,i)))/prm%CLambdaSlip(i) ! change order and use matmul if (prm%sum_N_tw > 0 .and. prm%sum_N_sl > 0) & inv_lambda_sl_tw = matmul(prm%h_sl_tw,f_over_t_tw)/(1.0_pReal-sumf_twin) !ToDo: needed? if (prm%sum_N_tw > 0) & inv_lambda_tw_tw = matmul(prm%h_tw_tw,f_over_t_tw)/(1.0_pReal-sumf_twin) if (prm%sum_N_tr > 0 .and. prm%sum_N_sl > 0) & inv_lambda_sl_tr = matmul(prm%h_sl_tr,f_over_t_tr)/(1.0_pReal-sumf_trans) !ToDo: needed? if (prm%sum_N_tr > 0) & inv_lambda_tr_tr = matmul(prm%h_tr_tr,f_over_t_tr)/(1.0_pReal-sumf_trans) if ((prm%sum_N_tw > 0) .or. (prm%sum_N_tr > 0)) then ! ToDo: Change order dst%Lambda_sl(:,of) = & prm%D/(1.0_pReal+prm%D*& (inv_lambda_sl_sl + inv_lambda_sl_tw + inv_lambda_sl_tr)) else dst%Lambda_sl(:,of) = prm%D & / (1.0_pReal+prm%D*inv_lambda_sl_sl) !!!!!! correct? endif dst%Lambda_tw(:,of) = prm%i_tw*prm%D/(1.0_pReal+prm%D*inv_lambda_tw_tw) dst%Lambda_tr(:,of) = prm%i_tr*prm%D/(1.0_pReal+prm%D*inv_lambda_tr_tr) !* threshold stress for dislocation motion dst%tau_pass(:,of) = prm%mu*prm%b_sl* sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,of)+stt%rho_dip(:,of))) !* threshold stress for growing twin/martensite if(prm%sum_N_tw == prm%sum_N_sl) & dst%tau_hat_tw(:,of) = & (SFE/(3.0_pReal*prm%b_tw)+ 3.0_pReal*prm%b_tw*prm%mu/(prm%L_tw*prm%b_sl)) ! slip burgers here correct? if(prm%sum_N_tr == prm%sum_N_sl) & dst%tau_hat_tr(:,of) = & (SFE/(3.0_pReal*prm%b_tr) + 3.0_pReal*prm%b_tr*prm%mu/& (prm%L_tr*prm%b_sl) + prm%h*prm%gamma_fcc_hex/ (3.0_pReal*prm%b_tr) ) dst%f_tw(:,of) = (PI/4.0_pReal)*prm%t_tw*dst%Lambda_tw(:,of)**2.0_pReal dst%f_tr(:,of) = (PI/4.0_pReal)*prm%t_tr*dst%Lambda_tr(:,of)**2.0_pReal x0 = prm%mu*prm%b_tw**2.0_pReal/(SFE*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) ! ToDo: In the paper, this is the burgers vector for slip and is the same for twin and trans dst%tau_r_tw(:,of) = prm%mu*prm%b_tw/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_twin)+cos(pi/3.0_pReal)/x0) x0 = prm%mu*prm%b_tr**2.0_pReal/(SFE*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) ! ToDo: In the paper, this is the burgers vector for slip dst%tau_r_tr(:,of) = prm%mu*prm%b_tr/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_trans)+cos(pi/3.0_pReal)/x0) end associate end subroutine plastic_dislotwin_dependentState !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- function plastic_dislotwin_postResults(Mp,T,instance,of) result(postResults) use prec, only: & tol_math_check, & dEq0 use math, only: & PI, & math_mul33xx33 real(pReal), dimension(3,3),intent(in) :: & Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation real(pReal), intent(in) :: & T !< temperature at integration point integer, intent(in) :: & instance, & of real(pReal), dimension(sum(plastic_dislotwin_sizePostResult(:,instance))) :: & postResults integer :: & o,c,j associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) c = 0 do o = 1,size(prm%outputID) select case(prm%outputID(o)) case (rho_mob_ID) postResults(c+1:c+prm%sum_N_sl) = stt%rho_mob(1:prm%sum_N_sl,of) c = c + prm%sum_N_sl case (rho_dip_ID) postResults(c+1:c+prm%sum_N_sl) = stt%rho_dip(1:prm%sum_N_sl,of) c = c + prm%sum_N_sl case (dot_gamma_sl_ID) call kinetics_slip(Mp,T,instance,of,postResults(c+1:c+prm%sum_N_sl)) c = c + prm%sum_N_sl case (gamma_sl_ID) postResults(c+1:c+prm%sum_N_sl) = stt%gamma_sl(1:prm%sum_N_sl,of) c = c + prm%sum_N_sl case (Lambda_sl_ID) postResults(c+1:c+prm%sum_N_sl) = dst%Lambda_sl(1:prm%sum_N_sl,of) c = c + prm%sum_N_sl case (resolved_stress_slip_ID) do j = 1, prm%sum_N_sl postResults(c+j) = math_mul33xx33(Mp,prm%P_sl(1:3,1:3,j)) enddo c = c + prm%sum_N_sl case (threshold_stress_slip_ID) postResults(c+1:c+prm%sum_N_sl) = dst%tau_pass(1:prm%sum_N_sl,of) c = c + prm%sum_N_sl case (f_tw_ID) postResults(c+1:c+prm%sum_N_tw) = stt%f_tw(1:prm%sum_N_tw,of) c = c + prm%sum_N_tw case (Lambda_tw_ID) postResults(c+1:c+prm%sum_N_tw) = dst%Lambda_tw(1:prm%sum_N_tw,of) c = c + prm%sum_N_tw case (resolved_stress_twin_ID) do j = 1, prm%sum_N_tw postResults(c+j) = math_mul33xx33(Mp,prm%P_tw(1:3,1:3,j)) enddo c = c + prm%sum_N_tw case (tau_hat_tw_ID) postResults(c+1:c+prm%sum_N_tw) = dst%tau_hat_tw(1:prm%sum_N_tw,of) c = c + prm%sum_N_tw case (f_tr_ID) postResults(c+1:c+prm%sum_N_tr) = stt%f_tr(1:prm%sum_N_tr,of) c = c + prm%sum_N_tr end select enddo end associate end function plastic_dislotwin_postResults !-------------------------------------------------------------------------------------------------- !> @brief writes results to HDF5 output file !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_results(instance,group) #if defined(PETSc) || defined(DAMASK_HDF5) use results, only: & results_writeDataset integer, intent(in) :: instance character(len=*) :: group integer :: o associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) outputsLoop: do o = 1,size(prm%outputID) select case(prm%outputID(o)) case (rho_mob_ID) call results_writeDataset(group,stt%rho_mob,'rho_mob',& 'mobile dislocation density','1/m²') case (rho_dip_ID) call results_writeDataset(group,stt%rho_dip,'rho_dip',& 'dislocation dipole density''1/m²') case (dot_gamma_sl_ID) call results_writeDataset(group,stt%gamma_sl,'dot_gamma_sl',& 'plastic shear','1') case (Lambda_sl_ID) call results_writeDataset(group,dst%Lambda_sl,'Lambda_sl',& 'mean free path for slip','m') case (threshold_stress_slip_ID) call results_writeDataset(group,dst%tau_pass,'tau_pass',& 'passing stress for slip','Pa') case (f_tw_ID) call results_writeDataset(group,stt%f_tw,'f_tw',& 'twinned volume fraction','m³/m³') case (Lambda_tw_ID) call results_writeDataset(group,dst%Lambda_tw,'Lambda_tw',& 'mean free path for twinning','m') case (tau_hat_tw_ID) call results_writeDataset(group,dst%tau_hat_tw,'tau_hat_tw',& 'threshold stress for twinning','Pa') case (f_tr_ID) call results_writeDataset(group,stt%f_tr,'f_tr',& 'martensite volume fraction','m³/m³') end select enddo outputsLoop end associate #else integer, intent(in) :: instance character(len=*) :: group #endif end subroutine plastic_dislotwin_results !-------------------------------------------------------------------------------------------------- !> @brief Shear rates on slip systems, their derivatives with respect to resolved stress and the ! resolved stresss !> @details Derivatives and resolved stress are calculated only optionally. ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end !-------------------------------------------------------------------------------------------------- pure subroutine kinetics_slip(Mp,T,instance,of, & dot_gamma_sl,ddot_gamma_dtau_slip,tau_slip) use prec, only: & tol_math_check, & dNeq0 use math, only: & math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & T !< temperature integer, intent(in) :: & instance, & of real(pReal), dimension(param(instance)%sum_N_sl), intent(out) :: & dot_gamma_sl real(pReal), dimension(param(instance)%sum_N_sl), optional, intent(out) :: & ddot_gamma_dtau_slip, & tau_slip real(pReal), dimension(param(instance)%sum_N_sl) :: & ddot_gamma_dtau real(pReal), dimension(param(instance)%sum_N_sl) :: & tau, & stressRatio, & StressRatio_p, & BoltzmannRatio, & v_wait_inverse, & !< inverse of the effective velocity of a dislocation waiting at obstacles (unsigned) v_run_inverse, & !< inverse of the velocity of a free moving dislocation (unsigned) dV_wait_inverse_dTau, & dV_run_inverse_dTau, & dV_dTau, & tau_eff !< effective resolved stress integer :: i associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) do i = 1, prm%sum_N_sl tau(i) = math_mul33xx33(Mp,prm%P_sl(1:3,1:3,i)) enddo tau_eff = abs(tau)-dst%tau_pass(:,of) significantStress: where(tau_eff > tol_math_check) stressRatio = tau_eff/prm%tau_0 StressRatio_p = stressRatio** prm%p BoltzmannRatio = prm%Delta_F/(kB*T) v_wait_inverse = prm%v0**(-1.0_pReal) * exp(BoltzmannRatio*(1.0_pReal-StressRatio_p)** prm%q) v_run_inverse = prm%B/(tau_eff*prm%b_sl) dot_gamma_sl = sign(stt%rho_mob(:,of)*prm%b_sl/(v_wait_inverse+v_run_inverse),tau) dV_wait_inverse_dTau = -1.0_pReal * v_wait_inverse * prm%p * prm%q * BoltzmannRatio & * (stressRatio**(prm%p-1.0_pReal)) & * (1.0_pReal-StressRatio_p)**(prm%q-1.0_pReal) & / prm%tau_0 dV_run_inverse_dTau = -1.0_pReal * v_run_inverse/tau_eff dV_dTau = -1.0_pReal * (dV_wait_inverse_dTau+dV_run_inverse_dTau) & / (v_wait_inverse+v_run_inverse)**2.0_pReal ddot_gamma_dtau = dV_dTau*stt%rho_mob(:,of)*prm%b_sl else where significantStress dot_gamma_sl = 0.0_pReal ddot_gamma_dtau = 0.0_pReal end where significantStress end associate if(present(ddot_gamma_dtau_slip)) ddot_gamma_dtau_slip = ddot_gamma_dtau if(present(tau_slip)) tau_slip = tau end subroutine kinetics_slip !-------------------------------------------------------------------------------------------------- !> @brief calculates shear rates on twin systems !-------------------------------------------------------------------------------------------------- pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,& dot_gamma_twin,ddot_gamma_dtau_twin) use prec, only: & tol_math_check, & dNeq0 use math, only: & math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & T !< temperature integer, intent(in) :: & instance, & of real(pReal), dimension(param(instance)%sum_N_sl), intent(in) :: & dot_gamma_sl real(pReal), dimension(param(instance)%sum_N_tw), intent(out) :: & dot_gamma_twin real(pReal), dimension(param(instance)%sum_N_tw), optional, intent(out) :: & ddot_gamma_dtau_twin real, dimension(param(instance)%sum_N_tw) :: & tau, & Ndot0, & stressRatio_r, & ddot_gamma_dtau integer :: i,s1,s2 associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) do i = 1, prm%sum_N_tw tau(i) = math_mul33xx33(Mp,prm%P_tw(1:3,1:3,i)) isFCC: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,i) s2=prm%fcc_twinNucleationSlipPair(2,i) if (tau(i) < dst%tau_r_tw(i,of)) then Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,of)+stt%rho_dip(s2,of))+& abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,of)+stt%rho_dip(s1,of)))/& ! ToDo: MD: it would be more consistent to use shearrates from state (prm%L_tw*prm%b_sl(i))*& (1.0_pReal-exp(-prm%V_cs/(kB*T)*& (dst%tau_r_tw(i,of)-tau))) else Ndot0=0.0_pReal end if else isFCC Ndot0=prm%dot_N_0_tw(i) endif isFCC enddo significantStress: where(tau > tol_math_check) StressRatio_r = (dst%tau_hat_tw(:,of)/tau)**prm%r dot_gamma_twin = prm%gamma_char * dst%f_tw(:,of) * Ndot0*exp(-StressRatio_r) ddot_gamma_dtau = (dot_gamma_twin*prm%r/tau)*StressRatio_r else where significantStress dot_gamma_twin = 0.0_pReal ddot_gamma_dtau = 0.0_pReal end where significantStress end associate if(present(ddot_gamma_dtau_twin)) ddot_gamma_dtau_twin = ddot_gamma_dtau end subroutine kinetics_twin !-------------------------------------------------------------------------------------------------- !> @brief calculates shear rates on twin systems !-------------------------------------------------------------------------------------------------- pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& dot_gamma_tr,ddot_gamma_dtau_trans) use prec, only: & tol_math_check, & dNeq0 use math, only: & math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & T !< temperature integer, intent(in) :: & instance, & of real(pReal), dimension(param(instance)%sum_N_sl), intent(in) :: & dot_gamma_sl real(pReal), dimension(param(instance)%sum_N_tr), intent(out) :: & dot_gamma_tr real(pReal), dimension(param(instance)%sum_N_tr), optional, intent(out) :: & ddot_gamma_dtau_trans real, dimension(param(instance)%sum_N_tr) :: & tau, & Ndot0, & stressRatio_s, & ddot_gamma_dtau integer :: i,s1,s2 associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) do i = 1, prm%sum_N_tr tau(i) = math_mul33xx33(Mp,prm%P_tr(1:3,1:3,i)) isFCC: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,i) s2=prm%fcc_twinNucleationSlipPair(2,i) if (tau(i) < dst%tau_r_tr(i,of)) then Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,of)+stt%rho_dip(s2,of))+& abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,of)+stt%rho_dip(s1,of)))/& ! ToDo: MD: it would be more consistent to use shearrates from state (prm%L_tr*prm%b_sl(i))*& (1.0_pReal-exp(-prm%V_cs/(kB*T)*& (dst%tau_r_tr(i,of)-tau))) else Ndot0=0.0_pReal end if else isFCC Ndot0=prm%dot_N_0_tr(i) endif isFCC enddo significantStress: where(tau > tol_math_check) StressRatio_s = (dst%tau_hat_tr(:,of)/tau)**prm%s dot_gamma_tr = dst%f_tr(:,of) * Ndot0*exp(-StressRatio_s) ddot_gamma_dtau = (dot_gamma_tr*prm%r/tau)*StressRatio_s else where significantStress dot_gamma_tr = 0.0_pReal ddot_gamma_dtau = 0.0_pReal end where significantStress end associate if(present(ddot_gamma_dtau_trans)) ddot_gamma_dtau_trans = ddot_gamma_dtau end subroutine kinetics_trans end module plastic_dislotwin