From d451a3a7a09ff03cb7bd537e9b799283d873983b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 27 Nov 2018 18:25:06 +0100 Subject: [PATCH 01/47] calculation of shearrates etc in one function --- src/plastic_disloUCLA.f90 | 176 +++++++++++++++++++++++++------------- 1 file changed, 118 insertions(+), 58 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 7c4d87fff..1e33f82b0 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -1241,6 +1241,123 @@ function plastic_disloUCLA_postResults(Tstar_v,Temperature,ipc,ip,el) plastic_disloUCLA_postResults(c+1_pInt:c+ns) = state(instance)%rhoEdgeDip(1_pInt:ns,of) c = c + ns case (shear_rate_slip_ID,stress_exponent_ID) + call kinetics(Tstar_v,Temperature,ipc,ip,el, & + gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) + + if (plastic_disloUCLA_outputID(o,instance) == shear_rate_slip_ID) then + plastic_disloUCLA_postResults(c+1:c+ns) = (gdot_slip_pos + gdot_slip_neg)*0.5_pReal + c = c + ns + elseif(plastic_disloUCLA_outputID(o,instance) == stress_exponent_ID) then + do j = 1_pInt, ns + if (dEq(gdot_slip_pos(j)+gdot_slip_neg(j),0.0_pReal)) then + plastic_disloUCLA_postResults(c+j) = 0.0_pReal + else + plastic_disloUCLA_postResults(c+j) = (tau_slip_pos(j)+tau_slip_neg(j))/& + (gdot_slip_pos(j)+gdot_slip_neg(j))*& + (dgdot_dtauslip_pos(j)+dgdot_dtauslip_neg(j))* 0.5_pReal + endif + enddo + c = c + ns + endif + + case (accumulated_shear_slip_ID) + plastic_disloUCLA_postResults(c+1_pInt:c+ns) = & + state(instance)%accshear_slip(1_pInt:ns, of) + c = c + ns + case (mfp_slip_ID) + plastic_disloUCLA_postResults(c+1_pInt:c+ns) =& + state(instance)%mfp_slip(1_pInt:ns, of) + c = c + ns + case (resolved_stress_slip_ID) + j = 0_pInt + slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems1: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) + j = j + 1_pInt + plastic_disloUCLA_postResults(c+j) =& + dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) + enddo slipSystems1; enddo slipFamilies1 + c = c + ns + case (threshold_stress_slip_ID) + plastic_disloUCLA_postResults(c+1_pInt:c+ns) = & + state(instance)%threshold_stress_slip(1_pInt:ns,of) + c = c + ns + case (edge_dipole_distance_ID) + j = 0_pInt + slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems2: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) + j = j + 1_pInt + if (dNeq0(abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph))))) then + plastic_disloUCLA_postResults(c+j) = & + (3.0_pReal*lattice_mu(ph)*plastic_disloUCLA_burgersPerSlipSystem(j,instance))/& + (16.0_pReal*pi*abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)))) + else + plastic_disloUCLA_postResults(c+j) = huge(1.0_pReal) + endif + plastic_disloUCLA_postResults(c+j)=min(plastic_disloUCLA_postResults(c+j),& + state(instance)%mfp_slip(j,of)) + enddo slipSystems2; enddo slipFamilies2 + c = c + ns + end select + enddo +end function plastic_disloUCLA_postResults + + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of constitutive results +!-------------------------------------------------------------------------------------------------- +subroutine kinetics(Tstar_v,Temperature,ipc,ip,el, & + gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) + use prec, only: & + tol_math_check, & + dEq, dNeq0 + use math, only: & + pi + use material, only: & + material_phase, & + phase_plasticityInstance,& + !plasticState, & + phaseAt, phasememberAt + use lattice, only: & + lattice_Sslip_v, & + lattice_maxNslipFamily, & + lattice_NslipSystem, & + lattice_NnonSchmid, & + lattice_mu + + implicit none + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal), intent(in) :: & + temperature !< temperature at integration point + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + + real(pReal), dimension(plastic_disloUCLA_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + plastic_disloUCLA_postResults + + integer(pInt) :: & + instance,& + ns,& + f,o,i,c,j,k,index_myFamily,& + ph, & + of + real(pReal) :: StressRatio_p,StressRatio_pminus1,& + BoltzmannRatio,DotGamma0,stressRatio,& + dvel_slip, vel_slip + real(pReal), intent(out), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg + + !* Shortened notation + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + ns = plastic_disloUCLA_totalNslip(instance) + + gdot_slip_pos = 0.0_pReal gdot_slip_neg = 0.0_pReal dgdot_dtauslip_pos = 0.0_pReal @@ -1404,63 +1521,6 @@ function plastic_disloUCLA_postResults(Tstar_v,Temperature,ipc,ip,el) enddo slipSystems enddo slipFamilies - if (plastic_disloUCLA_outputID(o,instance) == shear_rate_slip_ID) then - plastic_disloUCLA_postResults(c+1:c+ns) = (gdot_slip_pos + gdot_slip_neg)*0.5_pReal - c = c + ns - elseif(plastic_disloUCLA_outputID(o,instance) == stress_exponent_ID) then - do j = 1_pInt, ns - if (dEq(gdot_slip_pos(j)+gdot_slip_neg(j),0.0_pReal)) then - plastic_disloUCLA_postResults(c+j) = 0.0_pReal - else - plastic_disloUCLA_postResults(c+j) = (tau_slip_pos(j)+tau_slip_neg(j))/& - (gdot_slip_pos(j)+gdot_slip_neg(j))*& - (dgdot_dtauslip_pos(j)+dgdot_dtauslip_neg(j))* 0.5_pReal - endif - enddo - c = c + ns - endif - - case (accumulated_shear_slip_ID) - plastic_disloUCLA_postResults(c+1_pInt:c+ns) = & - state(instance)%accshear_slip(1_pInt:ns, of) - c = c + ns - case (mfp_slip_ID) - plastic_disloUCLA_postResults(c+1_pInt:c+ns) =& - state(instance)%mfp_slip(1_pInt:ns, of) - c = c + ns - case (resolved_stress_slip_ID) - j = 0_pInt - slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) - j = j + 1_pInt - plastic_disloUCLA_postResults(c+j) =& - dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) - enddo slipSystems1; enddo slipFamilies1 - c = c + ns - case (threshold_stress_slip_ID) - plastic_disloUCLA_postResults(c+1_pInt:c+ns) = & - state(instance)%threshold_stress_slip(1_pInt:ns,of) - c = c + ns - case (edge_dipole_distance_ID) - j = 0_pInt - slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems2: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) - j = j + 1_pInt - if (dNeq0(abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph))))) then - plastic_disloUCLA_postResults(c+j) = & - (3.0_pReal*lattice_mu(ph)*plastic_disloUCLA_burgersPerSlipSystem(j,instance))/& - (16.0_pReal*pi*abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)))) - else - plastic_disloUCLA_postResults(c+j) = huge(1.0_pReal) - endif - plastic_disloUCLA_postResults(c+j)=min(plastic_disloUCLA_postResults(c+j),& - state(instance)%mfp_slip(j,of)) - enddo slipSystems2; enddo slipFamilies2 - c = c + ns - end select - enddo -end function plastic_disloUCLA_postResults +end subroutine kinetics end module plastic_disloUCLA From d89dc6cc007c84488bb79a7e930d39d35e37ae98 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 27 Nov 2018 18:41:33 +0100 Subject: [PATCH 02/47] preparing for the use of kinetics --- src/plastic_disloUCLA.f90 | 40 +++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 1e33f82b0..017bdf548 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -1017,8 +1017,6 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) EdgeDipMinDistance,& AtomicVolume,& VacancyDiffusion,& - tau_slip_pos,& - tau_slip_neg,& DotRhoMultiplication,& EdgeDipDistance, & DotRhoEdgeDipAnnihilation, & @@ -1029,7 +1027,9 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) vel_slip, & gdot_slip real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_slip_pos, gdot_slip_neg + gdot_slip_pos, gdot_slip_neg,& + tau_slip_pos,& + tau_slip_neg !* Shortened notation of = phasememberAt(ipc,ip,el) @@ -1054,19 +1054,19 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) state(instance)%rhoEdge(j,of)*plastic_disloUCLA_burgersPerSlipSystem(j,instance)*& plastic_disloUCLA_v0PerSlipSystem(j,instance) !* Resolved shear stress on slip system - tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_pos + tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + tau_slip_neg(j) = tau_slip_pos(j) nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & + tau_slip_pos(j) = tau_slip_pos(j) + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & + tau_slip_neg(j) = tau_slip_neg(j) + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo nonSchmidSystems - significantPositiveStress: if((abs(tau_slip_pos)-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then + significantPositiveStress: if((abs(tau_slip_pos(j))-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then !* Stress ratios - stressRatio = ((abs(tau_slip_pos)-state(instance)%threshold_stress_slip(j,of))/& + stressRatio = ((abs(tau_slip_pos(j))-state(instance)%threshold_stress_slip(j,of))/& (plastic_disloUCLA_SolidSolutionStrength(instance)+& plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) @@ -1074,10 +1074,10 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & - * (tau_slip_pos & + * (tau_slip_pos(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & / ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos(j) & + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & @@ -1085,11 +1085,11 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) gdot_slip_pos(j) = DotGamma0 & * vel_slip & - * sign(1.0_pReal,tau_slip_pos) + * sign(1.0_pReal,tau_slip_pos(j)) endif significantPositiveStress - significantNegativeStress: if((abs(tau_slip_neg)-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then + significantNegativeStress: if((abs(tau_slip_neg(j))-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then !* Stress ratios - stressRatio = ((abs(tau_slip_neg)-state(instance)%threshold_stress_slip(j,of))/& + stressRatio = ((abs(tau_slip_neg(j))-state(instance)%threshold_stress_slip(j,of))/& (plastic_disloUCLA_SolidSolutionStrength(instance)+& plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) @@ -1097,10 +1097,10 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & - * (tau_slip_neg & + * (tau_slip_neg(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & / ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg(j) & + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & @@ -1108,7 +1108,7 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) gdot_slip_neg(j) = DotGamma0 & * vel_slip & - * sign(1.0_pReal,tau_slip_neg) + * sign(1.0_pReal,tau_slip_neg(j)) endif significantNegativeStress gdot_slip = (gdot_slip_pos(j)+gdot_slip_neg(j))*0.5_pReal !* Multiplication @@ -1119,12 +1119,12 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) !* Dipole formation EdgeDipMinDistance = & plastic_disloUCLA_CEdgeDipMinDistance(instance)*plastic_disloUCLA_burgersPerSlipSystem(j,instance) - if (dEq0(tau_slip_pos)) then + if (dEq0(tau_slip_pos(j))) then DotRhoDipFormation = 0.0_pReal else EdgeDipDistance = & (3.0_pReal*lattice_mu(ph)*plastic_disloUCLA_burgersPerSlipSystem(j,instance))/& - (16.0_pReal*pi*abs(tau_slip_pos)) + (16.0_pReal*pi*abs(tau_slip_pos(j))) if (EdgeDipDistance>state(instance)%mfp_slip(j,of)) EdgeDipDistance=state(instance)%mfp_slip(j,of) if (EdgeDipDistance Date: Tue, 27 Nov 2018 18:53:01 +0100 Subject: [PATCH 03/47] don't need to repeat code --- src/plastic_disloUCLA.f90 | 63 +++------------------------------------ 1 file changed, 4 insertions(+), 59 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 017bdf548..3d91a6fd3 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -1029,7 +1029,8 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_slip_pos, gdot_slip_neg,& tau_slip_pos,& - tau_slip_neg + tau_slip_neg, & + dgdot_dtauslip_neg,dgdot_dtauslip_pos !* Shortened notation of = phasememberAt(ipc,ip,el) @@ -1040,8 +1041,8 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) plasticState(ph)%dotState(:,of) = 0.0_pReal !* Dislocation density evolution - gdot_slip_pos = 0.0_pReal - gdot_slip_neg = 0.0_pReal + call kinetics(Tstar_v,Temperature,ipc,ip,el, & + gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) j = 0_pInt slipFamilies: do f = 1_pInt,lattice_maxNslipFamily index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family @@ -1053,63 +1054,7 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) DotGamma0 = & state(instance)%rhoEdge(j,of)*plastic_disloUCLA_burgersPerSlipSystem(j,instance)*& plastic_disloUCLA_v0PerSlipSystem(j,instance) - !* Resolved shear stress on slip system - tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) - tau_slip_neg(j) = tau_slip_pos(j) - nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos(j) = tau_slip_pos(j) + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) - tau_slip_neg(j) = tau_slip_neg(j) + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) - enddo nonSchmidSystems - - significantPositiveStress: if((abs(tau_slip_pos(j))-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then - !* Stress ratios - stressRatio = ((abs(tau_slip_pos(j))-state(instance)%threshold_stress_slip(j,of))/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+& - plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) - stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) - !* Shear rates due to slip - vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & - * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & - * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & - * (tau_slip_pos(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & - / ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos(j) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & - ) - - gdot_slip_pos(j) = DotGamma0 & - * vel_slip & - * sign(1.0_pReal,tau_slip_pos(j)) - endif significantPositiveStress - significantNegativeStress: if((abs(tau_slip_neg(j))-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then - !* Stress ratios - stressRatio = ((abs(tau_slip_neg(j))-state(instance)%threshold_stress_slip(j,of))/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+& - plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) - stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) - - vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & - * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & - * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & - * (tau_slip_neg(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & - / ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg(j) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & - ) - - gdot_slip_neg(j) = DotGamma0 & - * vel_slip & - * sign(1.0_pReal,tau_slip_neg(j)) - endif significantNegativeStress gdot_slip = (gdot_slip_pos(j)+gdot_slip_neg(j))*0.5_pReal !* Multiplication DotRhoMultiplication = abs(gdot_slip)/& From 87b7569eb5df64daca02e910938ad54a1c034d07 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 27 Nov 2018 19:01:55 +0100 Subject: [PATCH 04/47] preparing use of kinetics function --- src/plastic_disloUCLA.f90 | 58 +++++++++++++++++++-------------------- 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 3d91a6fd3..b335cce26 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -774,14 +774,14 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature integer(pInt) :: instance,ph,of,ns,f,i,j,k,l,m,n,index_myFamily real(pReal) :: StressRatio_p,StressRatio_pminus1,BoltzmannRatio,DotGamma0, & - tau_slip_pos,tau_slip_neg,vel_slip,dvel_slip,& - dgdot_dtauslip_pos,dgdot_dtauslip_neg,stressRatio + vel_slip,dvel_slip,& + stressRatio real(pReal), dimension(3,3,2) :: & nonSchmid_tensor real(pReal), dimension(3,3,3,3) :: & dLp_dTstar3333 real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_slip_pos,gdot_slip_neg + gdot_slip_pos,gdot_slip_neg,tau_slip_pos,tau_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg !* Shortened notation of = phasememberAt(ipc,ip,el) @@ -811,14 +811,14 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature state(instance)%rhoEdge(j,of)*plastic_disloUCLA_burgersPerSlipSystem(j,instance)*& plastic_disloUCLA_v0PerSlipSystem(j,instance) !* Resolved shear stress on slip system - tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_pos + tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + tau_slip_neg(j) = tau_slip_pos(j) nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & + tau_slip_pos(j) = tau_slip_pos(j) + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & + tau_slip_neg(j) = tau_slip_neg(j) + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + plastic_disloUCLA_nonSchmidCoeff(k,instance)*& lattice_Sslip(1:3,1:3,2*k, index_myFamily+i,ph) @@ -826,9 +826,9 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) enddo nonSchmidSystems - significantPostitiveStress: if((abs(tau_slip_pos)-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then + significantPostitiveStress: if((abs(tau_slip_pos(j))-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then !* Stress ratio - stressRatio = ((abs(tau_slip_pos)-state(instance)%threshold_stress_slip(j,of))/& + stressRatio = ((abs(tau_slip_pos(j))-state(instance)%threshold_stress_slip(j,of))/& (plastic_disloUCLA_SolidSolutionStrength(instance)+& plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) @@ -837,10 +837,10 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & - * (tau_slip_pos & + * (tau_slip_pos(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & / ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos(j) & + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & @@ -848,7 +848,7 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature gdot_slip_pos(j) = DotGamma0 & * vel_slip & - * sign(1.0_pReal,tau_slip_pos) + * sign(1.0_pReal,tau_slip_pos(j)) !* Derivatives of shear rates dvel_slip = & @@ -857,19 +857,19 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & * ( & (exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & - + tau_slip_pos & + + tau_slip_pos(j) & * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& *plastic_disloUCLA_qPerSlipFamily(f,instance)/& (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) ) &!deltaf(f) ) & - * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos & + * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos(j) & + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & ) & - - (tau_slip_pos & + - (tau_slip_pos(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal) & + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & @@ -883,18 +883,18 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature ) & / ( & ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos(j) & + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & )**2.0_pReal & ) - dgdot_dtauslip_pos = DotGamma0 * dvel_slip + dgdot_dtauslip_pos(j) = DotGamma0 * dvel_slip endif significantPostitiveStress - significantNegativeStress: if((abs(tau_slip_neg)-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then + significantNegativeStress: if((abs(tau_slip_neg(j))-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then !* Stress ratio - stressRatio = ((abs(tau_slip_neg)-state(instance)%threshold_stress_slip(j,of))/& + stressRatio = ((abs(tau_slip_neg(j))-state(instance)%threshold_stress_slip(j,of))/& (plastic_disloUCLA_SolidSolutionStrength(instance)+& plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) @@ -903,10 +903,10 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & - * (tau_slip_neg & + * (tau_slip_neg(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & / ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg(j) & + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & @@ -914,7 +914,7 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature gdot_slip_neg(j) = DotGamma0 & * vel_slip & - * sign(1.0_pReal,tau_slip_neg) + * sign(1.0_pReal,tau_slip_neg(j)) !* Derivatives of shear rates dvel_slip = & @@ -923,19 +923,19 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & * ( & (exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & - + tau_slip_neg & + + tau_slip_neg(j) & * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& *plastic_disloUCLA_qPerSlipFamily(f,instance)/& (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) ) &!deltaf(f) ) & - * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg & + * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg(j) & + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & ) & - - (tau_slip_neg & + - (tau_slip_neg(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal) & + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & @@ -949,14 +949,14 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature ) & / ( & ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg & + 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg(j) & + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & )**2.0_pReal & ) - dgdot_dtauslip_neg = DotGamma0 * dvel_slip + dgdot_dtauslip_neg(j) = DotGamma0 * dvel_slip endif significantNegativeStress !* Plastic velocity gradient for dislocation glide @@ -964,8 +964,8 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature !* 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_pos*nonSchmid_tensor(m,n,1)+& - dgdot_dtauslip_neg*nonSchmid_tensor(m,n,2))*0.5_pReal*& + dLp_dTstar3333(k,l,m,n) + (dgdot_dtauslip_pos(j)*nonSchmid_tensor(m,n,1)+& + dgdot_dtauslip_neg(j)*nonSchmid_tensor(m,n,2))*0.5_pReal*& lattice_Sslip(k,l,1,index_myFamily+i,ph) enddo slipSystems enddo slipFamilies From 01bc94557911203d764fca7d726b579fd115efb9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 27 Nov 2018 19:19:36 +0100 Subject: [PATCH 05/47] avoid code duplication --- src/plastic_disloUCLA.f90 | 147 +------------------------------------- 1 file changed, 3 insertions(+), 144 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index b335cce26..eed8aac91 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -794,11 +794,10 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature !-------------------------------------------------------------------------------------------------- ! Dislocation glide part - gdot_slip_pos = 0.0_pReal - gdot_slip_neg = 0.0_pReal - dgdot_dtauslip_pos = 0.0_pReal - dgdot_dtauslip_neg = 0.0_pReal + !* Dislocation density evolution + call kinetics(Tstar_v,Temperature,ipc,ip,el, & + gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) j = 0_pInt slipFamilies: do f = 1_pInt,lattice_maxNslipFamily index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family @@ -810,155 +809,15 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature DotGamma0 = & state(instance)%rhoEdge(j,of)*plastic_disloUCLA_burgersPerSlipSystem(j,instance)*& plastic_disloUCLA_v0PerSlipSystem(j,instance) - !* Resolved shear stress on slip system - tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) - tau_slip_neg(j) = tau_slip_pos(j) nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos(j) = tau_slip_pos(j) + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) - tau_slip_neg(j) = tau_slip_neg(j) + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + plastic_disloUCLA_nonSchmidCoeff(k,instance)*& lattice_Sslip(1:3,1:3,2*k, index_myFamily+i,ph) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + plastic_disloUCLA_nonSchmidCoeff(k,instance)*& lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) enddo nonSchmidSystems - significantPostitiveStress: if((abs(tau_slip_pos(j))-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then - !* Stress ratio - stressRatio = ((abs(tau_slip_pos(j))-state(instance)%threshold_stress_slip(j,of))/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+& - plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) - stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) - stressRatio_pminus1 = stressRatio**(plastic_disloUCLA_pPerSlipFamily(f,instance)-1.0_pReal) - !* Shear rates due to slip - vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & - * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & - * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & - * (tau_slip_pos(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & - / ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos(j) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & - ) - - gdot_slip_pos(j) = DotGamma0 & - * vel_slip & - * sign(1.0_pReal,tau_slip_pos(j)) - - !* Derivatives of shear rates - dvel_slip = & - 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & - * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & - * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & - * ( & - (exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & - + tau_slip_pos(j) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) - *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& - *plastic_disloUCLA_qPerSlipFamily(f,instance)/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& - StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) ) &!deltaf(f) - ) & - * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos(j) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & - ) & - - (tau_slip_pos(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & - * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) - *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& - *plastic_disloUCLA_qPerSlipFamily(f,instance)/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& - StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) )& !deltaf(f) - ) & - ) & - / ( & - ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos(j) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & - )**2.0_pReal & - ) - dgdot_dtauslip_pos(j) = DotGamma0 * dvel_slip - - endif significantPostitiveStress - significantNegativeStress: if((abs(tau_slip_neg(j))-state(instance)%threshold_stress_slip(j,of)) > tol_math_check) then - !* Stress ratio - stressRatio = ((abs(tau_slip_neg(j))-state(instance)%threshold_stress_slip(j,of))/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+& - plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) - stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) - stressRatio_pminus1 = stressRatio**(plastic_disloUCLA_pPerSlipFamily(f,instance)-1.0_pReal) - !* Shear rates due to slip - vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & - * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & - * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & - * (tau_slip_neg(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & - / ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg(j) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & - ) - - gdot_slip_neg(j) = DotGamma0 & - * vel_slip & - * sign(1.0_pReal,tau_slip_neg(j)) - - !* Derivatives of shear rates - dvel_slip = & - 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & - * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & - * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & - * ( & - (exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & - + tau_slip_neg(j) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) - *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& - *plastic_disloUCLA_qPerSlipFamily(f,instance)/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& - StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) ) &!deltaf(f) - ) & - * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg(j) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & - ) & - - (tau_slip_neg(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & - * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) - *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& - *plastic_disloUCLA_qPerSlipFamily(f,instance)/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& - StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) )& !deltaf(f) - ) & - ) & - / ( & - ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg(j) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & - )**2.0_pReal & - ) - - dgdot_dtauslip_neg(j) = DotGamma0 * dvel_slip - - endif significantNegativeStress !* Plastic velocity gradient for dislocation glide Lp = Lp + (gdot_slip_pos(j)+gdot_slip_neg(j))*0.5_pReal*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) !* Calculation of the tangent of Lp From 6c23e9feb8174611b2d9913a908ebab2c116ed56 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 27 Nov 2018 19:28:00 +0100 Subject: [PATCH 06/47] be lazy, use a function --- src/plastic_disloUCLA.f90 | 29 ++++++----------------------- 1 file changed, 6 insertions(+), 23 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index eed8aac91..eabaa3a9e 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -152,7 +152,8 @@ subroutine plastic_disloUCLA_init(fileUnit) PLASTICITY_DISLOUCLA_label, & PLASTICITY_DISLOUCLA_ID, & material_phase, & - plasticState + plasticState, & +material_allocatePlasticState use config, only: & MATERIAL_partPhase use lattice @@ -486,29 +487,11 @@ subroutine plastic_disloUCLA_init(fileUnit) + int(size(['invLambdaSlip ',& 'meanFreePathSlip ','tauSlipThreshold ']),pInt) * ns - plasticState(phase)%sizeState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizeDeltaState = sizeDeltaState - plasticState(phase)%sizePostResults = plastic_disloUCLA_sizePostResults(instance) - plasticState(phase)%nSlip = plastic_disloucla_totalNslip(instance) - plasticState(phase)%nTwin = 0_pInt - plasticState(phase)%nTrans= 0_pInt - 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) + call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,0_pInt, & + ns,0_pInt,0_pInt) + +plasticState(phase)%sizePostResults = plastic_disloUCLA_sizePostResults(instance) - allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (sizeDeltaState,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) offset_slip = 2_pInt*plasticState(phase)%nSlip plasticState(phase)%slipRate => & plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NofMyPhase) From e305e99541a1f0c89821293ae3fec73532ec2d0c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 27 Nov 2018 19:49:04 +0100 Subject: [PATCH 07/47] cleaning --- src/plastic_disloUCLA.f90 | 59 ++++++++------------------------------- 1 file changed, 12 insertions(+), 47 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index eabaa3a9e..e094fcd87 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -157,8 +157,6 @@ material_allocatePlasticState use config, only: & MATERIAL_partPhase use lattice - use numerics,only: & - numerics_integrator implicit none integer(pInt), intent(in) :: fileUnit @@ -743,7 +741,6 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature phaseAt, phasememberAt use lattice, only: & lattice_Sslip, & - lattice_Sslip_v, & lattice_maxNslipFamily,& lattice_NslipSystem, & lattice_NnonSchmid @@ -756,9 +753,7 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature real(pReal), dimension(9,9), intent(out) :: dLp_dTstar99 integer(pInt) :: instance,ph,of,ns,f,i,j,k,l,m,n,index_myFamily - real(pReal) :: StressRatio_p,StressRatio_pminus1,BoltzmannRatio,DotGamma0, & - vel_slip,dvel_slip,& - stressRatio + real(pReal), dimension(3,3,2) :: & nonSchmid_tensor real(pReal), dimension(3,3,3,3) :: & @@ -786,12 +781,6 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) j = j+1_pInt - !* Boltzmann ratio - BoltzmannRatio = plastic_disloUCLA_QedgePerSlipSystem(j,instance)/(kB*Temperature) - !* Initial shear rates - DotGamma0 = & - state(instance)%rhoEdge(j,of)*plastic_disloUCLA_burgersPerSlipSystem(j,instance)*& - plastic_disloUCLA_v0PerSlipSystem(j,instance) nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) @@ -832,10 +821,8 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) plasticState, & phaseAt, phasememberAt use lattice, only: & - lattice_Sslip_v, & lattice_maxNslipFamily, & lattice_NslipSystem, & - lattice_NnonSchmid, & lattice_mu implicit none @@ -848,14 +835,10 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) ip, & !< integration point el !< element - integer(pInt) :: instance,ns,f,i,j,k,index_myFamily, & + integer(pInt) :: instance,ns,f,i,j,index_myFamily, & ph, & of real(pReal) :: & - stressRatio_p,& - BoltzmannRatio,& - DotGamma0,& - stressRatio, & EdgeDipMinDistance,& AtomicVolume,& VacancyDiffusion,& @@ -865,9 +848,7 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) DotRhoEdgeEdgeAnnihilation, & ClimbVelocity, & DotRhoEdgeDipClimb, & - DotRhoDipFormation, & - vel_slip, & - gdot_slip + DotRhoDipFormation real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_slip_pos, gdot_slip_neg,& tau_slip_pos,& @@ -890,16 +871,10 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) j = j+1_pInt - !* Boltzmann ratio - BoltzmannRatio = plastic_disloUCLA_QedgePerSlipSystem(j,instance)/(kB*Temperature) - !* Initial shear rates - DotGamma0 = & - state(instance)%rhoEdge(j,of)*plastic_disloUCLA_burgersPerSlipSystem(j,instance)*& - plastic_disloUCLA_v0PerSlipSystem(j,instance) - gdot_slip = (gdot_slip_pos(j)+gdot_slip_neg(j))*0.5_pReal + dotState(instance)%accshear_slip(j,of) = (gdot_slip_pos(j)+gdot_slip_neg(j))*0.5_pReal !* Multiplication - DotRhoMultiplication = abs(gdot_slip)/& + DotRhoMultiplication = abs(dotState(instance)%accshear_slip(j,of))/& (plastic_disloUCLA_burgersPerSlipSystem(j,instance)* & state(instance)%mfp_slip(j,of)) @@ -916,18 +891,18 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) if (EdgeDipDistance Date: Tue, 27 Nov 2018 20:00:45 +0100 Subject: [PATCH 08/47] introducing parameter structure --- src/plastic_disloUCLA.f90 | 72 +++++++++++++++++++++++++++++++++++---- 1 file changed, 66 insertions(+), 6 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index e094fcd87..59480ef1f 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -84,6 +84,26 @@ module plastic_disloUCLA edge_dipole_distance_ID, & stress_exponent_ID end enum + + type, private :: tParameters + real(pReal), allocatable, dimension(:) :: & + nonSchmidCoeff + real(pReal), allocatable, dimension(:,:) :: & + interaction_SlipSlip !< slip resistance from slip activity + real(pReal), allocatable, dimension(:,:,:) :: & + Schmid_slip, & + Schmid_twin, & + nonSchmid_pos, & + nonSchmid_neg + integer(pInt) :: & + totalNslip !< total number of active slip system + integer(pInt), allocatable, dimension(:) :: & + Nslip !< number of active slip systems for each family + integer(kind(undefined_ID)), allocatable, dimension(:) :: & + outputID !< ID of each post result output + end type !< container type for internal constitutive parameters + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & plastic_disloUCLA_outputID !< ID of each post result output @@ -155,7 +175,8 @@ subroutine plastic_disloUCLA_init(fileUnit) plasticState, & material_allocatePlasticState use config, only: & - MATERIAL_partPhase + MATERIAL_partPhase, & + config_phase use lattice implicit none @@ -167,13 +188,18 @@ material_allocatePlasticState Nchunks_SlipSlip = 0_pInt, & Nchunks_SlipFamilies = 0_pInt,Nchunks_nonSchmid = 0_pInt, & offset_slip, index_myFamily, index_otherFamily, & - startIndex, endIndex + startIndex, endIndex, p integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase character(len=65536) :: & + structure = '',& tag = '', & line = '' real(pReal), dimension(:), allocatable :: tempPerSlip + + integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] + real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOUCLA_label//' init -+>>>' write(6,'(/,a)') ' Cereceda et al., International Journal of Plasticity 78, 2016, 242-256' @@ -225,6 +251,43 @@ material_allocatePlasticState allocate(plastic_disloUCLA_nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstance), source=0.0_pReal) + allocate(param(maxNinstance)) + allocate(state(maxNinstance)) + allocate(state0(maxNinstance)) + allocate(dotState(maxNinstance)) + + +do p = 1_pInt, size(phase_plasticityInstance) + if (phase_plasticity(p) /= PLASTICITY_DISLOUCLA_ID) cycle + associate(prm => param(phase_plasticityInstance(p)), & + dot => dotState(phase_plasticityInstance(p)), & + stt => state(phase_plasticityInstance(p))) + + structure = config_phase(p)%getString('lattice_structure') + + +!-------------------------------------------------------------------------------------------------- +! slip related parameters + prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) + prm%totalNslip = sum(prm%Nslip) + slipActive: if (prm%totalNslip > 0_pInt) then + prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& + config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) + if(structure=='bcc') then + prm%nonSchmidCoeff = config_phase(p)%getFloats('nonschmid_coefficients',& + defaultVal = emptyRealArray) + prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt) + prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) + else + prm%nonSchmid_pos = prm%Schmid_slip + prm%nonSchmid_neg = prm%Schmid_slip + endif + prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & + config_phase(p)%getFloats('interaction_slipslip'), & + structure(1:3)) + endif slipActive + end associate + enddo rewind(fileUnit) phase = 0_pInt @@ -442,10 +505,7 @@ material_allocatePlasticState maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstance), & source=0.0_pReal) - - allocate(state(maxNinstance)) - allocate(state0(maxNinstance)) - allocate(dotState(maxNinstance)) + initializeInstances: do phase = 1_pInt, size(phase_plasticity) myPhase2: if (phase_plasticity(phase) == PLASTICITY_disloUCLA_ID) then From 6e22a76a9114800ffafb2d7d855feb5c78830ece Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 28 Nov 2018 05:59:03 +0100 Subject: [PATCH 09/47] parameters from old 22-NewStyle branch --- src/plastic_disloUCLA.f90 | 96 ++++++++++++++++++++++++++++++++++++--- 1 file changed, 90 insertions(+), 6 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 59480ef1f..1218b7b45 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -82,11 +82,36 @@ module plastic_disloUCLA resolved_stress_slip_ID, & threshold_stress_slip_ID, & edge_dipole_distance_ID, & - stress_exponent_ID + stress_exponent_ID, & + rho_ID, & + rhoDip_ID, & + shearrate_ID, & + accumulatedshear_ID, & + mfp_ID, & + resolvedstress_ID, & + thresholdstress_ID, & + dipoledistance_ID, & + stressexponent_ID end enum type, private :: tParameters real(pReal), allocatable, dimension(:) :: & + rho0, & !< initial edge dislocation density per slip system for each family and instance + rhoDip0, & !< initial edge dipole density per slip system for each family and instance + burgers, & !< absolute length of burgers vector [m] for each slip system and instance + H0kp, & !< activation energy for glide [J] for each slip system and instance + v0, & !< dislocation velocity prefactor [m/s] for each family and instance + CLambda, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance + p, & !< p-exponent in glide velocity + q, & !< q-exponent in glide velocity + !* mobility law parameters + kinkheight, & !< height of the kink pair + nu0, & !< attempt frequency for kink pair nucleation + kinkwidth, & !< width of the kink pair + !dislolength, & !< dislocation length (lamda) + viscosity, & !< friction coeff. B (kMC) + !* + tauPeierls, & nonSchmidCoeff real(pReal), allocatable, dimension(:,:) :: & interaction_SlipSlip !< slip resistance from slip activity @@ -184,8 +209,8 @@ material_allocatePlasticState integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,phase,maxTotalNslip,& - f,instance,j,k,o,ns, & - Nchunks_SlipSlip = 0_pInt, & + f,instance,j,k,o,ns, i, & + Nchunks_SlipSlip = 0_pInt, output_ID, outputSize, & Nchunks_SlipFamilies = 0_pInt,Nchunks_nonSchmid = 0_pInt, & offset_slip, index_myFamily, index_otherFamily, & startIndex, endIndex, p @@ -196,7 +221,8 @@ material_allocatePlasticState tag = '', & line = '' real(pReal), dimension(:), allocatable :: tempPerSlip - + character(len=65536), dimension(:), allocatable :: outputs + integer(kind(undefined_ID)) :: outputID integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] @@ -285,7 +311,65 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & config_phase(p)%getFloats('interaction_slipslip'), & structure(1:3)) + !prm%rho0 = config_phase(p)%getFloats('rho0') + !prm%rhoDip0 = config_phase(p)%getFloats('dipole_rho0') + !prm%burgers = config_phase(p)%getFloats('burgers') + !prm%H0kp = config_phase(p)%getFloats('h0') + !prm%v0 = config_phase(p)%getFloats('v0') + !prm%clambda = config_phase(p)%getFloats('clambda') + !prm%tauPeierls = config_phase(p)%getFloats('peierls_stress') + !prm%p = config_phase(p)%getFloats('pexponent',defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) + !prm%q = config_phase(p)%getFloats('qexponent',defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) + !prm%kinkHeight = config_phase(p)%getFloats('kink_height') + !prm%kinkWidth = config_phase(p)%getFloats('kink_width') + !prm%nu0 = config_phase(p)%getFloats('attemptfrequency') + !prm%dislolength = config_phase(p)%getFloats('dislolength') ! what is this used for? + !prm%viscosity = config_phase(p)%getFloats('viscosity') endif slipActive + + +!-------------------------------------------------------------------------------------------------- +! phase outputs + +#if defined(__GFORTRAN__) + outputs = ['GfortranBug86277'] + outputs = config_phase(p)%getStrings('(output)',defaultVal=outputs) + if (outputs(1) == 'GfortranBug86277') outputs = emptyStringArray +#else + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) +#endif + allocate(prm%outputID(0)) + + do i = 1_pInt, size(outputs) + outputID = undefined_ID + outputSize = prm%totalNslip + select case(trim(outputs(i))) + case ('edge_density') + outputID = rho_ID + case ('dipole_density') + output_ID = rhoDip_ID + case ('shear_rate','shearrate') + output_ID = shearrate_ID + case ('accumulated_shear','accumulatedshear') + output_ID = accumulatedshear_ID + case ('mfp') + output_ID = mfp_ID + case ('resolved_stress') + output_ID = resolvedstress_ID + case ('threshold_stress') + output_ID = thresholdstress_ID + case ('edge_dipole_distance') + output_ID = dipoleDistance_ID + case ('stress_exponent') + output_ID = stressexponent_ID + end select + + !if (outputID /= undefined_ID) then + ! plastic_disloUCLA_output(i,instance) = outputs(i) + ! plastic_disloUCLA_sizePostResult(i,instance) = outputSize + ! prm%outputID = [prm%outputID, outputID] + !endif + enddo end associate enddo @@ -515,7 +599,7 @@ do p = 1_pInt, size(phase_plasticityInstance) !-------------------------------------------------------------------------------------------------- ! Determine size of postResults array - outputs: do o = 1_pInt,plastic_disloUCLA_Noutput(instance) + do o = 1_pInt,plastic_disloUCLA_Noutput(instance) select case(plastic_disloUCLA_outputID(o,instance)) case(edge_density_ID, & dipole_density_ID, & @@ -534,7 +618,7 @@ do p = 1_pInt, size(phase_plasticityInstance) plastic_disloUCLA_sizePostResult(o,instance) = mySize plastic_disloUCLA_sizePostResults(instance) = plastic_disloUCLA_sizePostResults(instance) + mySize endif - enddo outputs + enddo !-------------------------------------------------------------------------------------------------- ! allocate state arrays From b923839b1de9fd6b27d07bed5c1bf75e86afd5f8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 28 Nov 2018 06:44:32 +0100 Subject: [PATCH 10/47] no need for conversion 33<->6 --- src/constitutive.f90 | 7 ++--- src/plastic_disloUCLA.f90 | 61 +++++++++++++++++++-------------------- 2 files changed, 33 insertions(+), 35 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index eca8af08a..bb52ab3cc 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -530,9 +530,8 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e call plastic_dislotwin_LpAndItsTangent (Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_DISLOUCLA_ID) plasticityType - call plastic_disloucla_LpAndItsTangent (Lp,dLp_dMp99, math_Mandel33to6(Mp), & + call plastic_disloucla_LpAndItsTangent (Lp,dLp_dMp,Mp, & temperature(ho)%p(tme), ipc,ip,el) - dLp_dMp = math_Plain99to3333(dLp_dMp99) ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget end select plasticityType @@ -927,7 +926,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac call plastic_dislotwin_dotState (Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_DISLOUCLA_ID) plasticityType - call plastic_disloucla_dotState (math_Mandel33to6(Mp),temperature(ho)%p(tme), & + call plastic_disloucla_dotState (Mp,temperature(ho)%p(tme), & ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) plasticityType @@ -1155,7 +1154,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) case (PLASTICITY_DISLOUCLA_ID) plasticityType constitutive_postResults(startPos:endPos) = & - plastic_disloucla_postResults(S6,temperature(ho)%p(tme),ipc,ip,el) + plastic_disloucla_postResults(Mp,temperature(ho)%p(tme),ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) plasticityType constitutive_postResults(startPos:endPos) = & diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 1218b7b45..a4b4b554f 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -870,7 +870,7 @@ end subroutine plastic_disloUCLA_microstructure !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature,ipc,ip,el) +subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,ipc,ip,el) use prec, only: & tol_math_check use math, only: & @@ -892,16 +892,14 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature implicit none 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(in) :: Mp real(pReal), dimension(3,3), intent(out) :: Lp - real(pReal), dimension(9,9), intent(out) :: dLp_dTstar99 + real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp integer(pInt) :: instance,ph,of,ns,f,i,j,k,l,m,n,index_myFamily real(pReal), dimension(3,3,2) :: & nonSchmid_tensor - real(pReal), dimension(3,3,3,3) :: & - dLp_dTstar3333 real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_slip_pos,gdot_slip_neg,tau_slip_pos,tau_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg @@ -912,13 +910,13 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature ns = plastic_disloUCLA_totalNslip(instance) Lp = 0.0_pReal - dLp_dTstar3333 = 0.0_pReal + dLp_dMp = 0.0_pReal !-------------------------------------------------------------------------------------------------- ! Dislocation glide part !* Dislocation density evolution - call kinetics(Tstar_v,Temperature,ipc,ip,el, & + call kinetics(Mp,Temperature,ipc,ip,el, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) j = 0_pInt slipFamilies: do f = 1_pInt,lattice_maxNslipFamily @@ -938,14 +936,13 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,Temperature Lp = Lp + (gdot_slip_pos(j)+gdot_slip_neg(j))*0.5_pReal*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) !* 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_pos(j)*nonSchmid_tensor(m,n,1)+& + dLp_dMp(k,l,m,n) = & + dLp_dMp(k,l,m,n) + (dgdot_dtauslip_pos(j)*nonSchmid_tensor(m,n,1)+& dgdot_dtauslip_neg(j)*nonSchmid_tensor(m,n,2))*0.5_pReal*& lattice_Sslip(k,l,1,index_myFamily+i,ph) enddo slipSystems enddo slipFamilies - dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) end subroutine plastic_disloUCLA_LpAndItsTangent @@ -953,7 +950,7 @@ end subroutine plastic_disloUCLA_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) +subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) use prec, only: & tol_math_check, & dEq0 @@ -970,8 +967,8 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) lattice_mu implicit none - real(pReal), dimension(6), intent(in):: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal), dimension(3,3), intent(in):: & + Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation real(pReal), intent(in) :: & temperature !< temperature at integration point integer(pInt), intent(in) :: & @@ -1008,7 +1005,7 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el) plasticState(ph)%dotState(:,of) = 0.0_pReal !* Dislocation density evolution - call kinetics(Tstar_v,Temperature,ipc,ip,el, & + call kinetics(Mp,Temperature,ipc,ip,el, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) j = 0_pInt slipFamilies: do f = 1_pInt,lattice_maxNslipFamily @@ -1082,26 +1079,27 @@ end subroutine plastic_disloUCLA_dotState !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -function plastic_disloUCLA_postResults(Tstar_v,Temperature,ipc,ip,el) +function plastic_disloUCLA_postResults(Mp,Temperature,ipc,ip,el) use prec, only: & tol_math_check, & dEq, dNeq0 use math, only: & - pi + pi, & +math_mul33xx33 use material, only: & material_phase, & phase_plasticityInstance,& !plasticState, & phaseAt, phasememberAt use lattice, only: & - lattice_Sslip_v, & + lattice_Sslip, & lattice_maxNslipFamily, & lattice_NslipSystem, & lattice_mu implicit none - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal), dimension(3,3), intent(in) :: & + Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation real(pReal), intent(in) :: & temperature !< temperature at integration point integer(pInt), intent(in) :: & @@ -1141,7 +1139,7 @@ function plastic_disloUCLA_postResults(Tstar_v,Temperature,ipc,ip,el) plastic_disloUCLA_postResults(c+1_pInt:c+ns) = state(instance)%rhoEdgeDip(1_pInt:ns,of) c = c + ns case (shear_rate_slip_ID,stress_exponent_ID) - call kinetics(Tstar_v,Temperature,ipc,ip,el, & + call kinetics(Mp,Temperature,ipc,ip,el, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) if (plastic_disloUCLA_outputID(o,instance) == shear_rate_slip_ID) then @@ -1175,7 +1173,7 @@ function plastic_disloUCLA_postResults(Tstar_v,Temperature,ipc,ip,el) slipSystems1: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) j = j + 1_pInt plastic_disloUCLA_postResults(c+j) =& - dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) + math_mul33xx33(Mp,lattice_Sslip(:,:,1,index_myFamily+i,ph)) enddo slipSystems1; enddo slipFamilies1 c = c + ns case (threshold_stress_slip_ID) @@ -1188,10 +1186,10 @@ function plastic_disloUCLA_postResults(Tstar_v,Temperature,ipc,ip,el) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems2: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) j = j + 1_pInt - if (dNeq0(abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph))))) then + if (dNeq0(abs(math_mul33xx33(Mp,lattice_Sslip(:,:,1,index_myFamily+i,ph))))) then plastic_disloUCLA_postResults(c+j) = & (3.0_pReal*lattice_mu(ph)*plastic_disloUCLA_burgersPerSlipSystem(j,instance))/& - (16.0_pReal*pi*abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)))) + (16.0_pReal*pi*abs(math_mul33xx33(Mp,lattice_Sslip(:,:,1,index_myFamily+i,ph)))) else plastic_disloUCLA_postResults(c+j) = huge(1.0_pReal) endif @@ -1207,27 +1205,28 @@ end function plastic_disloUCLA_postResults !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -subroutine kinetics(Tstar_v,Temperature,ipc,ip,el, & +subroutine kinetics(Mp,Temperature,ipc,ip,el, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) use prec, only: & tol_math_check, & dEq, dNeq0 use math, only: & - pi + pi, & +math_mul33xx33 use material, only: & material_phase, & phase_plasticityInstance,& !plasticState, & phaseAt, phasememberAt use lattice, only: & - lattice_Sslip_v, & + lattice_Sslip, & lattice_maxNslipFamily, & lattice_NslipSystem, & lattice_NnonSchmid implicit none - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal), dimension(3,3), intent(in) :: & + Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation real(pReal), intent(in) :: & temperature !< temperature at integration point integer(pInt), intent(in) :: & @@ -1270,14 +1269,14 @@ subroutine kinetics(Tstar_v,Temperature,ipc,ip,el, & state(instance)%rhoEdge(j,of)*plastic_disloUCLA_burgersPerSlipSystem(j,instance)*& plastic_disloUCLA_v0PerSlipSystem(j,instance) !* Resolved shear stress on slip system - tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) + tau_slip_pos(j) = math_mul33xx33(Mp,lattice_Sslip(:,:,1,index_myFamily+i,ph)) tau_slip_neg(j) = tau_slip_pos(j) nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) tau_slip_pos = tau_slip_pos + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) + math_mul33xx33(Mp,lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph)) tau_slip_neg = tau_slip_neg + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + math_mul33xx33(Mp,lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph)) enddo nonSchmidSystems significantPositiveTau: if((abs(tau_slip_pos(j))-state(instance)%threshold_stress_slip(j, of)) > tol_math_check) then From 6af633aa28809e43088d82fa2082923bd60a8f74 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 28 Nov 2018 07:18:50 +0100 Subject: [PATCH 11/47] going towards the new API (ipc,ip,el not of interest) --- src/plastic_disloUCLA.f90 | 22 +++++++--------------- 1 file changed, 7 insertions(+), 15 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index a4b4b554f..08edae241 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -916,7 +916,7 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,ipc,ip,el ! Dislocation glide part !* Dislocation density evolution - call kinetics(Mp,Temperature,ipc,ip,el, & + call kinetics(Mp,Temperature,ph,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) j = 0_pInt slipFamilies: do f = 1_pInt,lattice_maxNslipFamily @@ -1005,7 +1005,7 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) plasticState(ph)%dotState(:,of) = 0.0_pReal !* Dislocation density evolution - call kinetics(Mp,Temperature,ipc,ip,el, & + call kinetics(Mp,Temperature,ph,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) j = 0_pInt slipFamilies: do f = 1_pInt,lattice_maxNslipFamily @@ -1139,7 +1139,7 @@ math_mul33xx33 plastic_disloUCLA_postResults(c+1_pInt:c+ns) = state(instance)%rhoEdgeDip(1_pInt:ns,of) c = c + ns case (shear_rate_slip_ID,stress_exponent_ID) - call kinetics(Mp,Temperature,ipc,ip,el, & + call kinetics(Mp,Temperature,ph,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) if (plastic_disloUCLA_outputID(o,instance) == shear_rate_slip_ID) then @@ -1205,7 +1205,7 @@ end function plastic_disloUCLA_postResults !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -subroutine kinetics(Mp,Temperature,ipc,ip,el, & +subroutine kinetics(Mp,Temperature,ph,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) use prec, only: & tol_math_check, & @@ -1230,26 +1230,18 @@ math_mul33xx33 real(pReal), intent(in) :: & temperature !< temperature at integration point integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element +ph, instance,of integer(pInt) :: & - instance,& ns,& - f,i,j,k,index_myFamily,& - ph, & - of + f,i,j,k,index_myFamily real(pReal) :: StressRatio_p,StressRatio_pminus1,& BoltzmannRatio,DotGamma0,stressRatio,& dvel_slip, vel_slip - real(pReal), intent(out), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), intent(out), dimension(plastic_disloUCLA_totalNslip(instance)) :: & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg !* Shortened notation - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) ns = plastic_disloUCLA_totalNslip(instance) From 5983496c35668334cb5b0001495147035f1c0938 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 28 Nov 2018 16:45:45 +0100 Subject: [PATCH 12/47] get output from config module --- src/plastic_disloUCLA.f90 | 151 ++++++++++---------------------------- 1 file changed, 39 insertions(+), 112 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 08edae241..74373136c 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -74,15 +74,6 @@ module plastic_disloUCLA 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, & rho_ID, & rhoDip_ID, & shearrate_ID, & @@ -210,7 +201,7 @@ material_allocatePlasticState integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,phase,maxTotalNslip,& f,instance,j,k,o,ns, i, & - Nchunks_SlipSlip = 0_pInt, output_ID, outputSize, & + Nchunks_SlipSlip = 0_pInt, outputSize, & Nchunks_SlipFamilies = 0_pInt,Nchunks_nonSchmid = 0_pInt, & offset_slip, index_myFamily, index_otherFamily, & startIndex, endIndex, p @@ -345,34 +336,40 @@ do p = 1_pInt, size(phase_plasticityInstance) outputSize = prm%totalNslip select case(trim(outputs(i))) case ('edge_density') - outputID = rho_ID + outputID = merge(rho_ID,undefined_ID,prm%totalNslip>0_pInt) case ('dipole_density') - output_ID = rhoDip_ID - case ('shear_rate','shearrate') - output_ID = shearrate_ID - case ('accumulated_shear','accumulatedshear') - output_ID = accumulatedshear_ID - case ('mfp') - output_ID = mfp_ID - case ('resolved_stress') - output_ID = resolvedstress_ID - case ('threshold_stress') - output_ID = thresholdstress_ID + outputID = merge(rhoDip_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('shear_rate','shearrate','shear_rate_slip','shearrate_slip') + outputID = merge(shearrate_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('accumulated_shear','accumulatedshear','accumulated_shear_slip') + outputID = merge(accumulatedshear_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('mfp','mfp_slip') + outputID = merge(mfp_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('resolved_stress','resolved_stress_slip') + outputID = merge(resolvedstress_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('threshold_stress','threshold_stress_slip') + outputID = merge(thresholdstress_ID,undefined_ID,prm%totalNslip>0_pInt) case ('edge_dipole_distance') - output_ID = dipoleDistance_ID + outputID = merge(dipoleDistance_ID,undefined_ID,prm%totalNslip>0_pInt) case ('stress_exponent') - output_ID = stressexponent_ID + outputID = merge(stressexponent_ID,undefined_ID,prm%totalNslip>0_pInt) end select - - !if (outputID /= undefined_ID) then - ! plastic_disloUCLA_output(i,instance) = outputs(i) - ! plastic_disloUCLA_sizePostResult(i,instance) = outputSize - ! prm%outputID = [prm%outputID, outputID] - !endif + + if (outputID /= undefined_ID) then + plastic_disloUCLA_output(i,phase_plasticityInstance(p)) = outputs(i) + plastic_disloUCLA_sizePostResult(i,phase_plasticityInstance(p)) = outputSize + prm%outputID = [prm%outputID, outputID] + plastic_disloUCLA_outputID(i,phase_plasticityInstance(p)) = outputID + plastic_disloUCLA_sizePostResults(phase_plasticityInstance(p)) = & + plastic_disloUCLA_sizePostResults(phase_plasticityInstance(p)) + outputSize +plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) + 1_pInt + endif + enddo end associate enddo - + print*, plastic_disloUCLA_sizePostResults + print*, plastic_disloUCLA_output rewind(fileUnit) phase = 0_pInt do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to @@ -402,54 +399,6 @@ do p = 1_pInt, size(phase_plasticityInstance) chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('edge_density') - plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt - plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = edge_density_ID - plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('dipole_density') - plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt - plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = dipole_density_ID - plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shear_rate_slip','shearrate_slip') - plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt - plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = shear_rate_slip_ID - plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('accumulated_shear_slip') - plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt - plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = accumulated_shear_slip_ID - plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('mfp_slip') - plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt - plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = mfp_slip_ID - plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resolved_stress_slip') - plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt - plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = resolved_stress_slip_ID - plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('threshold_stress_slip') - plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt - plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = threshold_stress_slip_ID - plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('edge_dipole_distance') - plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt - plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = edge_dipole_distance_ID - plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('stress_exponent') - plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt - plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = stress_exponent_ID - plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select !-------------------------------------------------------------------------------------------------- ! parameters depending on number of slip system families case ('nslip') @@ -597,28 +546,6 @@ do p = 1_pInt, size(phase_plasticityInstance) instance = phase_plasticityInstance(phase) ns = plastic_disloUCLA_totalNslip(instance) -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - do o = 1_pInt,plastic_disloUCLA_Noutput(instance) - select case(plastic_disloUCLA_outputID(o,instance)) - 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 & - ) - mySize = ns - end select - - if (mySize > 0_pInt) then ! any meaningful output found - plastic_disloUCLA_sizePostResult(o,instance) = mySize - plastic_disloUCLA_sizePostResults(instance) = plastic_disloUCLA_sizePostResults(instance) + mySize - endif - enddo !-------------------------------------------------------------------------------------------------- ! allocate state arrays @@ -632,7 +559,7 @@ do p = 1_pInt, size(phase_plasticityInstance) call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,0_pInt, & ns,0_pInt,0_pInt) -plasticState(phase)%sizePostResults = plastic_disloUCLA_sizePostResults(instance) + plasticState(phase)%sizePostResults = plastic_disloUCLA_sizePostResults(instance) offset_slip = 2_pInt*plasticState(phase)%nSlip plasticState(phase)%slipRate => & @@ -1132,20 +1059,20 @@ math_mul33xx33 do o = 1_pInt,plastic_disloUCLA_Noutput(instance) select case(plastic_disloUCLA_outputID(o,instance)) - case (edge_density_ID) + case (rho_ID) plastic_disloUCLA_postResults(c+1_pInt:c+ns) = state(instance)%rhoEdge(1_pInt:ns,of) c = c + ns - case (dipole_density_ID) + case (rhoDip_ID) plastic_disloUCLA_postResults(c+1_pInt:c+ns) = state(instance)%rhoEdgeDip(1_pInt:ns,of) c = c + ns - case (shear_rate_slip_ID,stress_exponent_ID) + case (shearrate_ID,stressexponent_ID) call kinetics(Mp,Temperature,ph,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) - if (plastic_disloUCLA_outputID(o,instance) == shear_rate_slip_ID) then + if (plastic_disloUCLA_outputID(o,instance) == shearrate_ID) then plastic_disloUCLA_postResults(c+1:c+ns) = (gdot_slip_pos + gdot_slip_neg)*0.5_pReal c = c + ns - elseif(plastic_disloUCLA_outputID(o,instance) == stress_exponent_ID) then + elseif(plastic_disloUCLA_outputID(o,instance) == stressexponent_ID) then do j = 1_pInt, ns if (dEq(gdot_slip_pos(j)+gdot_slip_neg(j),0.0_pReal)) then plastic_disloUCLA_postResults(c+j) = 0.0_pReal @@ -1158,15 +1085,15 @@ math_mul33xx33 c = c + ns endif - case (accumulated_shear_slip_ID) + case (accumulatedshear_ID) plastic_disloUCLA_postResults(c+1_pInt:c+ns) = & state(instance)%accshear_slip(1_pInt:ns, of) c = c + ns - case (mfp_slip_ID) + case (mfp_ID) plastic_disloUCLA_postResults(c+1_pInt:c+ns) =& state(instance)%mfp_slip(1_pInt:ns, of) c = c + ns - case (resolved_stress_slip_ID) + case (resolvedstress_ID) j = 0_pInt slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family @@ -1176,11 +1103,11 @@ math_mul33xx33 math_mul33xx33(Mp,lattice_Sslip(:,:,1,index_myFamily+i,ph)) enddo slipSystems1; enddo slipFamilies1 c = c + ns - case (threshold_stress_slip_ID) + case (thresholdstress_ID) plastic_disloUCLA_postResults(c+1_pInt:c+ns) = & state(instance)%threshold_stress_slip(1_pInt:ns,of) c = c + ns - case (edge_dipole_distance_ID) + case (dipoleDistance_ID) j = 0_pInt slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family From b917ae2cca64d7bbcb3c135905ec80c30551977a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 28 Nov 2018 17:12:06 +0100 Subject: [PATCH 13/47] function to initialize absolute tolerance for state not needed --- src/plastic_disloUCLA.f90 | 53 +++++++++------------------------------ 1 file changed, 12 insertions(+), 41 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 74373136c..f2e32ffcb 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -63,8 +63,7 @@ module plastic_disloUCLA !* mobility law parameters plastic_disloUCLA_kinkheight, & !< height of the kink pair plastic_disloUCLA_omega, & !< attempt frequency for kink pair nucleation - plastic_disloUCLA_kinkwidth, & !< width of the kink pair - plastic_disloUCLA_dislolength, & !< dislocation length (lamda) + plastic_disloUCLA_kinkwidth, & !< width of the kink pair plastic_disloUCLA_friction, & !< friction coeff. B (kMC) !* plastic_disloUCLA_nonSchmidCoeff !< non-Schmid coefficients (bcc) @@ -144,8 +143,8 @@ module plastic_disloUCLA plastic_disloUCLA_dotState, & plastic_disloUCLA_postResults private :: & - plastic_disloUCLA_stateInit, & - plastic_disloUCLA_aTolState + plastic_disloUCLA_stateInit + contains @@ -252,7 +251,6 @@ material_allocatePlasticState allocate(plastic_disloUCLA_kinkheight(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_omega(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_kinkwidth(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_dislolength(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_friction(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_QedgePerSlipFamily(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_v0PerSlipFamily(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) @@ -368,8 +366,7 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp enddo end associate enddo - print*, plastic_disloUCLA_sizePostResults - print*, plastic_disloUCLA_output + rewind(fileUnit) phase = 0_pInt do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to @@ -445,9 +442,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp case ('kink_width') plastic_disloUCLA_kinkwidth(1:Nchunks_SlipFamilies,instance) = & tempPerSlip(1:Nchunks_SlipFamilies) - case ('dislolength') - plastic_disloUCLA_dislolength(1:Nchunks_SlipFamilies,instance) = & - tempPerSlip(1:Nchunks_SlipFamilies) case ('friction_coeff') plastic_disloUCLA_friction(1:Nchunks_SlipFamilies,instance) = & tempPerSlip(1:Nchunks_SlipFamilies) @@ -542,6 +536,7 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp initializeInstances: do phase = 1_pInt, size(phase_plasticity) myPhase2: if (phase_plasticity(phase) == PLASTICITY_disloUCLA_ID) then + p = phase NofMyPhase=count(material_phase==phase) instance = phase_plasticityInstance(phase) ns = plastic_disloUCLA_totalNslip(instance) @@ -610,38 +605,36 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp startIndex=1_pInt endIndex=ns state(instance)%rhoEdge=>plasticState(phase)%state(startIndex:endIndex,:) - state0(instance)%rhoEdge=>plasticState(phase)%state0(startIndex:endIndex,:) - dotState(instance)%rhoEdge=>plasticState(phase)%dotState(startIndex:endIndex,:) + dotState(instance)%rhoEdge=>plasticState(phase)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = plastic_disloUCLA_aTolRho(instance) startIndex=endIndex+1_pInt endIndex=endIndex+ns state(instance)%rhoEdgeDip=>plasticState(phase)%state(startIndex:endIndex,:) - state0(instance)%rhoEdgeDip=>plasticState(phase)%state0(startIndex:endIndex,:) dotState(instance)%rhoEdgeDip=>plasticState(phase)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = plastic_disloUCLA_aTolRho(instance) startIndex=endIndex+1_pInt endIndex=endIndex+ns state(instance)%accshear_slip=>plasticState(phase)%state(startIndex:endIndex,:) - state0(instance)%accshear_slip=>plasticState(phase)%state0(startIndex:endIndex,:) dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = 1e6_pReal startIndex=endIndex+1_pInt endIndex=endIndex+ns state(instance)%invLambdaSlip=>plasticState(phase)%state(startIndex:endIndex,:) - state0(instance)%invLambdaSlip=>plasticState(phase)%state0(startIndex:endIndex,:) startIndex=endIndex+1_pInt endIndex=endIndex+ns state(instance)%mfp_slip=>plasticState(phase)%state(startIndex:endIndex,:) - state0(instance)%mfp_slip=>plasticState(phase)%state0(startIndex:endIndex,:) startIndex=endIndex+1_pInt endIndex=endIndex+ns state(instance)%threshold_stress_slip=>plasticState(phase)%state(startIndex:endIndex,:) - state0(instance)%threshold_stress_slip=>plasticState(phase)%state0(startIndex:endIndex,:) call plastic_disloUCLA_stateInit(phase,instance) - call plastic_disloUCLA_aTolState(phase,instance) + + plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally endif myPhase2 enddo initializeInstances @@ -711,32 +704,10 @@ subroutine plastic_disloUCLA_stateInit(ph,instance) tempState(5_pInt*ns+1:6_pInt*ns) = tauSlipThreshold0 -plasticState(ph)%state0 = spread(tempState,2,size(plasticState(ph)%state(1,:))) +plasticState(ph)%state = spread(tempState,2,size(plasticState(ph)%state(1,:))) end subroutine plastic_disloUCLA_stateInit -!-------------------------------------------------------------------------------------------------- -!> @brief sets the relevant state values for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine plastic_disloUCLA_aTolState(ph,instance) - use material, only: & - plasticState - - implicit none - integer(pInt), intent(in) :: & - ph, & - instance ! number specifying the current instance of the plasticity - - ! Tolerance state for dislocation densities - plasticState(ph)%aTolState(1_pInt:2_pInt*plastic_disloUCLA_totalNslip(instance)) = & - plastic_disloUCLA_aTolRho(instance) - - ! Tolerance state for accumulated shear due to slip - plasticState(ph)%aTolState(2_pInt*plastic_disloUCLA_totalNslip(instance)+1_pInt: & - 3_pInt*plastic_disloUCLA_totalNslip(instance))=1e6_pReal - -end subroutine plastic_disloUCLA_aTolState - !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state From 0649eafdedf68290e82721a2ef8a3bf44a22f970 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 28 Nov 2018 22:22:13 +0100 Subject: [PATCH 14/47] simpler way of Lp calculation --- src/plastic_disloUCLA.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index f2e32ffcb..50e3f37f2 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -806,6 +806,7 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,ipc,ip,el ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) ns = plastic_disloUCLA_totalNslip(instance) + associate(prm => param(instance), stt => state(instance)) Lp = 0.0_pReal dLp_dMp = 0.0_pReal @@ -830,8 +831,7 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,ipc,ip,el lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) enddo nonSchmidSystems - !* Plastic velocity gradient for dislocation glide - Lp = Lp + (gdot_slip_pos(j)+gdot_slip_neg(j))*0.5_pReal*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) + Lp = Lp + (gdot_slip_pos(j)+gdot_slip_neg(j))*prm%Schmid_slip(1:3,1:3,j)*0.5_pReal !* 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_dMp(k,l,m,n) = & @@ -840,7 +840,7 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,ipc,ip,el lattice_Sslip(k,l,1,index_myFamily+i,ph) enddo slipSystems enddo slipFamilies - +end associate end subroutine plastic_disloUCLA_LpAndItsTangent From 5dc696c24e94a8f6edc43d8e1d30d3577bd242b1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 28 Nov 2018 22:38:14 +0100 Subject: [PATCH 15/47] calculating Lp is simple if appropriate data structures are used --- src/plastic_disloUCLA.f90 | 60 +++++++++------------------------------ 1 file changed, 14 insertions(+), 46 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 50e3f37f2..3fd8d5447 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -769,23 +769,10 @@ end subroutine plastic_disloUCLA_microstructure !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,ipc,ip,el) - use prec, only: & - tol_math_check - use math, only: & - math_Plain3333to99, & - math_Mandel6to33, & - math_Mandel33to6, & - math_symmetric33, & - math_mul33x3 use material, only: & material_phase, & phase_plasticityInstance, & phaseAt, phasememberAt - use lattice, only: & - lattice_Sslip, & - lattice_maxNslipFamily,& - lattice_NslipSystem, & - lattice_NnonSchmid implicit none integer(pInt), intent(in) :: ipc,ip,el @@ -794,10 +781,8 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,ipc,ip,el real(pReal), dimension(3,3), intent(out) :: Lp real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp - integer(pInt) :: instance,ph,of,ns,f,i,j,k,l,m,n,index_myFamily + integer(pInt) :: instance,ph,of,i,k,l,m,n - real(pReal), dimension(3,3,2) :: & - nonSchmid_tensor real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_slip_pos,gdot_slip_neg,tau_slip_pos,tau_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg @@ -805,43 +790,25 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,ipc,ip,el of = phasememberAt(ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) - ns = plastic_disloUCLA_totalNslip(instance) associate(prm => param(instance), stt => state(instance)) Lp = 0.0_pReal dLp_dMp = 0.0_pReal -!-------------------------------------------------------------------------------------------------- -! Dislocation glide part - - !* Dislocation density evolution call kinetics(Mp,Temperature,ph,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) - j = 0_pInt - slipFamilies: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) - j = j+1_pInt - nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) - nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) - nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) - nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + plastic_disloUCLA_nonSchmidCoeff(k,instance)*& - lattice_Sslip(1:3,1:3,2*k, index_myFamily+i,ph) - nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + plastic_disloUCLA_nonSchmidCoeff(k,instance)*& - lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) - enddo nonSchmidSystems - - Lp = Lp + (gdot_slip_pos(j)+gdot_slip_neg(j))*prm%Schmid_slip(1:3,1:3,j)*0.5_pReal - !* 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_dMp(k,l,m,n) = & - dLp_dMp(k,l,m,n) + (dgdot_dtauslip_pos(j)*nonSchmid_tensor(m,n,1)+& - dgdot_dtauslip_neg(j)*nonSchmid_tensor(m,n,2))*0.5_pReal*& - lattice_Sslip(k,l,1,index_myFamily+i,ph) - enddo slipSystems - enddo slipFamilies + slipSystems: do i = 1_pInt, prm%totalNslip + Lp = Lp + (gdot_slip_pos(i)+gdot_slip_neg(i))*prm%Schmid_slip(1:3,1:3,i) + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + + dgdot_dtauslip_pos(i) * prm%Schmid_slip(k,l,i) * prm%nonSchmid_pos(m,n,i) & + + dgdot_dtauslip_neg(i) * prm%Schmid_slip(k,l,i) * prm%nonSchmid_neg(m,n,i) + enddo slipSystems end associate - + + Lp = 0.5_pReal * Lp + dLp_dMp = 0.5_pReal * dLp_dMp + end subroutine plastic_disloUCLA_LpAndItsTangent @@ -905,13 +872,14 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) !* Dislocation density evolution call kinetics(Mp,Temperature,ph,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) + dotState(instance)%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)*0.5_pReal + j = 0_pInt slipFamilies: do f = 1_pInt,lattice_maxNslipFamily index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) j = j+1_pInt - dotState(instance)%accshear_slip(j,of) = (gdot_slip_pos(j)+gdot_slip_neg(j))*0.5_pReal !* Multiplication DotRhoMultiplication = abs(dotState(instance)%accshear_slip(j,of))/& (plastic_disloUCLA_burgersPerSlipSystem(j,instance)* & From c0663b9fba214b37e9d9336285bd60f5f1a50cbb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 28 Nov 2018 23:02:46 +0100 Subject: [PATCH 16/47] storing per family makes loops obsolete --- src/plastic_disloUCLA.f90 | 340 ++++++++++++++++---------------------- 1 file changed, 145 insertions(+), 195 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 3fd8d5447..edaba83db 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -42,31 +42,20 @@ module plastic_disloUCLA plastic_disloUCLA_GrainSize, & !< grain size plastic_disloUCLA_CEdgeDipMinDistance, & !< plastic_disloUCLA_SolidSolutionStrength, & !< Strength due to elements in solid solution - plastic_disloUCLA_dipoleFormationFactor, & !< scaling factor for dipole formation: 0: off, 1: on. other values not useful - plastic_disloUCLA_aTolRho !< absolute tolerance for integration of dislocation density + plastic_disloUCLA_dipoleFormationFactor !< scaling factor for dipole formation: 0: off, 1: on. other values not useful real(pReal), dimension(:,:), allocatable, private :: & plastic_disloUCLA_rhoEdge0, & !< initial edge dislocation density per slip system for each family and instance plastic_disloUCLA_rhoEdgeDip0, & !< initial edge dipole density per slip system for each family and instance - plastic_disloUCLA_burgersPerSlipFamily, & !< absolute length of burgers vector [m] for each slip family and instance - plastic_disloUCLA_burgersPerSlipSystem, & !< absolute length of burgers vector [m] for each slip system and instance - plastic_disloUCLA_QedgePerSlipFamily, & !< activation energy for glide [J] for each slip family and instance - plastic_disloUCLA_QedgePerSlipSystem, & !< activation energy for glide [J] for each slip system and instance plastic_disloUCLA_v0PerSlipFamily, & !< dislocation velocity prefactor [m/s] for each family and instance plastic_disloUCLA_v0PerSlipSystem, & !< dislocation velocity prefactor [m/s] for each slip system and instance plastic_disloUCLA_tau_peierlsPerSlipFamily, & !< Peierls stress [Pa] for each family and instance plastic_disloUCLA_CLambdaSlipPerSlipFamily, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance plastic_disloUCLA_CLambdaSlipPerSlipSystem, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance - plastic_disloUCLA_interaction_SlipSlip, & !< coefficients for slip-slip interaction for each interaction type and instance - plastic_disloUCLA_pPerSlipFamily, & !< p-exponent in glide velocity - plastic_disloUCLA_qPerSlipFamily, & !< q-exponent in glide velocity - !* mobility law parameters - plastic_disloUCLA_kinkheight, & !< height of the kink pair - plastic_disloUCLA_omega, & !< attempt frequency for kink pair nucleation - plastic_disloUCLA_kinkwidth, & !< width of the kink pair - plastic_disloUCLA_friction, & !< friction coeff. B (kMC) - !* - plastic_disloUCLA_nonSchmidCoeff !< non-Schmid coefficients (bcc) + plastic_disloUCLA_interaction_SlipSlip, & !< coefficients for slip-slip interaction for each interaction type and instance + !* mobility law parameters + plastic_disloUCLA_friction !< friction coeff. B (kMC) + real(pReal), dimension(:,:,:), allocatable, private :: & plastic_disloUCLA_interactionMatrix_SlipSlip, & !< interaction matrix of the different slip systems for each instance plastic_disloUCLA_forestProjectionEdge !< matrix of forest projections of edge dislocations for each instance @@ -85,6 +74,8 @@ module plastic_disloUCLA end enum type, private :: tParameters + real(pReal) :: & + aTolRho real(pReal), allocatable, dimension(:) :: & rho0, & !< initial edge dislocation density per slip system for each family and instance rhoDip0, & !< initial edge dipole density per slip system for each family and instance @@ -95,10 +86,9 @@ module plastic_disloUCLA p, & !< p-exponent in glide velocity q, & !< q-exponent in glide velocity !* mobility law parameters - kinkheight, & !< height of the kink pair - nu0, & !< attempt frequency for kink pair nucleation - kinkwidth, & !< width of the kink pair - !dislolength, & !< dislocation length (lamda) + kink_height, & !< height of the kink pair + kink_width, & !< width of the kink pair + omega, & !< attempt frequency for kink pair nucleation viscosity, & !< friction coeff. B (kMC) !* tauPeierls, & @@ -166,7 +156,8 @@ subroutine plastic_disloUCLA_init(fileUnit) use math, only: & math_Mandel3333to66, & math_Voigt66to3333, & - math_mul3x3 + math_mul3x3, & + math_expand use IO, only: & IO_read, & IO_lc, & @@ -243,28 +234,19 @@ material_allocatePlasticState allocate(plastic_disloUCLA_GrainSize(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_CEdgeDipMinDistance(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_SolidSolutionStrength(maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_aTolRho(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_dipoleFormationFactor(maxNinstance), source=1.0_pReal) !should be on by default allocate(plastic_disloUCLA_rhoEdge0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_rhoEdgeDip0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_burgersPerSlipFamily(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) - allocate(plastic_disloUCLA_kinkheight(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_omega(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_kinkwidth(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_friction(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_QedgePerSlipFamily(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_v0PerSlipFamily(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_tau_peierlsPerSlipFamily(lattice_maxNslipFamily,maxNinstance), & source=0.0_pReal) - allocate(plastic_disloUCLA_pPerSlipFamily(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_qPerSlipFamily(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_CLambdaSlipPerSlipFamily(lattice_maxNslipFamily,maxNinstance), & source=0.0_pReal) allocate(plastic_disloUCLA_interaction_SlipSlip(lattice_maxNinteraction,maxNinstance),source=0.0_pReal) - allocate(plastic_disloUCLA_nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstance), source=0.0_pReal) allocate(param(maxNinstance)) allocate(state(maxNinstance)) @@ -280,7 +262,7 @@ do p = 1_pInt, size(phase_plasticityInstance) structure = config_phase(p)%getString('lattice_structure') - + prm%aTolRho = config_phase(p)%getFloat('atol_rho') !-------------------------------------------------------------------------------------------------- ! slip related parameters prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) @@ -302,18 +284,27 @@ do p = 1_pInt, size(phase_plasticityInstance) structure(1:3)) !prm%rho0 = config_phase(p)%getFloats('rho0') !prm%rhoDip0 = config_phase(p)%getFloats('dipole_rho0') - !prm%burgers = config_phase(p)%getFloats('burgers') - !prm%H0kp = config_phase(p)%getFloats('h0') + prm%burgers = config_phase(p)%getFloats('slipburgers') + prm%H0kp = config_phase(p)%getFloats('qedge') !prm%v0 = config_phase(p)%getFloats('v0') !prm%clambda = config_phase(p)%getFloats('clambda') !prm%tauPeierls = config_phase(p)%getFloats('peierls_stress') - !prm%p = config_phase(p)%getFloats('pexponent',defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) - !prm%q = config_phase(p)%getFloats('qexponent',defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) - !prm%kinkHeight = config_phase(p)%getFloats('kink_height') - !prm%kinkWidth = config_phase(p)%getFloats('kink_width') - !prm%nu0 = config_phase(p)%getFloats('attemptfrequency') - !prm%dislolength = config_phase(p)%getFloats('dislolength') ! what is this used for? + prm%p = config_phase(p)%getFloats('p_slip',defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) + prm%q = config_phase(p)%getFloats('q_slip',defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) + prm%kink_height = config_phase(p)%getFloats('kink_height') + prm%kink_width = config_phase(p)%getFloats('kink_width') + prm%omega = config_phase(p)%getFloats('omega') !prm%viscosity = config_phase(p)%getFloats('viscosity') + + + ! expand: family => system + prm%q = math_expand(prm%q, prm%Nslip) + prm%p = math_expand(prm%p, prm%Nslip) + prm%H0kp = math_expand(prm%H0kp, prm%Nslip) + prm%burgers = math_expand(prm%burgers, prm%Nslip) + prm%kink_height = math_expand(prm%kink_height, prm%Nslip) + prm%kink_width = math_expand(prm%kink_width, prm%Nslip) + prm%omega = math_expand(prm%omega, prm%Nslip) endif slipActive @@ -417,10 +408,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp plastic_disloUCLA_rhoEdge0(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) case ('rhoedgedip0') plastic_disloUCLA_rhoEdgeDip0(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('slipburgers') - plastic_disloUCLA_burgersPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('qedge') - plastic_disloUCLA_QedgePerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) case ('v0') plastic_disloUCLA_v0PerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) case ('clambdaslip') @@ -429,19 +416,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp if (lattice_structure(phase) /= LATTICE_bcc_ID) & call IO_warning(42_pInt,ext_msg=trim(tag)//' for non-bcc ('//PLASTICITY_DISLOUCLA_label//')') plastic_disloUCLA_tau_peierlsPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('p_slip') - plastic_disloUCLA_pPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('q_slip') - plastic_disloUCLA_qPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('kink_height') - plastic_disloUCLA_kinkheight(1:Nchunks_SlipFamilies,instance) = & - tempPerSlip(1:Nchunks_SlipFamilies) - case ('omega') - plastic_disloUCLA_omega(1:Nchunks_SlipFamilies,instance) = & - tempPerSlip(1:Nchunks_SlipFamilies) - case ('kink_width') - plastic_disloUCLA_kinkwidth(1:Nchunks_SlipFamilies,instance) = & - tempPerSlip(1:Nchunks_SlipFamilies) case ('friction_coeff') plastic_disloUCLA_friction(1:Nchunks_SlipFamilies,instance) = & tempPerSlip(1:Nchunks_SlipFamilies) @@ -455,12 +429,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp do j = 1_pInt, Nchunks_SlipSlip plastic_disloUCLA_interaction_SlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo - case ('nonschmid_coefficients') - if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') - do j = 1_pInt,Nchunks_nonSchmid - plastic_disloUCLA_nonSchmidCoeff(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo !-------------------------------------------------------------------------------------------------- ! parameters independent of number of slip systems case ('grainsize') @@ -469,8 +437,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp plastic_disloUCLA_D0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('qsd') plastic_disloUCLA_Qsd(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_rho') - plastic_disloUCLA_aTolRho(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('solidsolutionstrength') plastic_disloUCLA_SolidSolutionStrength(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cedgedipmindistance') @@ -494,8 +460,8 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp call IO_error(211_pInt,el=instance,ext_msg='rhoEdge0 ('//PLASTICITY_DISLOUCLA_label//')') if (plastic_disloUCLA_rhoEdgeDip0(f,instance) < 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='rhoEdgeDip0 ('//PLASTICITY_DISLOUCLA_label//')') - if (plastic_disloUCLA_burgersPerSlipFamily(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='slipBurgers ('//PLASTICITY_DISLOUCLA_label//')') + !if (plastic_disloUCLA_burgersPerSlipFamily(f,instance) <= 0.0_pReal) & + ! call IO_error(211_pInt,el=instance,ext_msg='slipBurgers ('//PLASTICITY_DISLOUCLA_label//')') if (plastic_disloUCLA_v0PerSlipFamily(f,instance) <= 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='v0 ('//PLASTICITY_DISLOUCLA_label//')') if (plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance) < 0.0_pReal) & @@ -522,8 +488,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp ! allocation of variables whose size depends on the total number of active slip systems maxTotalNslip = maxval(plastic_disloUCLA_totalNslip) - allocate(plastic_disloUCLA_burgersPerSlipSystem(maxTotalNslip, maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_QedgePerSlipSystem(maxTotalNslip, maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_v0PerSlipSystem(maxTotalNslip, maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_CLambdaSlipPerSlipSystem(maxTotalNslip, maxNinstance),source=0.0_pReal) @@ -541,7 +505,7 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp instance = phase_plasticityInstance(phase) ns = plastic_disloUCLA_totalNslip(instance) - + associate(prm => param(instance), stt=>state(instance)) !-------------------------------------------------------------------------------------------------- ! allocate state arrays @@ -567,16 +531,7 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp index_myFamily = sum(plastic_disloUCLA_Nslip(1:f-1_pInt,instance)) ! index in truncated slip system list mySlipSystems: do j = 1_pInt,plastic_disloUCLA_Nslip(f,instance) - !* Burgers vector, - ! dislocation velocity prefactor, - ! mean free path prefactor, - ! and minimum dipole distance - - plastic_disloUCLA_burgersPerSlipSystem(index_myFamily+j,instance) = & - plastic_disloUCLA_burgersPerSlipFamily(f,instance) - - plastic_disloUCLA_QedgePerSlipSystem(index_myFamily+j,instance) = & - plastic_disloUCLA_QedgePerSlipFamily(f,instance) + plastic_disloUCLA_v0PerSlipSystem(index_myFamily+j,instance) = & plastic_disloUCLA_v0PerSlipFamily(f,instance) @@ -606,13 +561,13 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp endIndex=ns state(instance)%rhoEdge=>plasticState(phase)%state(startIndex:endIndex,:) dotState(instance)%rhoEdge=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = plastic_disloUCLA_aTolRho(instance) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho startIndex=endIndex+1_pInt endIndex=endIndex+ns state(instance)%rhoEdgeDip=>plasticState(phase)%state(startIndex:endIndex,:) dotState(instance)%rhoEdgeDip=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = plastic_disloUCLA_aTolRho(instance) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho startIndex=endIndex+1_pInt endIndex=endIndex+ns @@ -635,8 +590,9 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp call plastic_disloUCLA_stateInit(phase,instance) plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally + end associate endif myPhase2 - + enddo initializeInstances end subroutine plastic_disloUCLA_init @@ -669,7 +625,7 @@ subroutine plastic_disloUCLA_stateInit(ph,instance) tauSlipThreshold0 tempState = 0.0_pReal ns = plastic_disloUCLA_totalNslip(instance) - + associate(prm => param(instance), stt => state(instance)) !-------------------------------------------------------------------------------------------------- ! initialize basic slip state variables do f = 1_pInt,lattice_maxNslipFamily @@ -699,13 +655,13 @@ subroutine plastic_disloUCLA_stateInit(ph,instance) forall (i = 1_pInt:ns) & tauSlipThreshold0(i) = & - lattice_mu(ph)*plastic_disloUCLA_burgersPerSlipSystem(i,instance) * & + lattice_mu(ph)*prm%burgers(i) * & sqrt(dot_product((rhoEdge0+rhoEdgeDip0),plastic_disloUCLA_interactionMatrix_SlipSlip(i,1:ns,instance))) tempState(5_pInt*ns+1:6_pInt*ns) = tauSlipThreshold0 plasticState(ph)%state = spread(tempState,2,size(plasticState(ph)%state(1,:))) - +end associate end subroutine plastic_disloUCLA_stateInit @@ -740,7 +696,7 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) ns = plastic_disloUCLA_totalNslip(instance) - + associate(prm => param(instance), stt => state(instance)) !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation forall (s = 1_pInt:ns) & state(instance)%invLambdaSlip(s,of) = & @@ -758,10 +714,10 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) !* threshold stress for dislocation motion forall (s = 1_pInt:ns) & state(instance)%threshold_stress_slip(s,of) = & - lattice_mu(ph)*plastic_disloUCLA_burgersPerSlipSystem(s,instance)*& + lattice_mu(ph)*prm%burgers(s)*& sqrt(dot_product((state(instance)%rhoEdge(1_pInt:ns,of)+state(instance)%rhoEdgeDip(1_pInt:ns,of)),& plastic_disloUCLA_interactionMatrix_SlipSlip(s,1:ns,instance))) - + end associate end subroutine plastic_disloUCLA_microstructure @@ -868,7 +824,7 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) ns = plastic_disloUCLA_totalNslip(instance) plasticState(ph)%dotState(:,of) = 0.0_pReal - + associate(prm => param(instance), stt => state(instance)) !* Dislocation density evolution call kinetics(Mp,Temperature,ph,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) @@ -882,38 +838,38 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) !* Multiplication DotRhoMultiplication = abs(dotState(instance)%accshear_slip(j,of))/& - (plastic_disloUCLA_burgersPerSlipSystem(j,instance)* & + (prm%burgers(j)* & state(instance)%mfp_slip(j,of)) !* Dipole formation EdgeDipMinDistance = & - plastic_disloUCLA_CEdgeDipMinDistance(instance)*plastic_disloUCLA_burgersPerSlipSystem(j,instance) + plastic_disloUCLA_CEdgeDipMinDistance(instance)*prm%burgers(j) if (dEq0(tau_slip_pos(j))) then DotRhoDipFormation = 0.0_pReal else EdgeDipDistance = & - (3.0_pReal*lattice_mu(ph)*plastic_disloUCLA_burgersPerSlipSystem(j,instance))/& + (3.0_pReal*lattice_mu(ph)*prm%burgers(j))/& (16.0_pReal*pi*abs(tau_slip_pos(j))) if (EdgeDipDistance>state(instance)%mfp_slip(j,of)) EdgeDipDistance=state(instance)%mfp_slip(j,of) if (EdgeDipDistance @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -function plastic_disloUCLA_postResults(Mp,Temperature,ipc,ip,el) +function plastic_disloUCLA_postResults(Mp,Temperature,ipc,ip,el) result(postResults) use prec, only: & tol_math_check, & dEq, dNeq0 @@ -974,7 +930,7 @@ math_mul33xx33 el !< element real(pReal), dimension(plastic_disloUCLA_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - plastic_disloUCLA_postResults + postResults integer(pInt) :: & instance,& @@ -993,30 +949,30 @@ math_mul33xx33 !* Required output c = 0_pInt - plastic_disloUCLA_postResults = 0.0_pReal - + postResults = 0.0_pReal + associate (prm => param(instance)) do o = 1_pInt,plastic_disloUCLA_Noutput(instance) select case(plastic_disloUCLA_outputID(o,instance)) case (rho_ID) - plastic_disloUCLA_postResults(c+1_pInt:c+ns) = state(instance)%rhoEdge(1_pInt:ns,of) + postResults(c+1_pInt:c+ns) = state(instance)%rhoEdge(1_pInt:ns,of) c = c + ns case (rhoDip_ID) - plastic_disloUCLA_postResults(c+1_pInt:c+ns) = state(instance)%rhoEdgeDip(1_pInt:ns,of) + postResults(c+1_pInt:c+ns) = state(instance)%rhoEdgeDip(1_pInt:ns,of) c = c + ns case (shearrate_ID,stressexponent_ID) call kinetics(Mp,Temperature,ph,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) if (plastic_disloUCLA_outputID(o,instance) == shearrate_ID) then - plastic_disloUCLA_postResults(c+1:c+ns) = (gdot_slip_pos + gdot_slip_neg)*0.5_pReal + postResults(c+1:c+ns) = (gdot_slip_pos + gdot_slip_neg)*0.5_pReal c = c + ns elseif(plastic_disloUCLA_outputID(o,instance) == stressexponent_ID) then do j = 1_pInt, ns if (dEq(gdot_slip_pos(j)+gdot_slip_neg(j),0.0_pReal)) then - plastic_disloUCLA_postResults(c+j) = 0.0_pReal + postResults(c+j) = 0.0_pReal else - plastic_disloUCLA_postResults(c+j) = (tau_slip_pos(j)+tau_slip_neg(j))/& + postResults(c+j) = (tau_slip_pos(j)+tau_slip_neg(j))/& (gdot_slip_pos(j)+gdot_slip_neg(j))*& (dgdot_dtauslip_pos(j)+dgdot_dtauslip_neg(j))* 0.5_pReal endif @@ -1025,11 +981,11 @@ math_mul33xx33 endif case (accumulatedshear_ID) - plastic_disloUCLA_postResults(c+1_pInt:c+ns) = & + postResults(c+1_pInt:c+ns) = & state(instance)%accshear_slip(1_pInt:ns, of) c = c + ns case (mfp_ID) - plastic_disloUCLA_postResults(c+1_pInt:c+ns) =& + postResults(c+1_pInt:c+ns) =& state(instance)%mfp_slip(1_pInt:ns, of) c = c + ns case (resolvedstress_ID) @@ -1038,12 +994,12 @@ math_mul33xx33 index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems1: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) j = j + 1_pInt - plastic_disloUCLA_postResults(c+j) =& + postResults(c+j) =& math_mul33xx33(Mp,lattice_Sslip(:,:,1,index_myFamily+i,ph)) enddo slipSystems1; enddo slipFamilies1 c = c + ns case (thresholdstress_ID) - plastic_disloUCLA_postResults(c+1_pInt:c+ns) = & + postResults(c+1_pInt:c+ns) = & state(instance)%threshold_stress_slip(1_pInt:ns,of) c = c + ns case (dipoleDistance_ID) @@ -1053,18 +1009,19 @@ math_mul33xx33 slipSystems2: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) j = j + 1_pInt if (dNeq0(abs(math_mul33xx33(Mp,lattice_Sslip(:,:,1,index_myFamily+i,ph))))) then - plastic_disloUCLA_postResults(c+j) = & - (3.0_pReal*lattice_mu(ph)*plastic_disloUCLA_burgersPerSlipSystem(j,instance))/& + postResults(c+j) = & + (3.0_pReal*lattice_mu(ph)*prm%burgers(j))/& (16.0_pReal*pi*abs(math_mul33xx33(Mp,lattice_Sslip(:,:,1,index_myFamily+i,ph)))) else - plastic_disloUCLA_postResults(c+j) = huge(1.0_pReal) + postResults(c+j) = huge(1.0_pReal) endif - plastic_disloUCLA_postResults(c+j)=min(plastic_disloUCLA_postResults(c+j),& + postResults(c+j)=min(postResults(c+j),& state(instance)%mfp_slip(j,of)) enddo slipSystems2; enddo slipFamilies2 c = c + ns end select enddo +end associate end function plastic_disloUCLA_postResults @@ -1106,7 +1063,7 @@ ph, instance,of dvel_slip, vel_slip real(pReal), intent(out), dimension(plastic_disloUCLA_totalNslip(instance)) :: & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg - + associate(prm => param(instance), stt => state(instance)) !* Shortened notation ns = plastic_disloUCLA_totalNslip(instance) @@ -1121,40 +1078,33 @@ ph, instance,of slipSystems: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) j = j + 1_pInt !* Boltzmann ratio - BoltzmannRatio = plastic_disloUCLA_QedgePerSlipSystem(j,instance)/(kB*Temperature) + BoltzmannRatio = prm%H0kp(j)/(kB*Temperature) !* Initial shear rates DotGamma0 = & - state(instance)%rhoEdge(j,of)*plastic_disloUCLA_burgersPerSlipSystem(j,instance)*& + state(instance)%rhoEdge(j,of)*prm%burgers(j)*& plastic_disloUCLA_v0PerSlipSystem(j,instance) !* Resolved shear stress on slip system - tau_slip_pos(j) = math_mul33xx33(Mp,lattice_Sslip(:,:,1,index_myFamily+i,ph)) - tau_slip_neg(j) = tau_slip_pos(j) - - nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & - math_mul33xx33(Mp,lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_disloUCLA_nonSchmidCoeff(k,instance)* & - math_mul33xx33(Mp,lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph)) - enddo nonSchmidSystems + tau_slip_pos(j) = math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)) + tau_slip_neg(j) = math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j)) significantPositiveTau: if((abs(tau_slip_pos(j))-state(instance)%threshold_stress_slip(j, of)) > tol_math_check) then !* Stress ratio stressRatio = ((abs(tau_slip_pos(j))-state(instance)%threshold_stress_slip(j, of))/& (plastic_disloUCLA_SolidSolutionStrength(instance)+& plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) - stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) - stressRatio_pminus1 = stressRatio**(plastic_disloUCLA_pPerSlipFamily(f,instance)-1.0_pReal) + stressRatio_p = stressRatio** prm%p(j) + stressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal) !* Shear rates due to slip - vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & - * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & - * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & + vel_slip = 2.0_pReal*prm%burgers(j) & + * prm%kink_height(j) * prm%omega(j) & + * ( state(instance)%mfp_slip(j,of) - prm%kink_width(j) ) & * (tau_slip_pos(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & / ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos(j) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) gdot_slip_pos(j) = DotGamma0 & @@ -1163,41 +1113,41 @@ ph, instance,of !* Derivatives of shear rates dvel_slip = & - 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & - * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & - * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & + 2.0_pReal*prm%burgers(j) & + * prm%kink_height(j) * prm%omega(j) & + * ( state(instance)%mfp_slip(j,of) - prm%kink_width(j) ) & * ( & - (exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + tau_slip_pos(j) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) - *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& - *plastic_disloUCLA_qPerSlipFamily(f,instance)/& + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) + *BoltzmannRatio*prm%p(j)& + *prm%q(j)/& (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& - StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) ) &!deltaf(f) + StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) &!deltaf(f) ) & - * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos(j) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) & - (tau_slip_pos(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & - * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) - *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& - *plastic_disloUCLA_qPerSlipFamily(f,instance)/& + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & + * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & + + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) + *BoltzmannRatio*prm%p(j)& + *prm%q(j)/& (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& - StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) )& !deltaf(f) + StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& !deltaf(f) ) & ) & / ( & ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_pos(j) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & )**2.0_pReal & ) @@ -1209,19 +1159,19 @@ ph, instance,of stressRatio = ((abs(tau_slip_neg(j))-state(instance)%threshold_stress_slip(j, of))/& (plastic_disloUCLA_SolidSolutionStrength(instance)+& plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) - stressRatio_p = stressRatio** plastic_disloUCLA_pPerSlipFamily(f,instance) - stressRatio_pminus1 = stressRatio**(plastic_disloUCLA_pPerSlipFamily(f,instance)-1.0_pReal) + stressRatio_p = stressRatio** prm%p(j) + stressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal) !* Shear rates due to slip - vel_slip = 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & - * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & - * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & + vel_slip = 2.0_pReal*prm%burgers(j) & + * prm%kink_height(j) * prm%omega(j) & + * ( state(instance)%mfp_slip(j,of) - prm%kink_width(j) ) & * (tau_slip_neg(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & / ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg(j) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) gdot_slip_neg(j) = DotGamma0 & @@ -1229,41 +1179,41 @@ ph, instance,of * sign(1.0_pReal,tau_slip_neg(j)) !* Derivatives of shear rates dvel_slip = & - 2.0_pReal*plastic_disloUCLA_burgersPerSlipFamily(f,instance) & - * plastic_disloUCLA_kinkheight(f,instance) * plastic_disloUCLA_omega(f,instance) & - * ( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) ) & + 2.0_pReal*prm%burgers(j) & + * prm%kink_height(j) * prm%omega(j) & + * ( state(instance)%mfp_slip(j,of) - prm%kink_width(j) ) & * ( & - (exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + tau_slip_neg(j) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) - *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& - *plastic_disloUCLA_qPerSlipFamily(f,instance)/& + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) + *BoltzmannRatio*prm%p(j)& + *prm%q(j)/& (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& - StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) ) &!deltaf(f) + StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) &!deltaf(f) ) & - * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg(j) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) & - (tau_slip_neg(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) ) & - * (2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)))& !deltaf(i) - *BoltzmannRatio*plastic_disloUCLA_pPerSlipFamily(f,instance)& - *plastic_disloUCLA_qPerSlipFamily(f,instance)/& + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & + * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & + + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) + *BoltzmannRatio*prm%p(j)& + *prm%q(j)/& (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& - StressRatio_pminus1*(1-StressRatio_p)**(plastic_disloUCLA_qPerSlipFamily(f,instance)-1.0_pReal) )& !deltaf(f) + StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& !deltaf(f) ) & ) & / ( & ( & - 2.0_pReal*(plastic_disloUCLA_burgersPerSlipFamily(f,instance)**2.0_pReal)*tau_slip_neg(j) & - + plastic_disloUCLA_omega(f,instance) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - plastic_disloUCLA_kinkwidth(f,instance) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** plastic_disloUCLA_qPerSlipFamily(f,instance)) & + 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & )**2.0_pReal & ) @@ -1273,7 +1223,7 @@ ph, instance,of endif significantNegativeTau enddo slipSystems enddo slipFamilies - + end associate end subroutine kinetics end module plastic_disloUCLA From 9aec5f6db0f14868f8fd17b191a79b86e45203ee Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 29 Nov 2018 07:27:35 +0100 Subject: [PATCH 17/47] shorter notation --- src/plastic_disloUCLA.f90 | 88 +++++++++++++++++++-------------------- 1 file changed, 44 insertions(+), 44 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index edaba83db..28feb94a7 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -559,33 +559,33 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp startIndex=1_pInt endIndex=ns - state(instance)%rhoEdge=>plasticState(phase)%state(startIndex:endIndex,:) + stt%rhoEdge=>plasticState(phase)%state(startIndex:endIndex,:) dotState(instance)%rhoEdge=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho startIndex=endIndex+1_pInt endIndex=endIndex+ns - state(instance)%rhoEdgeDip=>plasticState(phase)%state(startIndex:endIndex,:) + stt%rhoEdgeDip=>plasticState(phase)%state(startIndex:endIndex,:) dotState(instance)%rhoEdgeDip=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho startIndex=endIndex+1_pInt endIndex=endIndex+ns - state(instance)%accshear_slip=>plasticState(phase)%state(startIndex:endIndex,:) + stt%accshear_slip=>plasticState(phase)%state(startIndex:endIndex,:) dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = 1e6_pReal startIndex=endIndex+1_pInt endIndex=endIndex+ns - state(instance)%invLambdaSlip=>plasticState(phase)%state(startIndex:endIndex,:) + stt%invLambdaSlip=>plasticState(phase)%state(startIndex:endIndex,:) startIndex=endIndex+1_pInt endIndex=endIndex+ns - state(instance)%mfp_slip=>plasticState(phase)%state(startIndex:endIndex,:) + stt%mfp_slip=>plasticState(phase)%state(startIndex:endIndex,:) startIndex=endIndex+1_pInt endIndex=endIndex+ns - state(instance)%threshold_stress_slip=>plasticState(phase)%state(startIndex:endIndex,:) + stt%threshold_stress_slip=>plasticState(phase)%state(startIndex:endIndex,:) call plastic_disloUCLA_stateInit(phase,instance) @@ -625,7 +625,7 @@ subroutine plastic_disloUCLA_stateInit(ph,instance) tauSlipThreshold0 tempState = 0.0_pReal ns = plastic_disloUCLA_totalNslip(instance) - associate(prm => param(instance), stt => state(instance)) + associate(prm => param(instance)) !-------------------------------------------------------------------------------------------------- ! initialize basic slip state variables do f = 1_pInt,lattice_maxNslipFamily @@ -699,23 +699,23 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) associate(prm => param(instance), stt => state(instance)) !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation forall (s = 1_pInt:ns) & - state(instance)%invLambdaSlip(s,of) = & - sqrt(dot_product((state(instance)%rhoEdge(1_pInt:ns,of)+state(instance)%rhoEdgeDip(1_pInt:ns,of)),& + stt%invLambdaSlip(s,of) = & + sqrt(dot_product((stt%rhoEdge(1_pInt:ns,of)+stt%rhoEdgeDip(1_pInt:ns,of)),& plastic_disloUCLA_forestProjectionEdge(1:ns,s,instance)))/ & plastic_disloUCLA_CLambdaSlipPerSlipSystem(s,instance) !* mean free path between 2 obstacles seen by a moving dislocation do s = 1_pInt,ns - state(instance)%mfp_slip(s,of) = & + stt%mfp_slip(s,of) = & plastic_disloUCLA_GrainSize(instance)/& - (1.0_pReal+plastic_disloUCLA_GrainSize(instance)*(state(instance)%invLambdaSlip(s,of))) + (1.0_pReal+plastic_disloUCLA_GrainSize(instance)*(stt%invLambdaSlip(s,of))) enddo !* threshold stress for dislocation motion forall (s = 1_pInt:ns) & - state(instance)%threshold_stress_slip(s,of) = & + stt%threshold_stress_slip(s,of) = & lattice_mu(ph)*prm%burgers(s)*& - sqrt(dot_product((state(instance)%rhoEdge(1_pInt:ns,of)+state(instance)%rhoEdgeDip(1_pInt:ns,of)),& + sqrt(dot_product((stt%rhoEdge(1_pInt:ns,of)+stt%rhoEdgeDip(1_pInt:ns,of)),& plastic_disloUCLA_interactionMatrix_SlipSlip(s,1:ns,instance))) end associate end subroutine plastic_disloUCLA_microstructure @@ -746,7 +746,7 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,ipc,ip,el of = phasememberAt(ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) - associate(prm => param(instance), stt => state(instance)) + associate(prm => param(instance)) Lp = 0.0_pReal dLp_dMp = 0.0_pReal @@ -839,7 +839,7 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) !* Multiplication DotRhoMultiplication = abs(dotState(instance)%accshear_slip(j,of))/& (prm%burgers(j)* & - state(instance)%mfp_slip(j,of)) + stt%mfp_slip(j,of)) !* Dipole formation EdgeDipMinDistance = & @@ -850,22 +850,22 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) EdgeDipDistance = & (3.0_pReal*lattice_mu(ph)*prm%burgers(j))/& (16.0_pReal*pi*abs(tau_slip_pos(j))) - if (EdgeDipDistance>state(instance)%mfp_slip(j,of)) EdgeDipDistance=state(instance)%mfp_slip(j,of) + if (EdgeDipDistance>stt%mfp_slip(j,of)) EdgeDipDistance=stt%mfp_slip(j,of) if (EdgeDipDistance param(instance)) + associate (prm => param(instance),stt =>state(instance)) do o = 1_pInt,plastic_disloUCLA_Noutput(instance) select case(plastic_disloUCLA_outputID(o,instance)) case (rho_ID) - postResults(c+1_pInt:c+ns) = state(instance)%rhoEdge(1_pInt:ns,of) + postResults(c+1_pInt:c+ns) = stt%rhoEdge(1_pInt:ns,of) c = c + ns case (rhoDip_ID) - postResults(c+1_pInt:c+ns) = state(instance)%rhoEdgeDip(1_pInt:ns,of) + postResults(c+1_pInt:c+ns) = stt%rhoEdgeDip(1_pInt:ns,of) c = c + ns case (shearrate_ID,stressexponent_ID) call kinetics(Mp,Temperature,ph,instance,of, & @@ -982,11 +982,11 @@ math_mul33xx33 case (accumulatedshear_ID) postResults(c+1_pInt:c+ns) = & - state(instance)%accshear_slip(1_pInt:ns, of) + stt%accshear_slip(1_pInt:ns, of) c = c + ns case (mfp_ID) postResults(c+1_pInt:c+ns) =& - state(instance)%mfp_slip(1_pInt:ns, of) + stt%mfp_slip(1_pInt:ns, of) c = c + ns case (resolvedstress_ID) j = 0_pInt @@ -1000,7 +1000,7 @@ math_mul33xx33 c = c + ns case (thresholdstress_ID) postResults(c+1_pInt:c+ns) = & - state(instance)%threshold_stress_slip(1_pInt:ns,of) + stt%threshold_stress_slip(1_pInt:ns,of) c = c + ns case (dipoleDistance_ID) j = 0_pInt @@ -1016,7 +1016,7 @@ math_mul33xx33 postResults(c+j) = huge(1.0_pReal) endif postResults(c+j)=min(postResults(c+j),& - state(instance)%mfp_slip(j,of)) + stt%mfp_slip(j,of)) enddo slipSystems2; enddo slipFamilies2 c = c + ns end select @@ -1081,15 +1081,15 @@ ph, instance,of BoltzmannRatio = prm%H0kp(j)/(kB*Temperature) !* Initial shear rates DotGamma0 = & - state(instance)%rhoEdge(j,of)*prm%burgers(j)*& + stt%rhoEdge(j,of)*prm%burgers(j)*& plastic_disloUCLA_v0PerSlipSystem(j,instance) !* Resolved shear stress on slip system tau_slip_pos(j) = math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)) tau_slip_neg(j) = math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j)) - significantPositiveTau: if((abs(tau_slip_pos(j))-state(instance)%threshold_stress_slip(j, of)) > tol_math_check) then + significantPositiveTau: if((abs(tau_slip_pos(j))-stt%threshold_stress_slip(j, of)) > tol_math_check) then !* Stress ratio - stressRatio = ((abs(tau_slip_pos(j))-state(instance)%threshold_stress_slip(j, of))/& + stressRatio = ((abs(tau_slip_pos(j))-stt%threshold_stress_slip(j, of))/& (plastic_disloUCLA_SolidSolutionStrength(instance)+& plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) stressRatio_p = stressRatio** prm%p(j) @@ -1097,13 +1097,13 @@ ph, instance,of !* Shear rates due to slip vel_slip = 2.0_pReal*prm%burgers(j) & * prm%kink_height(j) * prm%omega(j) & - * ( state(instance)%mfp_slip(j,of) - prm%kink_width(j) ) & + * ( stt%mfp_slip(j,of) - prm%kink_width(j) ) & * (tau_slip_pos(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & / ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) @@ -1115,7 +1115,7 @@ ph, instance,of dvel_slip = & 2.0_pReal*prm%burgers(j) & * prm%kink_height(j) * prm%omega(j) & - * ( state(instance)%mfp_slip(j,of) - prm%kink_width(j) ) & + * ( stt%mfp_slip(j,of) - prm%kink_width(j) ) & * ( & (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + tau_slip_pos(j) & @@ -1127,14 +1127,14 @@ ph, instance,of ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) & - (tau_slip_pos(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) *BoltzmannRatio*prm%p(j)& *prm%q(j)/& @@ -1146,7 +1146,7 @@ ph, instance,of ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & )**2.0_pReal & ) @@ -1154,9 +1154,9 @@ ph, instance,of dgdot_dtauslip_pos(j) = DotGamma0 * dvel_slip endif significantPositiveTau - significantNegativeTau: if((abs(tau_slip_neg(j))-state(instance)%threshold_stress_slip(j, of)) > tol_math_check) then + significantNegativeTau: if((abs(tau_slip_neg(j))-stt%threshold_stress_slip(j, of)) > tol_math_check) then !* Stress ratios - stressRatio = ((abs(tau_slip_neg(j))-state(instance)%threshold_stress_slip(j, of))/& + stressRatio = ((abs(tau_slip_neg(j))-stt%threshold_stress_slip(j, of))/& (plastic_disloUCLA_SolidSolutionStrength(instance)+& plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) stressRatio_p = stressRatio** prm%p(j) @@ -1164,13 +1164,13 @@ ph, instance,of !* Shear rates due to slip vel_slip = 2.0_pReal*prm%burgers(j) & * prm%kink_height(j) * prm%omega(j) & - * ( state(instance)%mfp_slip(j,of) - prm%kink_width(j) ) & + * ( stt%mfp_slip(j,of) - prm%kink_width(j) ) & * (tau_slip_neg(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & / ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) @@ -1181,7 +1181,7 @@ ph, instance,of dvel_slip = & 2.0_pReal*prm%burgers(j) & * prm%kink_height(j) * prm%omega(j) & - * ( state(instance)%mfp_slip(j,of) - prm%kink_width(j) ) & + * ( stt%mfp_slip(j,of) - prm%kink_width(j) ) & * ( & (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + tau_slip_neg(j) & @@ -1193,14 +1193,14 @@ ph, instance,of ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) & - (tau_slip_neg(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) *BoltzmannRatio*prm%p(j)& *prm%q(j)/& @@ -1212,7 +1212,7 @@ ph, instance,of ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( state(instance)%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & )**2.0_pReal & ) From 228ef831f0019ed126a22d7a87e0c791c27ce438 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 29 Nov 2018 08:14:20 +0100 Subject: [PATCH 18/47] cleanding dependentState/microstructure don't need to be part of the complex state handling --- src/plastic_disloUCLA.f90 | 63 ++++++++++++++++++--------------------- 1 file changed, 29 insertions(+), 34 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 28feb94a7..dd46c0ca9 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -45,8 +45,6 @@ module plastic_disloUCLA plastic_disloUCLA_dipoleFormationFactor !< scaling factor for dipole formation: 0: off, 1: on. other values not useful real(pReal), dimension(:,:), allocatable, private :: & - plastic_disloUCLA_rhoEdge0, & !< initial edge dislocation density per slip system for each family and instance - plastic_disloUCLA_rhoEdgeDip0, & !< initial edge dipole density per slip system for each family and instance plastic_disloUCLA_v0PerSlipFamily, & !< dislocation velocity prefactor [m/s] for each family and instance plastic_disloUCLA_v0PerSlipSystem, & !< dislocation velocity prefactor [m/s] for each slip system and instance plastic_disloUCLA_tau_peierlsPerSlipFamily, & !< Peierls stress [Pa] for each family and instance @@ -121,10 +119,20 @@ module plastic_disloUCLA mfp_slip, & threshold_stress_slip end type + + type, private :: tDisloUCLAMicrostructure + real(pReal), allocatable, dimension(:,:) :: & + invLambda, & + mfp, & + threshold_stress + end type tDisloUCLAMicrostructure + type(tDisloUCLAState ), allocatable, dimension(:), private :: & state, & - state0, & dotState + + type(tDisloUCLAMicrostructure), allocatable, dimension(:), private :: & + microstructure public :: & plastic_disloUCLA_init, & @@ -235,8 +243,6 @@ material_allocatePlasticState allocate(plastic_disloUCLA_CEdgeDipMinDistance(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_SolidSolutionStrength(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_dipoleFormationFactor(maxNinstance), source=1.0_pReal) !should be on by default - allocate(plastic_disloUCLA_rhoEdge0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_rhoEdgeDip0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_friction(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_v0PerSlipFamily(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_tau_peierlsPerSlipFamily(lattice_maxNslipFamily,maxNinstance), & @@ -250,8 +256,8 @@ material_allocatePlasticState allocate(param(maxNinstance)) allocate(state(maxNinstance)) - allocate(state0(maxNinstance)) allocate(dotState(maxNinstance)) + allocate(microstructure(maxNinstance)) do p = 1_pInt, size(phase_plasticityInstance) @@ -282,8 +288,8 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & config_phase(p)%getFloats('interaction_slipslip'), & structure(1:3)) - !prm%rho0 = config_phase(p)%getFloats('rho0') - !prm%rhoDip0 = config_phase(p)%getFloats('dipole_rho0') + prm%rho0 = config_phase(p)%getFloats('rhoedge0') + prm%rhoDip0 = config_phase(p)%getFloats('rhoedgedip0') prm%burgers = config_phase(p)%getFloats('slipburgers') prm%H0kp = config_phase(p)%getFloats('qedge') !prm%v0 = config_phase(p)%getFloats('v0') @@ -298,6 +304,8 @@ do p = 1_pInt, size(phase_plasticityInstance) ! expand: family => system + prm%rho0 = math_expand(prm%rho0, prm%Nslip) + prm%rhoDip0 = math_expand(prm%rhoDip0, prm%Nslip) prm%q = math_expand(prm%q, prm%Nslip) prm%p = math_expand(prm%p, prm%Nslip) prm%H0kp = math_expand(prm%H0kp, prm%Nslip) @@ -404,10 +412,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo select case(tag) - case ('rhoedge0') - plastic_disloUCLA_rhoEdge0(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('rhoedgedip0') - plastic_disloUCLA_rhoEdgeDip0(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) case ('v0') plastic_disloUCLA_v0PerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) case ('clambdaslip') @@ -456,10 +460,10 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp call IO_error(211_pInt,el=instance,ext_msg='Nslip ('//PLASTICITY_DISLOUCLA_label//')') do f = 1_pInt,lattice_maxNslipFamily if (plastic_disloUCLA_Nslip(f,instance) > 0_pInt) then - if (plastic_disloUCLA_rhoEdge0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rhoEdge0 ('//PLASTICITY_DISLOUCLA_label//')') - if (plastic_disloUCLA_rhoEdgeDip0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rhoEdgeDip0 ('//PLASTICITY_DISLOUCLA_label//')') + !if (plastic_disloUCLA_rhoEdge0(f,instance) < 0.0_pReal) & + ! call IO_error(211_pInt,el=instance,ext_msg='rhoEdge0 ('//PLASTICITY_DISLOUCLA_label//')') + !if (plastic_disloUCLA_rhoEdgeDip0(f,instance) < 0.0_pReal) & + ! call IO_error(211_pInt,el=instance,ext_msg='rhoEdgeDip0 ('//PLASTICITY_DISLOUCLA_label//')') !if (plastic_disloUCLA_burgersPerSlipFamily(f,instance) <= 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='slipBurgers ('//PLASTICITY_DISLOUCLA_label//')') if (plastic_disloUCLA_v0PerSlipFamily(f,instance) <= 0.0_pReal) & @@ -505,7 +509,7 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp instance = phase_plasticityInstance(phase) ns = plastic_disloUCLA_totalNslip(instance) - associate(prm => param(instance), stt=>state(instance)) + associate(prm => param(instance), stt=>state(instance),mse => microstructure(phase_plasticityInstance(p))) !-------------------------------------------------------------------------------------------------- ! allocate state arrays @@ -587,6 +591,10 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp endIndex=endIndex+ns stt%threshold_stress_slip=>plasticState(phase)%state(startIndex:endIndex,:) + allocate(mse%invLambda(prm%totalNslip,NofMyPhase),source=0.0_pReal) + allocate(mse%mfp(prm%totalNslip,NofMyPhase),source=0.0_pReal) + allocate(mse%threshold_stress(prm%totalNslip,NofMyPhase),source=0.0_pReal) + call plastic_disloUCLA_stateInit(phase,instance) plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally @@ -618,33 +626,20 @@ subroutine plastic_disloUCLA_stateInit(ph,instance) integer(pInt) :: i,f,ns, index_myFamily real(pReal), dimension(plastic_disloUCLA_totalNslip(instance)) :: & - rhoEdge0, & - rhoEdgeDip0, & invLambdaSlip0, & MeanFreePathSlip0, & tauSlipThreshold0 tempState = 0.0_pReal ns = plastic_disloUCLA_totalNslip(instance) associate(prm => param(instance)) -!-------------------------------------------------------------------------------------------------- -! initialize basic slip state variables - do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(plastic_disloUCLA_Nslip(1:f-1_pInt,instance)) ! index in truncated slip system list - rhoEdge0(index_myFamily+1_pInt: & - index_myFamily+plastic_disloUCLA_Nslip(f,instance)) = & - plastic_disloUCLA_rhoEdge0(f,instance) - rhoEdgeDip0(index_myFamily+1_pInt: & - index_myFamily+plastic_disloUCLA_Nslip(f,instance)) = & - plastic_disloUCLA_rhoEdgeDip0(f,instance) - enddo - tempState(1_pInt:ns) = rhoEdge0 - tempState(ns+1_pInt:2_pInt*ns) = rhoEdgeDip0 + tempState(1_pInt:ns) = prm%rho0 + tempState(ns+1_pInt:2_pInt*ns) = prm%rhoDip0 !-------------------------------------------------------------------------------------------------- ! initialize dependent slip microstructural variables forall (i = 1_pInt:ns) & - invLambdaSlip0(i) = sqrt(dot_product((rhoEdge0+rhoEdgeDip0),plastic_disloUCLA_forestProjectionEdge(1:ns,i,instance)))/ & + invLambdaSlip0(i) = sqrt(dot_product((prm%rho0+prm%rhoDip0),plastic_disloUCLA_forestProjectionEdge(1:ns,i,instance)))/ & plastic_disloUCLA_CLambdaSlipPerSlipSystem(i,instance) tempState(3_pInt*ns+1:4_pInt*ns) = invLambdaSlip0 @@ -656,7 +651,7 @@ subroutine plastic_disloUCLA_stateInit(ph,instance) forall (i = 1_pInt:ns) & tauSlipThreshold0(i) = & lattice_mu(ph)*prm%burgers(i) * & - sqrt(dot_product((rhoEdge0+rhoEdgeDip0),plastic_disloUCLA_interactionMatrix_SlipSlip(i,1:ns,instance))) + sqrt(dot_product((prm%rho0+prm%rhoDip0),plastic_disloUCLA_interactionMatrix_SlipSlip(i,1:ns,instance))) tempState(5_pInt*ns+1:6_pInt*ns) = tauSlipThreshold0 From 252f1a6a7531679f49d45337feb1e63920ce8956 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 29 Nov 2018 08:32:15 +0100 Subject: [PATCH 19/47] invlabmdaslip does not need to be stored --- src/plastic_disloUCLA.f90 | 28 +++++++++++----------------- 1 file changed, 11 insertions(+), 17 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index dd46c0ca9..4e3f48e6c 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -115,14 +115,12 @@ module plastic_disloUCLA rhoEdge, & rhoEdgeDip, & accshear_slip, & - invLambdaSlip, & mfp_slip, & threshold_stress_slip end type type, private :: tDisloUCLAMicrostructure real(pReal), allocatable, dimension(:,:) :: & - invLambda, & mfp, & threshold_stress end type tDisloUCLAMicrostructure @@ -516,8 +514,7 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp sizeDotState = int(size(['rhoEdge ','rhoEdgeDip ','accshearslip']),pInt) * ns sizeDeltaState = 0_pInt sizeState = sizeDotState & - + int(size(['invLambdaSlip ',& - 'meanFreePathSlip ','tauSlipThreshold ']),pInt) * ns + + int(size(['meanFreePathSlip ','tauSlipThreshold ']),pInt) * ns call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,0_pInt, & ns,0_pInt,0_pInt) @@ -579,10 +576,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = 1e6_pReal - startIndex=endIndex+1_pInt - endIndex=endIndex+ns - stt%invLambdaSlip=>plasticState(phase)%state(startIndex:endIndex,:) - startIndex=endIndex+1_pInt endIndex=endIndex+ns stt%mfp_slip=>plasticState(phase)%state(startIndex:endIndex,:) @@ -591,7 +584,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp endIndex=endIndex+ns stt%threshold_stress_slip=>plasticState(phase)%state(startIndex:endIndex,:) - allocate(mse%invLambda(prm%totalNslip,NofMyPhase),source=0.0_pReal) allocate(mse%mfp(prm%totalNslip,NofMyPhase),source=0.0_pReal) allocate(mse%threshold_stress(prm%totalNslip,NofMyPhase),source=0.0_pReal) @@ -615,7 +607,8 @@ subroutine plastic_disloUCLA_stateInit(ph,instance) lattice_maxNslipFamily, & lattice_mu use material, only: & - plasticState + plasticState, & + material_phase implicit none integer(pInt), intent(in) :: & @@ -641,19 +634,18 @@ subroutine plastic_disloUCLA_stateInit(ph,instance) forall (i = 1_pInt:ns) & invLambdaSlip0(i) = sqrt(dot_product((prm%rho0+prm%rhoDip0),plastic_disloUCLA_forestProjectionEdge(1:ns,i,instance)))/ & plastic_disloUCLA_CLambdaSlipPerSlipSystem(i,instance) - tempState(3_pInt*ns+1:4_pInt*ns) = invLambdaSlip0 forall (i = 1_pInt:ns) & MeanFreePathSlip0(i) = & plastic_disloUCLA_GrainSize(instance)/(1.0_pReal+invLambdaSlip0(i)*plastic_disloUCLA_GrainSize(instance)) - tempState(4_pInt*ns+1:5_pInt*ns) = MeanFreePathSlip0 + tempState(3_pInt*ns+1:4_pInt*ns) = MeanFreePathSlip0 forall (i = 1_pInt:ns) & tauSlipThreshold0(i) = & lattice_mu(ph)*prm%burgers(i) * & sqrt(dot_product((prm%rho0+prm%rhoDip0),plastic_disloUCLA_interactionMatrix_SlipSlip(i,1:ns,instance))) - tempState(5_pInt*ns+1:6_pInt*ns) = tauSlipThreshold0 + tempState(4_pInt*ns+1:5_pInt*ns) = tauSlipThreshold0 plasticState(ph)%state = spread(tempState,2,size(plasticState(ph)%state(1,:))) end associate @@ -668,7 +660,8 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) pi use material, only: & phase_plasticityInstance, & - phaseAt, phasememberAt + phaseAt, phasememberAt, & + material_phase use lattice, only: & lattice_mu @@ -685,7 +678,8 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) ns,s, & ph, & of - + real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + invLambdaSlip !* Shortened notation of = phasememberAt(ipc,ip,el) ph = phaseAt(ipc,ip,el) @@ -694,7 +688,7 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) associate(prm => param(instance), stt => state(instance)) !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation forall (s = 1_pInt:ns) & - stt%invLambdaSlip(s,of) = & + invLambdaSlip(s) = & sqrt(dot_product((stt%rhoEdge(1_pInt:ns,of)+stt%rhoEdgeDip(1_pInt:ns,of)),& plastic_disloUCLA_forestProjectionEdge(1:ns,s,instance)))/ & plastic_disloUCLA_CLambdaSlipPerSlipSystem(s,instance) @@ -703,7 +697,7 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) do s = 1_pInt,ns stt%mfp_slip(s,of) = & plastic_disloUCLA_GrainSize(instance)/& - (1.0_pReal+plastic_disloUCLA_GrainSize(instance)*(stt%invLambdaSlip(s,of))) + (1.0_pReal+plastic_disloUCLA_GrainSize(instance)*(invLambdaSlip(s))) enddo !* threshold stress for dislocation motion From 28ec50a6a9f37d2f6d5b45666ba4a5c25a18f07d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 29 Nov 2018 08:44:31 +0100 Subject: [PATCH 20/47] simpler reading in --- src/plastic_disloUCLA.f90 | 48 +++++++++++++++++++-------------------- 1 file changed, 23 insertions(+), 25 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 4e3f48e6c..7752a33ef 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -39,7 +39,6 @@ module plastic_disloUCLA plastic_disloUCLA_CAtomicVolume, & !< atomic volume in Bugers vector unit plastic_disloUCLA_D0, & !< prefactor for self-diffusion coefficient plastic_disloUCLA_Qsd, & !< activation energy for dislocation climb - plastic_disloUCLA_GrainSize, & !< grain size plastic_disloUCLA_CEdgeDipMinDistance, & !< plastic_disloUCLA_SolidSolutionStrength, & !< Strength due to elements in solid solution plastic_disloUCLA_dipoleFormationFactor !< scaling factor for dipole formation: 0: off, 1: on. other values not useful @@ -47,7 +46,6 @@ module plastic_disloUCLA real(pReal), dimension(:,:), allocatable, private :: & plastic_disloUCLA_v0PerSlipFamily, & !< dislocation velocity prefactor [m/s] for each family and instance plastic_disloUCLA_v0PerSlipSystem, & !< dislocation velocity prefactor [m/s] for each slip system and instance - plastic_disloUCLA_tau_peierlsPerSlipFamily, & !< Peierls stress [Pa] for each family and instance plastic_disloUCLA_CLambdaSlipPerSlipFamily, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance plastic_disloUCLA_CLambdaSlipPerSlipSystem, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance plastic_disloUCLA_interaction_SlipSlip, & !< coefficients for slip-slip interaction for each interaction type and instance @@ -73,7 +71,8 @@ module plastic_disloUCLA type, private :: tParameters real(pReal) :: & - aTolRho + aTolRho, & + grainSize real(pReal), allocatable, dimension(:) :: & rho0, & !< initial edge dislocation density per slip system for each family and instance rhoDip0, & !< initial edge dipole density per slip system for each family and instance @@ -89,7 +88,7 @@ module plastic_disloUCLA omega, & !< attempt frequency for kink pair nucleation viscosity, & !< friction coeff. B (kMC) !* - tauPeierls, & + tau_Peierls, & nonSchmidCoeff real(pReal), allocatable, dimension(:,:) :: & interaction_SlipSlip !< slip resistance from slip activity @@ -237,14 +236,11 @@ material_allocatePlasticState allocate(plastic_disloUCLA_CAtomicVolume(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_D0(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_Qsd(maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_GrainSize(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_CEdgeDipMinDistance(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_SolidSolutionStrength(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_dipoleFormationFactor(maxNinstance), source=1.0_pReal) !should be on by default allocate(plastic_disloUCLA_friction(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_v0PerSlipFamily(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_tau_peierlsPerSlipFamily(lattice_maxNslipFamily,maxNinstance), & - source=0.0_pReal) allocate(plastic_disloUCLA_CLambdaSlipPerSlipFamily(lattice_maxNslipFamily,maxNinstance), & source=0.0_pReal) @@ -292,7 +288,7 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%H0kp = config_phase(p)%getFloats('qedge') !prm%v0 = config_phase(p)%getFloats('v0') !prm%clambda = config_phase(p)%getFloats('clambda') - !prm%tauPeierls = config_phase(p)%getFloats('peierls_stress') + prm%tau_Peierls = config_phase(p)%getFloats('tau_peierls') prm%p = config_phase(p)%getFloats('p_slip',defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) prm%q = config_phase(p)%getFloats('q_slip',defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) prm%kink_height = config_phase(p)%getFloats('kink_height') @@ -301,6 +297,9 @@ do p = 1_pInt, size(phase_plasticityInstance) !prm%viscosity = config_phase(p)%getFloats('viscosity') + prm%grainSize = config_phase(p)%getFloat('grainsize') + + ! expand: family => system prm%rho0 = math_expand(prm%rho0, prm%Nslip) prm%rhoDip0 = math_expand(prm%rhoDip0, prm%Nslip) @@ -311,6 +310,7 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%kink_height = math_expand(prm%kink_height, prm%Nslip) prm%kink_width = math_expand(prm%kink_width, prm%Nslip) prm%omega = math_expand(prm%omega, prm%Nslip) + prm%tau_Peierls = math_expand(prm%tau_Peierls, prm%Nslip) endif slipActive @@ -414,10 +414,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp plastic_disloUCLA_v0PerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) case ('clambdaslip') plastic_disloUCLA_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_DISLOUCLA_label//')') - plastic_disloUCLA_tau_peierlsPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) case ('friction_coeff') plastic_disloUCLA_friction(1:Nchunks_SlipFamilies,instance) = & tempPerSlip(1:Nchunks_SlipFamilies) @@ -433,8 +429,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp enddo !-------------------------------------------------------------------------------------------------- ! parameters independent of number of slip systems - case ('grainsize') - plastic_disloUCLA_GrainSize(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('d0') plastic_disloUCLA_D0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('qsd') @@ -466,8 +460,8 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp ! call IO_error(211_pInt,el=instance,ext_msg='slipBurgers ('//PLASTICITY_DISLOUCLA_label//')') if (plastic_disloUCLA_v0PerSlipFamily(f,instance) <= 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='v0 ('//PLASTICITY_DISLOUCLA_label//')') - if (plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='tau_peierls ('//PLASTICITY_DISLOUCLA_label//')') + !if (plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance) < 0.0_pReal) & + ! call IO_error(211_pInt,el=instance,ext_msg='tau_peierls ('//PLASTICITY_DISLOUCLA_label//')') endif enddo if (plastic_disloUCLA_CAtomicVolume(instance) <= 0.0_pReal) & @@ -637,7 +631,7 @@ subroutine plastic_disloUCLA_stateInit(ph,instance) forall (i = 1_pInt:ns) & MeanFreePathSlip0(i) = & - plastic_disloUCLA_GrainSize(instance)/(1.0_pReal+invLambdaSlip0(i)*plastic_disloUCLA_GrainSize(instance)) + prm%grainSize/(1.0_pReal+invLambdaSlip0(i)*prm%grainSize) tempState(3_pInt*ns+1:4_pInt*ns) = MeanFreePathSlip0 forall (i = 1_pInt:ns) & @@ -685,6 +679,8 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) ns = plastic_disloUCLA_totalNslip(instance) + + associate(prm => param(instance), stt => state(instance)) !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation forall (s = 1_pInt:ns) & @@ -696,8 +692,8 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) !* mean free path between 2 obstacles seen by a moving dislocation do s = 1_pInt,ns stt%mfp_slip(s,of) = & - plastic_disloUCLA_GrainSize(instance)/& - (1.0_pReal+plastic_disloUCLA_GrainSize(instance)*(invLambdaSlip(s))) + prm%grainSize/& + (1.0_pReal+prm%grainSize*(invLambdaSlip(s))) enddo !* threshold stress for dislocation motion @@ -707,6 +703,8 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) sqrt(dot_product((stt%rhoEdge(1_pInt:ns,of)+stt%rhoEdgeDip(1_pInt:ns,of)),& plastic_disloUCLA_interactionMatrix_SlipSlip(s,1:ns,instance))) end associate + + end subroutine plastic_disloUCLA_microstructure @@ -1080,7 +1078,7 @@ ph, instance,of !* Stress ratio stressRatio = ((abs(tau_slip_pos(j))-stt%threshold_stress_slip(j, of))/& (plastic_disloUCLA_SolidSolutionStrength(instance)+& - plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) + prm%tau_Peierls(j))) stressRatio_p = stressRatio** prm%p(j) stressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal) !* Shear rates due to slip @@ -1111,7 +1109,7 @@ ph, instance,of * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) *BoltzmannRatio*prm%p(j)& *prm%q(j)/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& + (plastic_disloUCLA_SolidSolutionStrength(instance)+prm%tau_Peierls(j))*& StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) &!deltaf(f) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & @@ -1127,7 +1125,7 @@ ph, instance,of * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) *BoltzmannRatio*prm%p(j)& *prm%q(j)/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& + (plastic_disloUCLA_SolidSolutionStrength(instance)+prm%tau_Peierls(j))*& StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& !deltaf(f) ) & ) & @@ -1147,7 +1145,7 @@ ph, instance,of !* Stress ratios stressRatio = ((abs(tau_slip_neg(j))-stt%threshold_stress_slip(j, of))/& (plastic_disloUCLA_SolidSolutionStrength(instance)+& - plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))) + prm%tau_Peierls(j))) stressRatio_p = stressRatio** prm%p(j) stressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal) !* Shear rates due to slip @@ -1177,7 +1175,7 @@ ph, instance,of * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) *BoltzmannRatio*prm%p(j)& *prm%q(j)/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& + (plastic_disloUCLA_SolidSolutionStrength(instance)+prm%tau_Peierls(j))*& StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) &!deltaf(f) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & @@ -1193,7 +1191,7 @@ ph, instance,of * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) *BoltzmannRatio*prm%p(j)& *prm%q(j)/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance))*& + (plastic_disloUCLA_SolidSolutionStrength(instance)+prm%tau_Peierls(j))*& StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& !deltaf(f) ) & ) & From 64e9c7fb7705c4110f39daf569e30ed997bf2b32 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 29 Nov 2018 08:56:57 +0100 Subject: [PATCH 21/47] mean free path and threshold stres don't have to be part of the state --- src/plastic_disloUCLA.f90 | 80 ++++++++++++++++++--------------------- 1 file changed, 36 insertions(+), 44 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 7752a33ef..f80457392 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -113,9 +113,7 @@ module plastic_disloUCLA real(pReal), pointer, dimension(:,:) :: & rhoEdge, & rhoEdgeDip, & - accshear_slip, & - mfp_slip, & - threshold_stress_slip + accshear_slip end type type, private :: tDisloUCLAMicrostructure @@ -507,8 +505,7 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp sizeDotState = int(size(['rhoEdge ','rhoEdgeDip ','accshearslip']),pInt) * ns sizeDeltaState = 0_pInt - sizeState = sizeDotState & - + int(size(['meanFreePathSlip ','tauSlipThreshold ']),pInt) * ns + sizeState = sizeDotState call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,0_pInt, & ns,0_pInt,0_pInt) @@ -555,12 +552,14 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp startIndex=1_pInt endIndex=ns stt%rhoEdge=>plasticState(phase)%state(startIndex:endIndex,:) + stt%rhoEdge= spread(prm%rho0,2,NofMyPhase) dotState(instance)%rhoEdge=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho startIndex=endIndex+1_pInt endIndex=endIndex+ns stt%rhoEdgeDip=>plasticState(phase)%state(startIndex:endIndex,:) + stt%rhoEdgeDip= spread(prm%rhoDip0,2,NofMyPhase) dotState(instance)%rhoEdgeDip=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho @@ -570,13 +569,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = 1e6_pReal - startIndex=endIndex+1_pInt - endIndex=endIndex+ns - stt%mfp_slip=>plasticState(phase)%state(startIndex:endIndex,:) - - startIndex=endIndex+1_pInt - endIndex=endIndex+ns - stt%threshold_stress_slip=>plasticState(phase)%state(startIndex:endIndex,:) allocate(mse%mfp(prm%totalNslip,NofMyPhase),source=0.0_pReal) allocate(mse%threshold_stress(prm%totalNslip,NofMyPhase),source=0.0_pReal) @@ -618,7 +610,7 @@ subroutine plastic_disloUCLA_stateInit(ph,instance) tauSlipThreshold0 tempState = 0.0_pReal ns = plastic_disloUCLA_totalNslip(instance) - associate(prm => param(instance)) + associate(prm => param(instance),mse => microstructure(instance)) tempState(1_pInt:ns) = prm%rho0 tempState(ns+1_pInt:2_pInt*ns) = prm%rhoDip0 @@ -632,16 +624,16 @@ subroutine plastic_disloUCLA_stateInit(ph,instance) forall (i = 1_pInt:ns) & MeanFreePathSlip0(i) = & prm%grainSize/(1.0_pReal+invLambdaSlip0(i)*prm%grainSize) - tempState(3_pInt*ns+1:4_pInt*ns) = MeanFreePathSlip0 + + mse%mfp= spread(MeanFreePathSlip0,2,size(plasticState(ph)%state(1,:))) forall (i = 1_pInt:ns) & tauSlipThreshold0(i) = & lattice_mu(ph)*prm%burgers(i) * & sqrt(dot_product((prm%rho0+prm%rhoDip0),plastic_disloUCLA_interactionMatrix_SlipSlip(i,1:ns,instance))) - tempState(4_pInt*ns+1:5_pInt*ns) = tauSlipThreshold0 + mse%threshold_stress= spread(tauSlipThreshold0,2,size(plasticState(ph)%state(1,:))) -plasticState(ph)%state = spread(tempState,2,size(plasticState(ph)%state(1,:))) end associate end subroutine plastic_disloUCLA_stateInit @@ -681,7 +673,7 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) ns = plastic_disloUCLA_totalNslip(instance) - associate(prm => param(instance), stt => state(instance)) + associate(prm => param(instance), stt => state(instance),mse => microstructure(instance)) !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation forall (s = 1_pInt:ns) & invLambdaSlip(s) = & @@ -691,14 +683,14 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) !* mean free path between 2 obstacles seen by a moving dislocation do s = 1_pInt,ns - stt%mfp_slip(s,of) = & + mse%mfp(s,of) = & prm%grainSize/& (1.0_pReal+prm%grainSize*(invLambdaSlip(s))) enddo - + !* threshold stress for dislocation motion forall (s = 1_pInt:ns) & - stt%threshold_stress_slip(s,of) = & + mse%threshold_stress(s,of) = & lattice_mu(ph)*prm%burgers(s)*& sqrt(dot_product((stt%rhoEdge(1_pInt:ns,of)+stt%rhoEdgeDip(1_pInt:ns,of)),& plastic_disloUCLA_interactionMatrix_SlipSlip(s,1:ns,instance))) @@ -811,7 +803,7 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) ns = plastic_disloUCLA_totalNslip(instance) plasticState(ph)%dotState(:,of) = 0.0_pReal - associate(prm => param(instance), stt => state(instance)) + associate(prm => param(instance), stt => state(instance),mse => microstructure(instance)) !* Dislocation density evolution call kinetics(Mp,Temperature,ph,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) @@ -826,7 +818,7 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) !* Multiplication DotRhoMultiplication = abs(dotState(instance)%accshear_slip(j,of))/& (prm%burgers(j)* & - stt%mfp_slip(j,of)) + mse%mfp(j,of)) !* Dipole formation EdgeDipMinDistance = & @@ -837,7 +829,7 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) EdgeDipDistance = & (3.0_pReal*lattice_mu(ph)*prm%burgers(j))/& (16.0_pReal*pi*abs(tau_slip_pos(j))) - if (EdgeDipDistance>stt%mfp_slip(j,of)) EdgeDipDistance=stt%mfp_slip(j,of) + if (EdgeDipDistance>mse%mfp(j,of)) EdgeDipDistance=mse%mfp(j,of) if (EdgeDipDistance param(instance),stt =>state(instance)) + associate (prm => param(instance),stt =>state(instance),mse => microstructure(instance)) do o = 1_pInt,plastic_disloUCLA_Noutput(instance) select case(plastic_disloUCLA_outputID(o,instance)) @@ -973,7 +965,7 @@ math_mul33xx33 c = c + ns case (mfp_ID) postResults(c+1_pInt:c+ns) =& - stt%mfp_slip(1_pInt:ns, of) + mse%mfp(1_pInt:ns, of) c = c + ns case (resolvedstress_ID) j = 0_pInt @@ -987,7 +979,7 @@ math_mul33xx33 c = c + ns case (thresholdstress_ID) postResults(c+1_pInt:c+ns) = & - stt%threshold_stress_slip(1_pInt:ns,of) + mse%threshold_stress(1_pInt:ns,of) c = c + ns case (dipoleDistance_ID) j = 0_pInt @@ -1003,7 +995,7 @@ math_mul33xx33 postResults(c+j) = huge(1.0_pReal) endif postResults(c+j)=min(postResults(c+j),& - stt%mfp_slip(j,of)) + mse%mfp(j,of)) enddo slipSystems2; enddo slipFamilies2 c = c + ns end select @@ -1050,7 +1042,7 @@ ph, instance,of dvel_slip, vel_slip real(pReal), intent(out), dimension(plastic_disloUCLA_totalNslip(instance)) :: & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg - associate(prm => param(instance), stt => state(instance)) + associate(prm => param(instance), stt => state(instance),mse => microstructure(instance)) !* Shortened notation ns = plastic_disloUCLA_totalNslip(instance) @@ -1074,9 +1066,9 @@ ph, instance,of tau_slip_pos(j) = math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)) tau_slip_neg(j) = math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j)) - significantPositiveTau: if((abs(tau_slip_pos(j))-stt%threshold_stress_slip(j, of)) > tol_math_check) then + significantPositiveTau: if((abs(tau_slip_pos(j))-mse%threshold_stress(j, of)) > tol_math_check) then !* Stress ratio - stressRatio = ((abs(tau_slip_pos(j))-stt%threshold_stress_slip(j, of))/& + stressRatio = ((abs(tau_slip_pos(j))-mse%threshold_stress(j, of))/& (plastic_disloUCLA_SolidSolutionStrength(instance)+& prm%tau_Peierls(j))) stressRatio_p = stressRatio** prm%p(j) @@ -1084,13 +1076,13 @@ ph, instance,of !* Shear rates due to slip vel_slip = 2.0_pReal*prm%burgers(j) & * prm%kink_height(j) * prm%omega(j) & - * ( stt%mfp_slip(j,of) - prm%kink_width(j) ) & + * ( mse%mfp(j,of) - prm%kink_width(j) ) & * (tau_slip_pos(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & / ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) @@ -1102,7 +1094,7 @@ ph, instance,of dvel_slip = & 2.0_pReal*prm%burgers(j) & * prm%kink_height(j) * prm%omega(j) & - * ( stt%mfp_slip(j,of) - prm%kink_width(j) ) & + * ( mse%mfp(j,of) - prm%kink_width(j) ) & * ( & (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + tau_slip_pos(j) & @@ -1114,14 +1106,14 @@ ph, instance,of ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) & - (tau_slip_pos(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) *BoltzmannRatio*prm%p(j)& *prm%q(j)/& @@ -1133,7 +1125,7 @@ ph, instance,of ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & )**2.0_pReal & ) @@ -1141,9 +1133,9 @@ ph, instance,of dgdot_dtauslip_pos(j) = DotGamma0 * dvel_slip endif significantPositiveTau - significantNegativeTau: if((abs(tau_slip_neg(j))-stt%threshold_stress_slip(j, of)) > tol_math_check) then + significantNegativeTau: if((abs(tau_slip_neg(j))-mse%threshold_stress(j, of)) > tol_math_check) then !* Stress ratios - stressRatio = ((abs(tau_slip_neg(j))-stt%threshold_stress_slip(j, of))/& + stressRatio = ((abs(tau_slip_neg(j))-mse%threshold_stress(j, of))/& (plastic_disloUCLA_SolidSolutionStrength(instance)+& prm%tau_Peierls(j))) stressRatio_p = stressRatio** prm%p(j) @@ -1151,13 +1143,13 @@ ph, instance,of !* Shear rates due to slip vel_slip = 2.0_pReal*prm%burgers(j) & * prm%kink_height(j) * prm%omega(j) & - * ( stt%mfp_slip(j,of) - prm%kink_width(j) ) & + * ( mse%mfp(j,of) - prm%kink_width(j) ) & * (tau_slip_neg(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & / ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) @@ -1168,7 +1160,7 @@ ph, instance,of dvel_slip = & 2.0_pReal*prm%burgers(j) & * prm%kink_height(j) * prm%omega(j) & - * ( stt%mfp_slip(j,of) - prm%kink_width(j) ) & + * ( mse%mfp(j,of) - prm%kink_width(j) ) & * ( & (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + tau_slip_neg(j) & @@ -1180,14 +1172,14 @@ ph, instance,of ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) & - (tau_slip_neg(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) *BoltzmannRatio*prm%p(j)& *prm%q(j)/& @@ -1199,7 +1191,7 @@ ph, instance,of ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & - *(( stt%mfp_slip(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & )**2.0_pReal & ) From bbddb2558c6d09767be9a493f96adb437720d81b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 29 Nov 2018 09:21:58 +0100 Subject: [PATCH 22/47] cleaning --- src/plastic_disloUCLA.f90 | 71 +++------------------------------------ 1 file changed, 5 insertions(+), 66 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index f80457392..7726b9291 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -136,7 +136,7 @@ module plastic_disloUCLA plastic_disloUCLA_dotState, & plastic_disloUCLA_postResults private :: & - plastic_disloUCLA_stateInit + kinetics contains @@ -192,7 +192,7 @@ material_allocatePlasticState integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,phase,maxTotalNslip,& + integer(pInt) :: maxNinstance,phase,maxTotalNslip,& f,instance,j,k,o,ns, i, & Nchunks_SlipSlip = 0_pInt, outputSize, & Nchunks_SlipFamilies = 0_pInt,Nchunks_nonSchmid = 0_pInt, & @@ -573,7 +573,7 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp allocate(mse%mfp(prm%totalNslip,NofMyPhase),source=0.0_pReal) allocate(mse%threshold_stress(prm%totalNslip,NofMyPhase),source=0.0_pReal) - call plastic_disloUCLA_stateInit(phase,instance) + !call plastic_disloUCLA_stateInit(phase,instance) plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally end associate @@ -583,60 +583,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp end subroutine plastic_disloUCLA_init -!-------------------------------------------------------------------------------------------------- -!> @brief sets the relevant state values for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine plastic_disloUCLA_stateInit(ph,instance) - use math, only: & - pi - use lattice, only: & - lattice_maxNslipFamily, & - lattice_mu - use material, only: & - plasticState, & - material_phase - - implicit none - integer(pInt), intent(in) :: & - instance, & !< number specifying the instance of the plasticity - ph - - real(pReal), dimension(plasticState(ph)%sizeState) :: tempState - - integer(pInt) :: i,f,ns, index_myFamily - real(pReal), dimension(plastic_disloUCLA_totalNslip(instance)) :: & - invLambdaSlip0, & - MeanFreePathSlip0, & - tauSlipThreshold0 - tempState = 0.0_pReal - ns = plastic_disloUCLA_totalNslip(instance) - associate(prm => param(instance),mse => microstructure(instance)) - - tempState(1_pInt:ns) = prm%rho0 - tempState(ns+1_pInt:2_pInt*ns) = prm%rhoDip0 - -!-------------------------------------------------------------------------------------------------- -! initialize dependent slip microstructural variables - forall (i = 1_pInt:ns) & - invLambdaSlip0(i) = sqrt(dot_product((prm%rho0+prm%rhoDip0),plastic_disloUCLA_forestProjectionEdge(1:ns,i,instance)))/ & - plastic_disloUCLA_CLambdaSlipPerSlipSystem(i,instance) - - forall (i = 1_pInt:ns) & - MeanFreePathSlip0(i) = & - prm%grainSize/(1.0_pReal+invLambdaSlip0(i)*prm%grainSize) - - mse%mfp= spread(MeanFreePathSlip0,2,size(plasticState(ph)%state(1,:))) - - forall (i = 1_pInt:ns) & - tauSlipThreshold0(i) = & - lattice_mu(ph)*prm%burgers(i) * & - sqrt(dot_product((prm%rho0+prm%rhoDip0),plastic_disloUCLA_interactionMatrix_SlipSlip(i,1:ns,instance))) - - mse%threshold_stress= spread(tauSlipThreshold0,2,size(plasticState(ph)%state(1,:))) - -end associate -end subroutine plastic_disloUCLA_stateInit - !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state @@ -1015,16 +961,9 @@ subroutine kinetics(Mp,Temperature,ph,instance,of, & use math, only: & pi, & math_mul33xx33 - use material, only: & - material_phase, & - phase_plasticityInstance,& - !plasticState, & - phaseAt, phasememberAt use lattice, only: & - lattice_Sslip, & lattice_maxNslipFamily, & - lattice_NslipSystem, & - lattice_NnonSchmid + lattice_NslipSystem implicit none real(pReal), dimension(3,3), intent(in) :: & @@ -1036,7 +975,7 @@ ph, instance,of integer(pInt) :: & ns,& - f,i,j,k,index_myFamily + f,i,j,index_myFamily real(pReal) :: StressRatio_p,StressRatio_pminus1,& BoltzmannRatio,DotGamma0,stressRatio,& dvel_slip, vel_slip From 39c1df75426e8bfa4c83b7366a1c8bea7fb18e0b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 29 Nov 2018 10:31:02 +0100 Subject: [PATCH 23/47] further simplifications --- src/plastic_disloUCLA.f90 | 106 ++++++++++---------------------------- 1 file changed, 28 insertions(+), 78 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 7726b9291..2050cf5b7 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -40,20 +40,15 @@ module plastic_disloUCLA plastic_disloUCLA_D0, & !< prefactor for self-diffusion coefficient plastic_disloUCLA_Qsd, & !< activation energy for dislocation climb plastic_disloUCLA_CEdgeDipMinDistance, & !< - plastic_disloUCLA_SolidSolutionStrength, & !< Strength due to elements in solid solution plastic_disloUCLA_dipoleFormationFactor !< scaling factor for dipole formation: 0: off, 1: on. other values not useful real(pReal), dimension(:,:), allocatable, private :: & - plastic_disloUCLA_v0PerSlipFamily, & !< dislocation velocity prefactor [m/s] for each family and instance - plastic_disloUCLA_v0PerSlipSystem, & !< dislocation velocity prefactor [m/s] for each slip system and instance plastic_disloUCLA_CLambdaSlipPerSlipFamily, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance plastic_disloUCLA_CLambdaSlipPerSlipSystem, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance - plastic_disloUCLA_interaction_SlipSlip, & !< coefficients for slip-slip interaction for each interaction type and instance !* mobility law parameters plastic_disloUCLA_friction !< friction coeff. B (kMC) real(pReal), dimension(:,:,:), allocatable, private :: & - plastic_disloUCLA_interactionMatrix_SlipSlip, & !< interaction matrix of the different slip systems for each instance plastic_disloUCLA_forestProjectionEdge !< matrix of forest projections of edge dislocations for each instance enum, bind(c) @@ -72,7 +67,8 @@ module plastic_disloUCLA type, private :: tParameters real(pReal) :: & aTolRho, & - grainSize + grainSize, & +SolidSolutionStrength !< Strength due to elements in solid solution real(pReal), allocatable, dimension(:) :: & rho0, & !< initial edge dislocation density per slip system for each family and instance rhoDip0, & !< initial edge dipole density per slip system for each family and instance @@ -198,7 +194,7 @@ material_allocatePlasticState Nchunks_SlipFamilies = 0_pInt,Nchunks_nonSchmid = 0_pInt, & offset_slip, index_myFamily, index_otherFamily, & startIndex, endIndex, p - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState + integer(pInt) :: sizeState, sizeDotState integer(pInt) :: NofMyPhase character(len=65536) :: & structure = '',& @@ -235,16 +231,12 @@ material_allocatePlasticState allocate(plastic_disloUCLA_D0(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_Qsd(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_CEdgeDipMinDistance(maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_SolidSolutionStrength(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_dipoleFormationFactor(maxNinstance), source=1.0_pReal) !should be on by default allocate(plastic_disloUCLA_friction(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_v0PerSlipFamily(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_CLambdaSlipPerSlipFamily(lattice_maxNslipFamily,maxNinstance), & source=0.0_pReal) - allocate(plastic_disloUCLA_interaction_SlipSlip(lattice_maxNinteraction,maxNinstance),source=0.0_pReal) - allocate(param(maxNinstance)) allocate(state(maxNinstance)) @@ -284,7 +276,7 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%rhoDip0 = config_phase(p)%getFloats('rhoedgedip0') prm%burgers = config_phase(p)%getFloats('slipburgers') prm%H0kp = config_phase(p)%getFloats('qedge') - !prm%v0 = config_phase(p)%getFloats('v0') + prm%v0 = config_phase(p)%getFloats('v0') !prm%clambda = config_phase(p)%getFloats('clambda') prm%tau_Peierls = config_phase(p)%getFloats('tau_peierls') prm%p = config_phase(p)%getFloats('p_slip',defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) @@ -295,8 +287,15 @@ do p = 1_pInt, size(phase_plasticityInstance) !prm%viscosity = config_phase(p)%getFloats('viscosity') + prm%SolidSolutionStrength = config_phase(p)%getFloat('solidsolutionstrength') + prm%grainSize = config_phase(p)%getFloat('grainsize') + plastic_disloUCLA_D0(phase_plasticityInstance(p)) = config_phase(p)%getFloat('qsd') + plastic_disloUCLA_Qsd(phase_plasticityInstance(p)) = config_phase(p)%getFloat('qsd') + plastic_disloUCLA_CEdgeDipMinDistance(phase_plasticityInstance(p)) = config_phase(p)%getFloat('cedgedipmindistance') + plastic_disloUCLA_CAtomicVolume(phase_plasticityInstance(p)) = config_phase(p)%getFloat('catomicvolume') + plastic_disloUCLA_dipoleFormationFactor(phase_plasticityInstance(p)) = config_phase(p)%getFloat('dipoleformationfactor') ! expand: family => system prm%rho0 = math_expand(prm%rho0, prm%Nslip) @@ -309,6 +308,7 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%kink_width = math_expand(prm%kink_width, prm%Nslip) prm%omega = math_expand(prm%omega, prm%Nslip) prm%tau_Peierls = math_expand(prm%tau_Peierls, prm%Nslip) + prm%v0 = math_expand(prm%v0, prm%Nslip) endif slipActive @@ -379,7 +379,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp phase = phase + 1_pInt ! advance phase section counter if (phase_plasticity(phase) == PLASTICITY_DISLOUCLA_ID) then Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) - Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) Nchunks_nonSchmid = lattice_NnonSchmid(phase) if(allocated(tempPerSlip)) deallocate(tempPerSlip) allocate(tempPerSlip(Nchunks_SlipFamilies)) @@ -402,43 +401,17 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp do j = 1_pInt, Nchunks_SlipFamilies plastic_disloUCLA_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo - case ('rhoedge0','rhoedgedip0','slipburgers','qedge','v0','clambdaslip','tau_peierls','p_slip','q_slip',& - 'kink_height','omega','kink_width','dislolength','friction_coeff') + case ('clambdaslip','friction_coeff') do j = 1_pInt, Nchunks_SlipFamilies tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo select case(tag) - case ('v0') - plastic_disloUCLA_v0PerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) case ('clambdaslip') plastic_disloUCLA_CLambdaSlipPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) case ('friction_coeff') plastic_disloUCLA_friction(1:Nchunks_SlipFamilies,instance) = & tempPerSlip(1:Nchunks_SlipFamilies) end select - -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of interactions - case ('interaction_slipslip','interactionslipslip') - if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') - do j = 1_pInt, Nchunks_SlipSlip - plastic_disloUCLA_interaction_SlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo -!-------------------------------------------------------------------------------------------------- -! parameters independent of number of slip systems - case ('d0') - plastic_disloUCLA_D0(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('qsd') - plastic_disloUCLA_Qsd(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('solidsolutionstrength') - plastic_disloUCLA_SolidSolutionStrength(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cedgedipmindistance') - plastic_disloUCLA_CEdgeDipMinDistance(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('catomicvolume') - plastic_disloUCLA_CAtomicVolume(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('dipoleformationfactor') - plastic_disloUCLA_dipoleFormationFactor(instance) = IO_floatValue(line,chunkPos,2_pInt) end select endif; endif enddo parsingFile @@ -456,8 +429,8 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp ! call IO_error(211_pInt,el=instance,ext_msg='rhoEdgeDip0 ('//PLASTICITY_DISLOUCLA_label//')') !if (plastic_disloUCLA_burgersPerSlipFamily(f,instance) <= 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='slipBurgers ('//PLASTICITY_DISLOUCLA_label//')') - if (plastic_disloUCLA_v0PerSlipFamily(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='v0 ('//PLASTICITY_DISLOUCLA_label//')') + !if (plastic_disloUCLA_v0PerSlipFamily(f,instance) <= 0.0_pReal) & + ! call IO_error(211_pInt,el=instance,ext_msg='v0 ('//PLASTICITY_DISLOUCLA_label//')') !if (plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance) < 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='tau_peierls ('//PLASTICITY_DISLOUCLA_label//')') endif @@ -482,12 +455,8 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp ! allocation of variables whose size depends on the total number of active slip systems maxTotalNslip = maxval(plastic_disloUCLA_totalNslip) - allocate(plastic_disloUCLA_v0PerSlipSystem(maxTotalNslip, maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_CLambdaSlipPerSlipSystem(maxTotalNslip, maxNinstance),source=0.0_pReal) - allocate(plastic_disloUCLA_interactionMatrix_SlipSlip(maxval(plastic_disloUCLA_totalNslip),& ! slip resistance from slip activity - maxval(plastic_disloUCLA_totalNslip),& - maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstance), & source=0.0_pReal) @@ -504,7 +473,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp ! allocate state arrays sizeDotState = int(size(['rhoEdge ','rhoEdgeDip ','accshearslip']),pInt) * ns - sizeDeltaState = 0_pInt sizeState = sizeDotState call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,0_pInt, & @@ -523,27 +491,17 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp index_myFamily = sum(plastic_disloUCLA_Nslip(1:f-1_pInt,instance)) ! index in truncated slip system list mySlipSystems: do j = 1_pInt,plastic_disloUCLA_Nslip(f,instance) - - - plastic_disloUCLA_v0PerSlipSystem(index_myFamily+j,instance) = & - plastic_disloUCLA_v0PerSlipFamily(f,instance) plastic_disloUCLA_CLambdaSlipPerSlipSystem(index_myFamily+j,instance) = & plastic_disloUCLA_CLambdaSlipPerSlipFamily(f,instance) !* Calculation of forest projections for edge dislocations - !* Interaction matrices otherSlipFamilies: do o = 1_pInt,lattice_maxNslipFamily index_otherFamily = sum(plastic_disloUCLA_Nslip(1:o-1_pInt,instance)) otherSlipSystems: do k = 1_pInt,plastic_disloUCLA_Nslip(o,instance) plastic_disloUCLA_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))) - plastic_disloUCLA_interactionMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_disloUCLA_interaction_SlipSlip(lattice_interactionSlipSlip( & - sum(lattice_NslipSystem(1:f-1,phase))+j, & - sum(lattice_NslipSystem(1:o-1,phase))+k, & - phase), instance ) enddo otherSlipSystems; enddo otherSlipFamilies enddo mySlipSystems @@ -573,7 +531,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp allocate(mse%mfp(prm%totalNslip,NofMyPhase),source=0.0_pReal) allocate(mse%threshold_stress(prm%totalNslip,NofMyPhase),source=0.0_pReal) - !call plastic_disloUCLA_stateInit(phase,instance) plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally end associate @@ -628,18 +585,15 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) plastic_disloUCLA_CLambdaSlipPerSlipSystem(s,instance) !* mean free path between 2 obstacles seen by a moving dislocation - do s = 1_pInt,ns - mse%mfp(s,of) = & - prm%grainSize/& - (1.0_pReal+prm%grainSize*(invLambdaSlip(s))) - enddo + + mse%mfp(:,of) = prm%grainSize/(1.0_pReal+prm%grainSize*invLambdaSlip) !* threshold stress for dislocation motion forall (s = 1_pInt:ns) & mse%threshold_stress(s,of) = & lattice_mu(ph)*prm%burgers(s)*& - sqrt(dot_product((stt%rhoEdge(1_pInt:ns,of)+stt%rhoEdgeDip(1_pInt:ns,of)),& - plastic_disloUCLA_interactionMatrix_SlipSlip(s,1:ns,instance))) + sqrt(dot_product(stt%rhoEdge(1_pInt:ns,of)+stt%rhoEdgeDip(1_pInt:ns,of),& + prm%interaction_SlipSlip(s,1:ns))) end associate @@ -910,8 +864,7 @@ math_mul33xx33 stt%accshear_slip(1_pInt:ns, of) c = c + ns case (mfp_ID) - postResults(c+1_pInt:c+ns) =& - mse%mfp(1_pInt:ns, of) + postResults(c+1_pInt:c+ns) = mse%mfp(1_pInt:ns, of) c = c + ns case (resolvedstress_ID) j = 0_pInt @@ -924,8 +877,7 @@ math_mul33xx33 enddo slipSystems1; enddo slipFamilies1 c = c + ns case (thresholdstress_ID) - postResults(c+1_pInt:c+ns) = & - mse%threshold_stress(1_pInt:ns,of) + postResults(c+1_pInt:c+ns) = mse%threshold_stress(1_pInt:ns,of) c = c + ns case (dipoleDistance_ID) j = 0_pInt @@ -998,9 +950,7 @@ ph, instance,of !* Boltzmann ratio BoltzmannRatio = prm%H0kp(j)/(kB*Temperature) !* Initial shear rates - DotGamma0 = & - stt%rhoEdge(j,of)*prm%burgers(j)*& - plastic_disloUCLA_v0PerSlipSystem(j,instance) + DotGamma0 = stt%rhoEdge(j,of)*prm%burgers(j)*prm%v0(j) !* Resolved shear stress on slip system tau_slip_pos(j) = math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)) tau_slip_neg(j) = math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j)) @@ -1008,7 +958,7 @@ ph, instance,of significantPositiveTau: if((abs(tau_slip_pos(j))-mse%threshold_stress(j, of)) > tol_math_check) then !* Stress ratio stressRatio = ((abs(tau_slip_pos(j))-mse%threshold_stress(j, of))/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+& + (prm%solidSolutionStrength+& prm%tau_Peierls(j))) stressRatio_p = stressRatio** prm%p(j) stressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal) @@ -1040,7 +990,7 @@ ph, instance,of * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) *BoltzmannRatio*prm%p(j)& *prm%q(j)/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+prm%tau_Peierls(j))*& + (prm%solidSolutionStrength+prm%tau_Peierls(j))*& StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) &!deltaf(f) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & @@ -1056,7 +1006,7 @@ ph, instance,of * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) *BoltzmannRatio*prm%p(j)& *prm%q(j)/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+prm%tau_Peierls(j))*& + (prm%solidSolutionStrength+prm%tau_Peierls(j))*& StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& !deltaf(f) ) & ) & @@ -1075,7 +1025,7 @@ ph, instance,of significantNegativeTau: if((abs(tau_slip_neg(j))-mse%threshold_stress(j, of)) > tol_math_check) then !* Stress ratios stressRatio = ((abs(tau_slip_neg(j))-mse%threshold_stress(j, of))/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+& + (prm%solidSolutionStrength+& prm%tau_Peierls(j))) stressRatio_p = stressRatio** prm%p(j) stressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal) @@ -1106,7 +1056,7 @@ ph, instance,of * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) *BoltzmannRatio*prm%p(j)& *prm%q(j)/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+prm%tau_Peierls(j))*& + (prm%solidSolutionStrength+prm%tau_Peierls(j))*& StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) &!deltaf(f) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & @@ -1122,7 +1072,7 @@ ph, instance,of * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) *BoltzmannRatio*prm%p(j)& *prm%q(j)/& - (plastic_disloUCLA_SolidSolutionStrength(instance)+prm%tau_Peierls(j))*& + (prm%solidSolutionStrength+prm%tau_Peierls(j))*& StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& !deltaf(f) ) & ) & From 0387486a5288fb5629532375cce014e9cd3023f1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 29 Nov 2018 10:37:06 +0100 Subject: [PATCH 24/47] same name as in dislotwin --- src/plastic_disloUCLA.f90 | 34 ++++++++++++++++------------------ 1 file changed, 16 insertions(+), 18 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 2050cf5b7..9428d714a 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -44,9 +44,7 @@ module plastic_disloUCLA real(pReal), dimension(:,:), allocatable, private :: & plastic_disloUCLA_CLambdaSlipPerSlipFamily, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance - plastic_disloUCLA_CLambdaSlipPerSlipSystem, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance - !* mobility law parameters - plastic_disloUCLA_friction !< friction coeff. B (kMC) + plastic_disloUCLA_CLambdaSlipPerSlipSystem !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance real(pReal), dimension(:,:,:), allocatable, private :: & plastic_disloUCLA_forestProjectionEdge !< matrix of forest projections of edge dislocations for each instance @@ -70,6 +68,7 @@ module plastic_disloUCLA grainSize, & SolidSolutionStrength !< Strength due to elements in solid solution real(pReal), allocatable, dimension(:) :: & + B, & !< friction coeff. B (kMC) rho0, & !< initial edge dislocation density per slip system for each family and instance rhoDip0, & !< initial edge dipole density per slip system for each family and instance burgers, & !< absolute length of burgers vector [m] for each slip system and instance @@ -232,7 +231,6 @@ material_allocatePlasticState allocate(plastic_disloUCLA_Qsd(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_CEdgeDipMinDistance(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_dipoleFormationFactor(maxNinstance), source=1.0_pReal) !should be on by default - allocate(plastic_disloUCLA_friction(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_CLambdaSlipPerSlipFamily(lattice_maxNslipFamily,maxNinstance), & source=0.0_pReal) @@ -284,6 +282,8 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%kink_height = config_phase(p)%getFloats('kink_height') prm%kink_width = config_phase(p)%getFloats('kink_width') prm%omega = config_phase(p)%getFloats('omega') + + prm%B = config_phase(p)%getFloats('friction_coeff') !prm%viscosity = config_phase(p)%getFloats('viscosity') @@ -309,6 +309,7 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%omega = math_expand(prm%omega, prm%Nslip) prm%tau_Peierls = math_expand(prm%tau_Peierls, prm%Nslip) prm%v0 = math_expand(prm%v0, prm%Nslip) + prm%B = math_expand(prm%B, prm%Nslip) endif slipActive @@ -401,16 +402,13 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp do j = 1_pInt, Nchunks_SlipFamilies plastic_disloUCLA_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo - case ('clambdaslip','friction_coeff') + case ('clambdaslip') do j = 1_pInt, Nchunks_SlipFamilies tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo select case(tag) case ('clambdaslip') plastic_disloUCLA_CLambdaSlipPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('friction_coeff') - plastic_disloUCLA_friction(1:Nchunks_SlipFamilies,instance) = & - tempPerSlip(1:Nchunks_SlipFamilies) end select end select endif; endif @@ -487,7 +485,7 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp plasticState(phase)%state (offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NofMyPhase) !* Process slip related parameters ------------------------------------------------ - mySlipFamilies: do f = 1_pInt,lattice_maxNslipFamily + mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) index_myFamily = sum(plastic_disloUCLA_Nslip(1:f-1_pInt,instance)) ! index in truncated slip system list mySlipSystems: do j = 1_pInt,plastic_disloUCLA_Nslip(f,instance) @@ -496,7 +494,7 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp plastic_disloUCLA_CLambdaSlipPerSlipFamily(f,instance) !* Calculation of forest projections for edge dislocations - otherSlipFamilies: do o = 1_pInt,lattice_maxNslipFamily + otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) index_otherFamily = sum(plastic_disloUCLA_Nslip(1:o-1_pInt,instance)) otherSlipSystems: do k = 1_pInt,plastic_disloUCLA_Nslip(o,instance) plastic_disloUCLA_forestProjectionEdge(index_myFamily+j,index_otherFamily+k,instance) = & @@ -970,7 +968,7 @@ ph, instance,of * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & / ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & - + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + + prm%omega(j) * prm%B(j) & *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) @@ -994,14 +992,14 @@ ph, instance,of StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) &!deltaf(f) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & - + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + + prm%omega(j) * prm%B(j) & *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) & - (tau_slip_pos(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & - + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + + prm%omega(j) * prm%B(j) & *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) *BoltzmannRatio*prm%p(j)& @@ -1013,7 +1011,7 @@ ph, instance,of / ( & ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & - + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + + prm%omega(j) * prm%B(j) & *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & )**2.0_pReal & @@ -1037,7 +1035,7 @@ ph, instance,of * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & / ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & - + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + + prm%omega(j) * prm%B(j) & *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) @@ -1060,14 +1058,14 @@ ph, instance,of StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) &!deltaf(f) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & - + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + + prm%omega(j) * prm%B(j) & *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) & - (tau_slip_neg(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & - + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + + prm%omega(j) * prm%B(j) & *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) *BoltzmannRatio*prm%p(j)& @@ -1079,7 +1077,7 @@ ph, instance,of / ( & ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & - + prm%omega(j) * plastic_disloUCLA_friction(f,instance) & + + prm%omega(j) * prm%B(j) & *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & )**2.0_pReal & From 47e32b39b9df37f4729b289e5937c7a4ff19951b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 30 Nov 2018 07:27:23 +0100 Subject: [PATCH 25/47] avoid unallocated array for elasticity only --- src/plastic_disloUCLA.f90 | 66 +++++++++++++++------------------------ 1 file changed, 26 insertions(+), 40 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 9428d714a..2c7fd9b6d 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -42,9 +42,6 @@ module plastic_disloUCLA plastic_disloUCLA_CEdgeDipMinDistance, & !< plastic_disloUCLA_dipoleFormationFactor !< scaling factor for dipole formation: 0: off, 1: on. other values not useful - real(pReal), dimension(:,:), allocatable, private :: & - plastic_disloUCLA_CLambdaSlipPerSlipFamily, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance - plastic_disloUCLA_CLambdaSlipPerSlipSystem !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance real(pReal), dimension(:,:,:), allocatable, private :: & plastic_disloUCLA_forestProjectionEdge !< matrix of forest projections of edge dislocations for each instance @@ -231,10 +228,6 @@ material_allocatePlasticState allocate(plastic_disloUCLA_Qsd(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_CEdgeDipMinDistance(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_dipoleFormationFactor(maxNinstance), source=1.0_pReal) !should be on by default - - allocate(plastic_disloUCLA_CLambdaSlipPerSlipFamily(lattice_maxNslipFamily,maxNinstance), & - source=0.0_pReal) - allocate(param(maxNinstance)) allocate(state(maxNinstance)) @@ -275,7 +268,7 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%burgers = config_phase(p)%getFloats('slipburgers') prm%H0kp = config_phase(p)%getFloats('qedge') prm%v0 = config_phase(p)%getFloats('v0') - !prm%clambda = config_phase(p)%getFloats('clambda') + prm%clambda = config_phase(p)%getFloats('clambdaslip') prm%tau_Peierls = config_phase(p)%getFloats('tau_peierls') prm%p = config_phase(p)%getFloats('p_slip',defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) prm%q = config_phase(p)%getFloats('q_slip',defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) @@ -310,6 +303,22 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%tau_Peierls = math_expand(prm%tau_Peierls, prm%Nslip) prm%v0 = math_expand(prm%v0, prm%Nslip) prm%B = math_expand(prm%B, prm%Nslip) + prm%clambda = math_expand(prm%clambda, prm%Nslip) + + instance = phase_plasticityInstance(p) + if (plastic_disloUCLA_CAtomicVolume(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOUCLA_label//')') + if (plastic_disloUCLA_D0(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='D0 ('//PLASTICITY_DISLOUCLA_label//')') + if (plastic_disloUCLA_Qsd(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='Qsd ('//PLASTICITY_DISLOUCLA_label//')') + ! if (plastic_disloUCLA_aTolRho(instance) <= 0.0_pReal) & + ! call IO_error(211_pInt,el=instance,ext_msg='aTolRho ('//PLASTICITY_DISLOUCLA_label//')') + + else slipActive + allocate(prm%rho0(0)) + allocate(prm%rhoDip0(0)) + endif slipActive @@ -402,14 +411,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp do j = 1_pInt, Nchunks_SlipFamilies plastic_disloUCLA_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo - case ('clambdaslip') - do j = 1_pInt, Nchunks_SlipFamilies - tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - select case(tag) - case ('clambdaslip') - plastic_disloUCLA_CLambdaSlipPerSlipFamily(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - end select end select endif; endif enddo parsingFile @@ -433,15 +434,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp ! call IO_error(211_pInt,el=instance,ext_msg='tau_peierls ('//PLASTICITY_DISLOUCLA_label//')') endif enddo - if (plastic_disloUCLA_CAtomicVolume(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOUCLA_label//')') - if (plastic_disloUCLA_D0(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='D0 ('//PLASTICITY_DISLOUCLA_label//')') - if (plastic_disloUCLA_Qsd(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='Qsd ('//PLASTICITY_DISLOUCLA_label//')') - ! if (plastic_disloUCLA_aTolRho(instance) <= 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='aTolRho ('//PLASTICITY_DISLOUCLA_label//')') - !-------------------------------------------------------------------------------------------------- ! Determine total number of active slip systems plastic_disloUCLA_Nslip(:,instance) = min(lattice_NslipSystem(:,phase),plastic_disloUCLA_Nslip(:,instance)) @@ -453,8 +445,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp ! allocation of variables whose size depends on the total number of active slip systems maxTotalNslip = maxval(plastic_disloUCLA_totalNslip) - allocate(plastic_disloUCLA_CLambdaSlipPerSlipSystem(maxTotalNslip, maxNinstance),source=0.0_pReal) - allocate(plastic_disloUCLA_forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstance), & source=0.0_pReal) @@ -488,10 +478,6 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) index_myFamily = sum(plastic_disloUCLA_Nslip(1:f-1_pInt,instance)) ! index in truncated slip system list mySlipSystems: do j = 1_pInt,plastic_disloUCLA_Nslip(f,instance) - - - plastic_disloUCLA_CLambdaSlipPerSlipSystem(index_myFamily+j,instance) = & - plastic_disloUCLA_CLambdaSlipPerSlipFamily(f,instance) !* Calculation of forest projections for edge dislocations otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) @@ -580,7 +566,7 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) invLambdaSlip(s) = & sqrt(dot_product((stt%rhoEdge(1_pInt:ns,of)+stt%rhoEdgeDip(1_pInt:ns,of)),& plastic_disloUCLA_forestProjectionEdge(1:ns,s,instance)))/ & - plastic_disloUCLA_CLambdaSlipPerSlipSystem(s,instance) + prm%Clambda(s) !* mean free path between 2 obstacles seen by a moving dislocation @@ -985,11 +971,11 @@ ph, instance,of * ( & (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + tau_slip_pos(j) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& *BoltzmannRatio*prm%p(j)& *prm%q(j)/& (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) &!deltaf(f) + StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) & ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + prm%omega(j) * prm%B(j) & @@ -1001,11 +987,11 @@ ph, instance,of * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & + prm%omega(j) * prm%B(j) & *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& *BoltzmannRatio*prm%p(j)& *prm%q(j)/& (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& !deltaf(f) + StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& ) & ) & / ( & @@ -1051,11 +1037,11 @@ ph, instance,of * ( & (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + tau_slip_neg(j) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& *BoltzmannRatio*prm%p(j)& *prm%q(j)/& (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) &!deltaf(f) + StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) & ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + prm%omega(j) * prm%B(j) & @@ -1067,11 +1053,11 @@ ph, instance,of * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & + prm%omega(j) * prm%B(j) & *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& !deltaf(i) + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& *BoltzmannRatio*prm%p(j)& *prm%q(j)/& (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& !deltaf(f) + StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& ) & ) & / ( & From c4df2eeac49483164c32dc63b2e03ba0799695df Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 30 Nov 2018 07:46:26 +0100 Subject: [PATCH 26/47] no need to know the phase id --- src/plastic_disloUCLA.f90 | 70 ++++++++++++++------------------------- 1 file changed, 24 insertions(+), 46 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 2c7fd9b6d..ce562a437 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -556,7 +556,7 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) !* Shortened notation of = phasememberAt(ipc,ip,el) ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) + instance = phase_plasticityInstance(phaseAt(ipc,ip,el)) ns = plastic_disloUCLA_totalNslip(instance) @@ -600,21 +600,20 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,ipc,ip,el real(pReal), dimension(3,3), intent(out) :: Lp real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp - integer(pInt) :: instance,ph,of,i,k,l,m,n + integer(pInt) :: instance,of,i,k,l,m,n real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_slip_pos,gdot_slip_neg,tau_slip_pos,tau_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg !* Shortened notation of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) + instance = phase_plasticityInstance(phaseAt(ipc,ip,el)) associate(prm => param(instance)) Lp = 0.0_pReal dLp_dMp = 0.0_pReal - call kinetics(Mp,Temperature,ph,instance,of, & + call kinetics(Mp,Temperature,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) slipSystems: do i = 1_pInt, prm%totalNslip Lp = Lp + (gdot_slip_pos(i)+gdot_slip_neg(i))*prm%Schmid_slip(1:3,1:3,i) @@ -689,7 +688,7 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) plasticState(ph)%dotState(:,of) = 0.0_pReal associate(prm => param(instance), stt => state(instance),mse => microstructure(instance)) !* Dislocation density evolution - call kinetics(Mp,Temperature,ph,instance,of, & + call kinetics(Mp,Temperature,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) dotState(instance)%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)*0.5_pReal @@ -777,9 +776,6 @@ math_mul33xx33 !plasticState, & phaseAt, phasememberAt use lattice, only: & - lattice_Sslip, & - lattice_maxNslipFamily, & - lattice_NslipSystem, & lattice_mu implicit none @@ -798,7 +794,7 @@ math_mul33xx33 integer(pInt) :: & instance,& ns,& - f,o,i,c,j,index_myFamily,& + o,i,c,j,& ph, & of real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & @@ -824,7 +820,7 @@ math_mul33xx33 postResults(c+1_pInt:c+ns) = stt%rhoEdgeDip(1_pInt:ns,of) c = c + ns case (shearrate_ID,stressexponent_ID) - call kinetics(Mp,Temperature,ph,instance,of, & + call kinetics(Mp,Temperature,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) if (plastic_disloUCLA_outputID(o,instance) == shearrate_ID) then @@ -851,34 +847,25 @@ math_mul33xx33 postResults(c+1_pInt:c+ns) = mse%mfp(1_pInt:ns, of) c = c + ns case (resolvedstress_ID) - j = 0_pInt - slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) - j = j + 1_pInt - postResults(c+j) =& - math_mul33xx33(Mp,lattice_Sslip(:,:,1,index_myFamily+i,ph)) - enddo slipSystems1; enddo slipFamilies1 + do j = 1_pInt, prm%totalNslip + + postResults(c+j) =math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)) + enddo c = c + ns case (thresholdstress_ID) postResults(c+1_pInt:c+ns) = mse%threshold_stress(1_pInt:ns,of) c = c + ns case (dipoleDistance_ID) - j = 0_pInt - slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems2: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) - j = j + 1_pInt - if (dNeq0(abs(math_mul33xx33(Mp,lattice_Sslip(:,:,1,index_myFamily+i,ph))))) then + do j = 1_pInt, prm%totalNslip + if (dNeq0(abs(math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j))))) then postResults(c+j) = & (3.0_pReal*lattice_mu(ph)*prm%burgers(j))/& - (16.0_pReal*pi*abs(math_mul33xx33(Mp,lattice_Sslip(:,:,1,index_myFamily+i,ph)))) + (16.0_pReal*pi*abs(math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)))) else postResults(c+j) = huge(1.0_pReal) endif - postResults(c+j)=min(postResults(c+j),& - mse%mfp(j,of)) - enddo slipSystems2; enddo slipFamilies2 + postResults(c+j)=min(postResults(c+j),mse%mfp(j,of)) + enddo c = c + ns end select enddo @@ -889,7 +876,7 @@ end function plastic_disloUCLA_postResults !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -subroutine kinetics(Mp,Temperature,ph,instance,of, & +subroutine kinetics(Mp,Temperature,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) use prec, only: & tol_math_check, & @@ -897,9 +884,6 @@ subroutine kinetics(Mp,Temperature,ph,instance,of, & use math, only: & pi, & math_mul33xx33 - use lattice, only: & - lattice_maxNslipFamily, & - lattice_NslipSystem implicit none real(pReal), dimension(3,3), intent(in) :: & @@ -907,10 +891,9 @@ math_mul33xx33 real(pReal), intent(in) :: & temperature !< temperature at integration point integer(pInt), intent(in) :: & -ph, instance,of +instance,of integer(pInt) :: & - ns,& f,i,j,index_myFamily real(pReal) :: StressRatio_p,StressRatio_pminus1,& BoltzmannRatio,DotGamma0,stressRatio,& @@ -918,19 +901,14 @@ ph, instance,of real(pReal), intent(out), dimension(plastic_disloUCLA_totalNslip(instance)) :: & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg associate(prm => param(instance), stt => state(instance),mse => microstructure(instance)) - !* Shortened notation - ns = plastic_disloUCLA_totalNslip(instance) + gdot_slip_pos = 0.0_pReal gdot_slip_neg = 0.0_pReal dgdot_dtauslip_pos = 0.0_pReal dgdot_dtauslip_neg = 0.0_pReal - j = 0_pInt - slipFamilies: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) - j = j + 1_pInt + do j = 1_pInt, prm%totalNslip !* Boltzmann ratio BoltzmannRatio = prm%H0kp(j)/(kB*Temperature) !* Initial shear rates @@ -1006,6 +984,8 @@ ph, instance,of dgdot_dtauslip_pos(j) = DotGamma0 * dvel_slip endif significantPositiveTau + + significantNegativeTau: if((abs(tau_slip_neg(j))-mse%threshold_stress(j, of)) > tol_math_check) then !* Stress ratios stressRatio = ((abs(tau_slip_neg(j))-mse%threshold_stress(j, of))/& @@ -1071,10 +1051,8 @@ ph, instance,of dgdot_dtauslip_neg(j) = DotGamma0 * dvel_slip - - endif significantNegativeTau - enddo slipSystems - enddo slipFamilies + endif significantNegativeTau + enddo end associate end subroutine kinetics From 4e86d239de890bdc0c4234ef033d320808bb0ef3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 30 Nov 2018 08:25:23 +0100 Subject: [PATCH 27/47] simplified --- src/plastic_disloUCLA.f90 | 59 +++++++++++++-------------------------- 1 file changed, 19 insertions(+), 40 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index ce562a437..866dfbee6 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -63,7 +63,8 @@ module plastic_disloUCLA real(pReal) :: & aTolRho, & grainSize, & -SolidSolutionStrength !< Strength due to elements in solid solution + SolidSolutionStrength, & !< Strength due to elements in solid solution + mu real(pReal), allocatable, dimension(:) :: & B, & !< friction coeff. B (kMC) rho0, & !< initial edge dislocation density per slip system for each family and instance @@ -242,6 +243,7 @@ do p = 1_pInt, size(phase_plasticityInstance) stt => state(phase_plasticityInstance(p))) structure = config_phase(p)%getString('lattice_structure') + prm%mu = lattice_mu(p) prm%aTolRho = config_phase(p)%getFloat('atol_rho') !-------------------------------------------------------------------------------------------------- @@ -306,6 +308,7 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%clambda = math_expand(prm%clambda, prm%Nslip) instance = phase_plasticityInstance(p) + plastic_disloUCLA_totalNslip(instance) = prm%totalNslip if (plastic_disloUCLA_CAtomicVolume(instance) <= 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOUCLA_label//')') if (plastic_disloUCLA_D0(instance) <= 0.0_pReal) & @@ -418,10 +421,7 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp sanityChecks: do phase = 1_pInt, size(phase_plasticity) myPhase: if (phase_plasticity(phase) == PLASTICITY_disloUCLA_ID) then instance = phase_plasticityInstance(phase) - if (sum(plastic_disloUCLA_Nslip(:,instance)) < 0_pInt) & - call IO_error(211_pInt,el=instance,ext_msg='Nslip ('//PLASTICITY_DISLOUCLA_label//')') do f = 1_pInt,lattice_maxNslipFamily - if (plastic_disloUCLA_Nslip(f,instance) > 0_pInt) then !if (plastic_disloUCLA_rhoEdge0(f,instance) < 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='rhoEdge0 ('//PLASTICITY_DISLOUCLA_label//')') !if (plastic_disloUCLA_rhoEdgeDip0(f,instance) < 0.0_pReal) & @@ -432,12 +432,10 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp ! call IO_error(211_pInt,el=instance,ext_msg='v0 ('//PLASTICITY_DISLOUCLA_label//')') !if (plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance) < 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='tau_peierls ('//PLASTICITY_DISLOUCLA_label//')') - endif enddo !-------------------------------------------------------------------------------------------------- ! Determine total number of active slip systems plastic_disloUCLA_Nslip(:,instance) = min(lattice_NslipSystem(:,phase),plastic_disloUCLA_Nslip(:,instance)) - plastic_disloUCLA_totalNslip(instance) = sum(plastic_disloUCLA_Nslip(:,instance)) endif myPhase enddo sanityChecks @@ -476,13 +474,13 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp !* Process slip related parameters ------------------------------------------------ mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) - index_myFamily = sum(plastic_disloUCLA_Nslip(1:f-1_pInt,instance)) ! index in truncated slip system list - mySlipSystems: do j = 1_pInt,plastic_disloUCLA_Nslip(f,instance) + index_myFamily = sum(prm%Nslip(1:f-1_pInt)) ! index in truncated slip system list + mySlipSystems: do j = 1_pInt,prm%Nslip(f) !* Calculation of forest projections for edge dislocations otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) - index_otherFamily = sum(plastic_disloUCLA_Nslip(1:o-1_pInt,instance)) - otherSlipSystems: do k = 1_pInt,plastic_disloUCLA_Nslip(o,instance) + index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) + otherSlipSystems: do k = 1_pInt,prm%Nslip(o) plastic_disloUCLA_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))) @@ -535,8 +533,6 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) phase_plasticityInstance, & phaseAt, phasememberAt, & material_phase - use lattice, only: & - lattice_mu implicit none integer(pInt), intent(in) :: & @@ -549,13 +545,11 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) integer(pInt) :: & instance, & ns,s, & - ph, & of real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & invLambdaSlip !* Shortened notation of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(phaseAt(ipc,ip,el)) ns = plastic_disloUCLA_totalNslip(instance) @@ -575,7 +569,7 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) !* threshold stress for dislocation motion forall (s = 1_pInt:ns) & mse%threshold_stress(s,of) = & - lattice_mu(ph)*prm%burgers(s)*& + prm%mu*prm%burgers(s)*& sqrt(dot_product(stt%rhoEdge(1_pInt:ns,of)+stt%rhoEdgeDip(1_pInt:ns,of),& prm%interaction_SlipSlip(s,1:ns))) end associate @@ -644,10 +638,6 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) phase_plasticityInstance, & plasticState, & phaseAt, phasememberAt - use lattice, only: & - lattice_maxNslipFamily, & - lattice_NslipSystem, & - lattice_mu implicit none real(pReal), dimension(3,3), intent(in):: & @@ -659,8 +649,7 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) ip, & !< integration point el !< element - integer(pInt) :: instance,ns,f,i,j,index_myFamily, & - ph, & + integer(pInt) :: instance,ns,f,i,j, & of real(pReal) :: & EdgeDipMinDistance,& @@ -681,22 +670,17 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) !* Shortened notation of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) + instance = phase_plasticityInstance(phaseAt(ipc,ip,el)) ns = plastic_disloUCLA_totalNslip(instance) - plasticState(ph)%dotState(:,of) = 0.0_pReal + plasticState(phaseAt(ipc,ip,el))%dotState(:,of) = 0.0_pReal associate(prm => param(instance), stt => state(instance),mse => microstructure(instance)) !* Dislocation density evolution call kinetics(Mp,Temperature,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) dotState(instance)%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)*0.5_pReal - j = 0_pInt - slipFamilies: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) - j = j+1_pInt +do j = 1_pInt, prm%totalNslip !* Multiplication DotRhoMultiplication = abs(dotState(instance)%accshear_slip(j,of))/& @@ -710,7 +694,7 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) DotRhoDipFormation = 0.0_pReal else EdgeDipDistance = & - (3.0_pReal*lattice_mu(ph)*prm%burgers(j))/& + (3.0_pReal*prm%mu*prm%burgers(j))/& (16.0_pReal*pi*abs(tau_slip_pos(j))) if (EdgeDipDistance>mse%mfp(j,of)) EdgeDipDistance=mse%mfp(j,of) if (EdgeDipDistance Date: Fri, 30 Nov 2018 08:36:56 +0100 Subject: [PATCH 28/47] no need to parse the file --- src/plastic_disloUCLA.f90 | 74 ++++----------------------------------- 1 file changed, 6 insertions(+), 68 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 866dfbee6..3f7fe52d9 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -155,18 +155,8 @@ subroutine plastic_disloUCLA_init(fileUnit) math_mul3x3, & math_expand use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & IO_error, & - IO_timeStamp, & - IO_EOF + IO_timeStamp use material, only: & phase_plasticity, & phase_plasticityInstance, & @@ -184,11 +174,9 @@ material_allocatePlasticState implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,phase,maxTotalNslip,& f,instance,j,k,o,ns, i, & - Nchunks_SlipSlip = 0_pInt, outputSize, & - Nchunks_SlipFamilies = 0_pInt,Nchunks_nonSchmid = 0_pInt, & + outputSize, & offset_slip, index_myFamily, index_otherFamily, & startIndex, endIndex, p integer(pInt) :: sizeState, sizeDotState @@ -375,53 +363,8 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp end associate enddo - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - 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 - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - if (phase_plasticity(phase) == PLASTICITY_DISLOUCLA_ID) then - Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) - Nchunks_nonSchmid = lattice_NnonSchmid(phase) - if(allocated(tempPerSlip)) deallocate(tempPerSlip) - allocate(tempPerSlip(Nchunks_SlipFamilies)) - endif - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_DISLOUCLA_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 - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of slip system families - case ('nslip') - if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) & - call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') - if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') - Nchunks_SlipFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_SlipFamilies - plastic_disloUCLA_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - end select - endif; endif - enddo parsingFile - - sanityChecks: do phase = 1_pInt, size(phase_plasticity) - myPhase: if (phase_plasticity(phase) == PLASTICITY_disloUCLA_ID) then - instance = phase_plasticityInstance(phase) - do f = 1_pInt,lattice_maxNslipFamily + !if (plastic_disloUCLA_rhoEdge0(f,instance) < 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='rhoEdge0 ('//PLASTICITY_DISLOUCLA_label//')') !if (plastic_disloUCLA_rhoEdgeDip0(f,instance) < 0.0_pReal) & @@ -432,12 +375,7 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp ! call IO_error(211_pInt,el=instance,ext_msg='v0 ('//PLASTICITY_DISLOUCLA_label//')') !if (plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance) < 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='tau_peierls ('//PLASTICITY_DISLOUCLA_label//')') - enddo -!-------------------------------------------------------------------------------------------------- -! Determine total number of active slip systems - plastic_disloUCLA_Nslip(:,instance) = min(lattice_NslipSystem(:,phase),plastic_disloUCLA_Nslip(:,instance)) - endif myPhase - enddo sanityChecks + !-------------------------------------------------------------------------------------------------- ! allocation of variables whose size depends on the total number of active slip systems @@ -649,7 +587,7 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) ip, & !< integration point el !< element - integer(pInt) :: instance,ns,f,i,j, & + integer(pInt) :: instance,ns,j, & of real(pReal) :: & EdgeDipMinDistance,& @@ -775,7 +713,7 @@ math_mul33xx33 integer(pInt) :: & instance,& ns,& - o,i,c,j,& + o,c,j,& of real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg From bbba2013626144ebe5cc936b9e817a8f40a4fae7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 30 Nov 2018 10:04:41 +0100 Subject: [PATCH 29/47] simpler API --- src/constitutive.f90 | 9 ++++--- src/plastic_disloUCLA.f90 | 53 ++++++++++++--------------------------- 2 files changed, 22 insertions(+), 40 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index bb52ab3cc..f01c82f75 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -926,8 +926,9 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac call plastic_dislotwin_dotState (Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_DISLOUCLA_ID) plasticityType - call plastic_disloucla_dotState (Mp,temperature(ho)%p(tme), & - ipc,ip,el) + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + call plastic_disloucla_dotState (Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_dotState (math_Mandel33to6(Mp),FeArray,FpArray,temperature(ho)%p(tme), & @@ -1153,8 +1154,10 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) plastic_dislotwin_postResults(Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_DISLOUCLA_ID) plasticityType + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) constitutive_postResults(startPos:endPos) = & - plastic_disloucla_postResults(Mp,temperature(ho)%p(tme),ipc,ip,el) + plastic_disloucla_postResults(Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType constitutive_postResults(startPos:endPos) = & diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 3f7fe52d9..20badb904 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -106,7 +106,8 @@ module plastic_disloUCLA real(pReal), pointer, dimension(:,:) :: & rhoEdge, & rhoEdgeDip, & - accshear_slip + accshear_slip, & + whole end type type, private :: tDisloUCLAMicrostructure @@ -447,6 +448,8 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = 1e6_pReal + dotState(instance)%whole => plasticState(phase)%dotState + allocate(mse%mfp(prm%totalNslip,NofMyPhase),source=0.0_pReal) allocate(mse%threshold_stress(prm%totalNslip,NofMyPhase),source=0.0_pReal) @@ -565,17 +568,12 @@ end subroutine plastic_disloUCLA_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) +subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) use prec, only: & tol_math_check, & dEq0 use math, only: & pi - use material, only: & - material_phase, & - phase_plasticityInstance, & - plasticState, & - phaseAt, phasememberAt implicit none real(pReal), dimension(3,3), intent(in):: & @@ -583,12 +581,9 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) real(pReal), intent(in) :: & temperature !< temperature at integration point integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + instance, of + integer(pInt) :: ns,j - integer(pInt) :: instance,ns,j, & - of real(pReal) :: & EdgeDipMinDistance,& AtomicVolume,& @@ -600,18 +595,15 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,ipc,ip,el) ClimbVelocity, & DotRhoEdgeDipClimb, & DotRhoDipFormation - real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(plastic_disloUCLA_totalNslip(instance)) :: & gdot_slip_pos, gdot_slip_neg,& tau_slip_pos,& tau_slip_neg, & dgdot_dtauslip_neg,dgdot_dtauslip_pos - !* Shortened notation - of = phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(phaseAt(ipc,ip,el)) ns = plastic_disloUCLA_totalNslip(instance) + dotState(instance)%whole(:,of) = 0.0_pReal - plasticState(phaseAt(ipc,ip,el))%dotState(:,of) = 0.0_pReal associate(prm => param(instance), stt => state(instance),mse => microstructure(instance)) !* Dislocation density evolution call kinetics(Mp,Temperature,instance,of, & @@ -684,18 +676,13 @@ end subroutine plastic_disloUCLA_dotState !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -function plastic_disloUCLA_postResults(Mp,Temperature,ipc,ip,el) result(postResults) +function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postResults) use prec, only: & tol_math_check, & dEq, dNeq0 use math, only: & pi, & math_mul33xx33 - use material, only: & - material_phase, & - phase_plasticityInstance,& - !plasticState, & - phaseAt, phasememberAt implicit none real(pReal), dimension(3,3), intent(in) :: & @@ -703,27 +690,19 @@ math_mul33xx33 real(pReal), intent(in) :: & temperature !< temperature at integration point integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + instance,of - real(pReal), dimension(plastic_disloUCLA_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(plastic_disloUCLA_sizePostResults(instance)) :: & postResults integer(pInt) :: & - instance,& ns,& - o,c,j,& - of - real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + o,c,j + real(pReal), dimension(plastic_disloUCLA_totalNslip(instance)) :: & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg - - !* Shortened notation - of = phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(phaseAt(ipc,ip,el)) + ns = plastic_disloUCLA_totalNslip(instance) - - !* Required output + c = 0_pInt postResults = 0.0_pReal associate (prm => param(instance),stt =>state(instance),mse => microstructure(instance)) From fb651e24efbf798435fdf2b71a48d2057d48df22 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 3 Dec 2018 10:48:37 +0100 Subject: [PATCH 30/47] same structure as in phenopowerlaw --- src/plastic_disloUCLA.f90 | 136 +++++++++++++++++--------------------- 1 file changed, 62 insertions(+), 74 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 20badb904..02b8d3c34 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -678,94 +678,82 @@ end subroutine plastic_disloUCLA_dotState !-------------------------------------------------------------------------------------------------- function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postResults) use prec, only: & - tol_math_check, & dEq, dNeq0 use math, only: & pi, & -math_mul33xx33 + math_mul33xx33 implicit none - real(pReal), dimension(3,3), intent(in) :: & - Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation - real(pReal), intent(in) :: & - temperature !< temperature at integration point - integer(pInt), intent(in) :: & - instance,of + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + real(pReal), intent(in) :: & + Temperature !< Mandel stress + integer(pInt), intent(in) :: & + instance, & + of - real(pReal), dimension(plastic_disloUCLA_sizePostResults(instance)) :: & - postResults + real(pReal), dimension(sum(plastic_disloUCLA_sizePostResult(:,instance))) :: & + postResults integer(pInt) :: & - ns,& - o,c,j - real(pReal), dimension(plastic_disloUCLA_totalNslip(instance)) :: & - gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg + o,c,i + real(pReal), dimension(param(instance)%totalNslip) :: & + gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos, & + gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg - ns = plastic_disloUCLA_totalNslip(instance) + associate( prm => param(instance), stt => state(instance), mse => microstructure(instance)) - c = 0_pInt postResults = 0.0_pReal - associate (prm => param(instance),stt =>state(instance),mse => microstructure(instance)) - do o = 1_pInt,plastic_disloUCLA_Noutput(instance) - select case(plastic_disloUCLA_outputID(o,instance)) - - case (rho_ID) - postResults(c+1_pInt:c+ns) = stt%rhoEdge(1_pInt:ns,of) - c = c + ns - case (rhoDip_ID) - postResults(c+1_pInt:c+ns) = stt%rhoEdgeDip(1_pInt:ns,of) - c = c + ns - case (shearrate_ID,stressexponent_ID) - call kinetics(Mp,Temperature,instance,of, & - gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) + c = 0_pInt - if (plastic_disloUCLA_outputID(o,instance) == shearrate_ID) then - postResults(c+1:c+ns) = (gdot_slip_pos + gdot_slip_neg)*0.5_pReal - c = c + ns - elseif(plastic_disloUCLA_outputID(o,instance) == stressexponent_ID) then - do j = 1_pInt, ns - if (dEq(gdot_slip_pos(j)+gdot_slip_neg(j),0.0_pReal)) then - postResults(c+j) = 0.0_pReal - else - postResults(c+j) = (tau_slip_pos(j)+tau_slip_neg(j))/& - (gdot_slip_pos(j)+gdot_slip_neg(j))*& - (dgdot_dtauslip_pos(j)+dgdot_dtauslip_neg(j))* 0.5_pReal - endif - enddo - c = c + ns - endif + outputsLoop: do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) - case (accumulatedshear_ID) - postResults(c+1_pInt:c+ns) = & - stt%accshear_slip(1_pInt:ns, of) - c = c + ns - case (mfp_ID) - postResults(c+1_pInt:c+ns) = mse%mfp(1_pInt:ns, of) - c = c + ns - case (resolvedstress_ID) - do j = 1_pInt, prm%totalNslip + case (rho_ID) + postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdge(1_pInt:prm%totalNslip,of) + case (rhoDip_ID) + postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdgeDip(1_pInt:prm%totalNslip,of) + case (shearrate_ID,stressexponent_ID) + call kinetics(Mp,Temperature,instance,of, & + gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) + + if (prm%outputID(o) == shearrate_ID) then + postResults(c+1:c+prm%totalNslip) = (gdot_slip_pos + gdot_slip_neg)*0.5_pReal + elseif(prm%outputID(o) == stressexponent_ID) then + where (dNeq0(gdot_slip_pos+gdot_slip_neg)) + postResults(c+1_pInt:c + prm%totalNslip) = (tau_slip_pos+tau_slip_neg) * 0.5_pReal & + / (gdot_slip_pos+gdot_slip_neg) & + * (dgdot_dtauslip_pos+dgdot_dtauslip_neg) + else where + postResults(c+1_pInt:c + prm%totalNslip) = 0.0_pReal + end where + endif + case (accumulatedshear_ID) + postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1_pInt:prm%totalNslip, of) + case (mfp_ID) + postResults(c+1_pInt:c+prm%totalNslip) = mse%mfp(1_pInt:prm%totalNslip, of) + case (resolvedstress_ID) + do i = 1_pInt, prm%totalNslip + postResults(c+i) =math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,i)) + enddo + case (thresholdstress_ID) + postResults(c+1_pInt:c+prm%totalNslip) = mse%threshold_stress(1_pInt:prm%totalNslip,of) + case (dipoleDistance_ID) + do i = 1_pInt, prm%totalNslip + if (dNeq0(abs(math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,i))))) then + postResults(c+i) = (3.0_pReal*prm%mu*prm%burgers(i)) & + / (16.0_pReal*pi*abs(math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,i)))) + else + postResults(c+i) = huge(1.0_pReal) + endif + postResults(c+i)=min(postResults(c+i),mse%mfp(i,of)) + enddo + end select + + c = c + prm%totalNslip + enddo outputsLoop + end associate - postResults(c+j) =math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)) - enddo - c = c + ns - case (thresholdstress_ID) - postResults(c+1_pInt:c+ns) = mse%threshold_stress(1_pInt:ns,of) - c = c + ns - case (dipoleDistance_ID) - do j = 1_pInt, prm%totalNslip - if (dNeq0(abs(math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j))))) then - postResults(c+j) = & - (3.0_pReal*prm%mu*prm%burgers(j))/& - (16.0_pReal*pi*abs(math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)))) - else - postResults(c+j) = huge(1.0_pReal) - endif - postResults(c+j)=min(postResults(c+j),mse%mfp(j,of)) - enddo - c = c + ns - end select - enddo -end associate end function plastic_disloUCLA_postResults From 49b5271ca4d403684b05697cd1be610277563c4e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 3 Dec 2018 11:25:29 +0100 Subject: [PATCH 31/47] simplified --- src/plastic_disloUCLA.f90 | 41 ++++++++++++--------------------------- 1 file changed, 12 insertions(+), 29 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 02b8d3c34..5e8e76052 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -13,9 +13,6 @@ module plastic_disloUCLA implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_disloUCLA_sizePostResults !< cumulative size of post results - integer(pInt), dimension(:,:), allocatable, target, public :: & plastic_disloUCLA_sizePostResult !< size of each post result output @@ -25,9 +22,6 @@ module plastic_disloUCLA real(pReal), parameter, private :: & kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin - integer(pInt), dimension(:), allocatable, target, public :: & - plastic_disloUCLA_Noutput !< number of outputs per instance of this plasticity - integer(pInt), dimension(:), allocatable, private :: & plastic_disloUCLA_totalNslip !< total number of active slip systems for each instance @@ -37,7 +31,6 @@ module plastic_disloUCLA real(pReal), dimension(:), allocatable, private :: & plastic_disloUCLA_CAtomicVolume, & !< atomic volume in Bugers vector unit - plastic_disloUCLA_D0, & !< prefactor for self-diffusion coefficient plastic_disloUCLA_Qsd, & !< activation energy for dislocation climb plastic_disloUCLA_CEdgeDipMinDistance, & !< plastic_disloUCLA_dipoleFormationFactor !< scaling factor for dipole formation: 0: off, 1: on. other values not useful @@ -64,7 +57,8 @@ module plastic_disloUCLA aTolRho, & grainSize, & SolidSolutionStrength, & !< Strength due to elements in solid solution - mu + mu, & + D0 !< prefactor for self-diffusion coefficient real(pReal), allocatable, dimension(:) :: & B, & !< friction coeff. B (kMC) rho0, & !< initial edge dislocation density per slip system for each family and instance @@ -99,8 +93,6 @@ module plastic_disloUCLA end type !< container type for internal constitutive parameters type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - plastic_disloUCLA_outputID !< ID of each post result output type, private :: tDisloUCLAState real(pReal), pointer, dimension(:,:) :: & @@ -183,10 +175,7 @@ material_allocatePlasticState integer(pInt) :: sizeState, sizeDotState integer(pInt) :: NofMyPhase character(len=65536) :: & - structure = '',& - tag = '', & - line = '' - real(pReal), dimension(:), allocatable :: tempPerSlip + structure = '' character(len=65536), dimension(:), allocatable :: outputs integer(kind(undefined_ID)) :: outputID integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] @@ -205,16 +194,15 @@ material_allocatePlasticState if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(plastic_disloUCLA_sizePostResults(maxNinstance), source=0_pInt) allocate(plastic_disloUCLA_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) allocate(plastic_disloUCLA_output(maxval(phase_Noutput),maxNinstance)) plastic_disloUCLA_output = '' - allocate(plastic_disloUCLA_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) - allocate(plastic_disloUCLA_Noutput(maxNinstance), source=0_pInt) + + allocate(plastic_disloUCLA_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) allocate(plastic_disloUCLA_totalNslip(maxNinstance), source=0_pInt) allocate(plastic_disloUCLA_CAtomicVolume(maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_D0(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_Qsd(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_CEdgeDipMinDistance(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_dipoleFormationFactor(maxNinstance), source=1.0_pReal) !should be on by default @@ -275,7 +263,7 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%grainSize = config_phase(p)%getFloat('grainsize') - plastic_disloUCLA_D0(phase_plasticityInstance(p)) = config_phase(p)%getFloat('qsd') + prm%D0 = config_phase(p)%getFloat('d0') plastic_disloUCLA_Qsd(phase_plasticityInstance(p)) = config_phase(p)%getFloat('qsd') plastic_disloUCLA_CEdgeDipMinDistance(phase_plasticityInstance(p)) = config_phase(p)%getFloat('cedgedipmindistance') plastic_disloUCLA_CAtomicVolume(phase_plasticityInstance(p)) = config_phase(p)%getFloat('catomicvolume') @@ -298,9 +286,9 @@ do p = 1_pInt, size(phase_plasticityInstance) instance = phase_plasticityInstance(p) plastic_disloUCLA_totalNslip(instance) = prm%totalNslip - if (plastic_disloUCLA_CAtomicVolume(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOUCLA_label//')') - if (plastic_disloUCLA_D0(instance) <= 0.0_pReal) & + !if (plastic_disloUCLA_CAtomicVolume(instance) <= 0.0_pReal) & + ! call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOUCLA_label//')') + if (prm%D0 <= 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='D0 ('//PLASTICITY_DISLOUCLA_label//')') if (plastic_disloUCLA_Qsd(instance) <= 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='Qsd ('//PLASTICITY_DISLOUCLA_label//')') @@ -354,10 +342,6 @@ do p = 1_pInt, size(phase_plasticityInstance) plastic_disloUCLA_output(i,phase_plasticityInstance(p)) = outputs(i) plastic_disloUCLA_sizePostResult(i,phase_plasticityInstance(p)) = outputSize prm%outputID = [prm%outputID, outputID] - plastic_disloUCLA_outputID(i,phase_plasticityInstance(p)) = outputID - plastic_disloUCLA_sizePostResults(phase_plasticityInstance(p)) = & - plastic_disloUCLA_sizePostResults(phase_plasticityInstance(p)) + outputSize -plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) + 1_pInt endif enddo @@ -403,7 +387,7 @@ plastic_disloUCLA_Noutput(phase_plasticityInstance(p)) = plastic_disloUCLA_Noutp call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,0_pInt, & ns,0_pInt,0_pInt) - plasticState(phase)%sizePostResults = plastic_disloUCLA_sizePostResults(instance) + plasticState(phase)%sizePostResults = sum(plastic_disloUCLA_sizePostResult(:,phase_plasticityInstance(p))) offset_slip = 2_pInt*plasticState(phase)%nSlip plasticState(phase)%slipRate => & @@ -646,8 +630,7 @@ do j = 1_pInt, prm%totalNslip !* Dislocation dipole climb AtomicVolume = & plastic_disloUCLA_CAtomicVolume(instance)*prm%burgers(j)**(3.0_pReal) - VacancyDiffusion = & - plastic_disloUCLA_D0(instance)*exp(-plastic_disloUCLA_Qsd(instance)/(kB*Temperature)) + VacancyDiffusion = prm%D0*exp(-plastic_disloUCLA_Qsd(instance)/(kB*Temperature)) if (dEq0(tau_slip_pos(j))) then DotRhoEdgeDipClimb = 0.0_pReal else From e604a3d9cc09ad1992faddf506c02cbe5f618dac Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 4 Dec 2018 00:06:46 +0100 Subject: [PATCH 32/47] simplified --- src/plastic_disloUCLA.f90 | 129 ++++++++++++++++++-------------------- 1 file changed, 61 insertions(+), 68 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 5e8e76052..a6ff87323 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -25,10 +25,6 @@ module plastic_disloUCLA integer(pInt), dimension(:), allocatable, private :: & plastic_disloUCLA_totalNslip !< total number of active slip systems for each instance - integer(pInt), dimension(:,:), allocatable, private :: & - plastic_disloUCLA_Nslip !< number of active slip systems for each family and instance - - real(pReal), dimension(:), allocatable, private :: & plastic_disloUCLA_CAtomicVolume, & !< atomic volume in Bugers vector unit plastic_disloUCLA_Qsd, & !< activation energy for dislocation climb @@ -76,7 +72,9 @@ module plastic_disloUCLA viscosity, & !< friction coeff. B (kMC) !* tau_Peierls, & - nonSchmidCoeff + nonSchmidCoeff, & + atomicVolume, & + minDipDistance real(pReal), allocatable, dimension(:,:) :: & interaction_SlipSlip !< slip resistance from slip activity real(pReal), allocatable, dimension(:,:,:) :: & @@ -90,6 +88,8 @@ module plastic_disloUCLA Nslip !< number of active slip systems for each family integer(kind(undefined_ID)), allocatable, dimension(:) :: & outputID !< ID of each post result output + logical :: & + dipoleformation end type !< container type for internal constitutive parameters type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) @@ -168,7 +168,7 @@ material_allocatePlasticState integer(pInt), intent(in) :: fileUnit integer(pInt) :: maxNinstance,phase,maxTotalNslip,& - f,instance,j,k,o,ns, i, & + f,instance,j,k,o, i, & outputSize, & offset_slip, index_myFamily, index_otherFamily, & startIndex, endIndex, p @@ -199,12 +199,13 @@ material_allocatePlasticState plastic_disloUCLA_output = '' - allocate(plastic_disloUCLA_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) allocate(plastic_disloUCLA_totalNslip(maxNinstance), source=0_pInt) + allocate(plastic_disloUCLA_CAtomicVolume(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_CEdgeDipMinDistance(maxNinstance), source=0.0_pReal) allocate(plastic_disloUCLA_Qsd(maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_CEdgeDipMinDistance(maxNinstance), source=0.0_pReal) + allocate(plastic_disloUCLA_dipoleFormationFactor(maxNinstance), source=1.0_pReal) !should be on by default allocate(param(maxNinstance)) @@ -217,7 +218,8 @@ do p = 1_pInt, size(phase_plasticityInstance) if (phase_plasticity(p) /= PLASTICITY_DISLOUCLA_ID) cycle associate(prm => param(phase_plasticityInstance(p)), & dot => dotState(phase_plasticityInstance(p)), & - stt => state(phase_plasticityInstance(p))) + stt => state(phase_plasticityInstance(p)), & + mse => microstructure(phase_plasticityInstance(p))) structure = config_phase(p)%getString('lattice_structure') prm%mu = lattice_mu(p) @@ -302,9 +304,6 @@ do p = 1_pInt, size(phase_plasticityInstance) endif slipActive -!-------------------------------------------------------------------------------------------------- -! phase outputs - #if defined(__GFORTRAN__) outputs = ['GfortranBug86277'] outputs = config_phase(p)%getStrings('(output)',defaultVal=outputs) @@ -345,8 +344,7 @@ do p = 1_pInt, size(phase_plasticityInstance) endif enddo - end associate - enddo + @@ -361,31 +359,18 @@ do p = 1_pInt, size(phase_plasticityInstance) !if (plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance) < 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='tau_peierls ('//PLASTICITY_DISLOUCLA_label//')') - -!-------------------------------------------------------------------------------------------------- -! allocation of variables whose size depends on the total number of active slip systems - maxTotalNslip = maxval(plastic_disloUCLA_totalNslip) - - allocate(plastic_disloUCLA_forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstance), & - source=0.0_pReal) - - - initializeInstances: do phase = 1_pInt, size(phase_plasticity) - myPhase2: if (phase_plasticity(phase) == PLASTICITY_disloUCLA_ID) then - p = phase + phase = p NofMyPhase=count(material_phase==phase) instance = phase_plasticityInstance(phase) - ns = plastic_disloUCLA_totalNslip(instance) - associate(prm => param(instance), stt=>state(instance),mse => microstructure(phase_plasticityInstance(p))) !-------------------------------------------------------------------------------------------------- ! allocate state arrays - sizeDotState = int(size(['rhoEdge ','rhoEdgeDip ','accshearslip']),pInt) * ns + sizeDotState = int(size(['rhoEdge ','rhoEdgeDip ','accshearslip']),pInt) * prm%totalNslip sizeState = sizeDotState call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,0_pInt, & - ns,0_pInt,0_pInt) + prm%totalNslip,0_pInt,0_pInt) plasticState(phase)%sizePostResults = sum(plastic_disloUCLA_sizePostResult(:,phase_plasticityInstance(p))) @@ -394,40 +379,23 @@ do p = 1_pInt, size(phase_plasticityInstance) plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NofMyPhase) plasticState(phase)%accumulatedSlip => & plasticState(phase)%state (offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NofMyPhase) - !* Process slip related parameters ------------------------------------------------ - - mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) - index_myFamily = sum(prm%Nslip(1:f-1_pInt)) ! index in truncated slip system list - mySlipSystems: do j = 1_pInt,prm%Nslip(f) - - !* Calculation of forest projections for edge dislocations - otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) - index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) - otherSlipSystems: do k = 1_pInt,prm%Nslip(o) - plastic_disloUCLA_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))) - enddo otherSlipSystems; enddo otherSlipFamilies - - enddo mySlipSystems - enddo mySlipFamilies startIndex=1_pInt - endIndex=ns + endIndex=prm%totalNslip stt%rhoEdge=>plasticState(phase)%state(startIndex:endIndex,:) stt%rhoEdge= spread(prm%rho0,2,NofMyPhase) dotState(instance)%rhoEdge=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho startIndex=endIndex+1_pInt - endIndex=endIndex+ns + endIndex=endIndex+prm%totalNslip stt%rhoEdgeDip=>plasticState(phase)%state(startIndex:endIndex,:) stt%rhoEdgeDip= spread(prm%rhoDip0,2,NofMyPhase) dotState(instance)%rhoEdgeDip=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho startIndex=endIndex+1_pInt - endIndex=endIndex+ns + endIndex=endIndex+prm%totalNslip stt%accshear_slip=>plasticState(phase)%state(startIndex:endIndex,:) dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = 1e6_pReal @@ -441,9 +409,39 @@ do p = 1_pInt, size(phase_plasticityInstance) plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally end associate - endif myPhase2 - enddo initializeInstances + enddo + + + allocate(plastic_disloUCLA_forestProjectionEdge(maxval(plastic_disloUCLA_totalNslip),& + maxval(plastic_disloUCLA_totalNslip),maxNinstance), & + source=0.0_pReal) + +do p = 1_pInt, size(phase_plasticityInstance) + if (phase_plasticity(p) /= PLASTICITY_DISLOUCLA_ID) cycle + associate(prm => param(phase_plasticityInstance(p)), & + dot => dotState(phase_plasticityInstance(p)), & + stt => state(phase_plasticityInstance(p)), & + mse => microstructure(phase_plasticityInstance(p))) + + mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) + index_myFamily = sum(prm%Nslip(1:f-1_pInt)) ! index in truncated slip system list + mySlipSystems: do j = 1_pInt,prm%Nslip(f) + + !* Calculation of forest projections for edge dislocations + otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) + index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) + otherSlipSystems: do k = 1_pInt,prm%Nslip(o) + plastic_disloUCLA_forestProjectionEdge(index_myFamily+j,index_otherFamily+k,instance) = & + abs(math_mul3x3(lattice_sn(:,sum(lattice_NslipSystem(1:f-1,p))+j,p), & + lattice_st(:,sum(lattice_NslipSystem(1:o-1,p))+k,p))) + enddo otherSlipSystems; enddo otherSlipFamilies + + enddo mySlipSystems + enddo mySlipFamilies + end associate + +enddo end subroutine plastic_disloUCLA_init @@ -572,7 +570,6 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) EdgeDipMinDistance,& AtomicVolume,& VacancyDiffusion,& - DotRhoMultiplication,& EdgeDipDistance, & DotRhoEdgeDipAnnihilation, & DotRhoEdgeEdgeAnnihilation, & @@ -588,22 +585,18 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) ns = plastic_disloUCLA_totalNslip(instance) dotState(instance)%whole(:,of) = 0.0_pReal - associate(prm => param(instance), stt => state(instance),mse => microstructure(instance)) + associate(prm => param(instance), stt => state(instance),dot => dotState(instance), mse => microstructure(instance)) !* Dislocation density evolution call kinetics(Mp,Temperature,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) dotState(instance)%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)*0.5_pReal do j = 1_pInt, prm%totalNslip + EdgeDipMinDistance = plastic_disloUCLA_CEdgeDipMinDistance(instance)*prm%burgers(j) + AtomicVolume = plastic_disloUCLA_CAtomicVolume(instance)*prm%burgers(j)**(3.0_pReal) + - !* Multiplication - DotRhoMultiplication = abs(dotState(instance)%accshear_slip(j,of))/& - (prm%burgers(j)* & - mse%mfp(j,of)) - !* Dipole formation - EdgeDipMinDistance = & - plastic_disloUCLA_CEdgeDipMinDistance(instance)*prm%burgers(j) if (dEq0(tau_slip_pos(j))) then DotRhoDipFormation = 0.0_pReal else @@ -620,7 +613,7 @@ do j = 1_pInt, prm%totalNslip !* Spontaneous annihilation of 2 single edge dislocations DotRhoEdgeEdgeAnnihilation = & ((2.0_pReal*EdgeDipMinDistance)/prm%burgers(j))*& - stt%rhoEdge(j,of)*abs(dotState(instance)%accshear_slip(j,of)) + stt%rhoEdge(j,of)*abs(dot%accshear_slip(j,of)) !* Spontaneous annihilation of a single edge dislocation with a dipole constituent DotRhoEdgeDipAnnihilation = & @@ -628,8 +621,6 @@ do j = 1_pInt, prm%totalNslip stt%rhoEdgeDip(j,of)*abs(dotState(instance)%accshear_slip(j,of)) !* Dislocation dipole climb - AtomicVolume = & - plastic_disloUCLA_CAtomicVolume(instance)*prm%burgers(j)**(3.0_pReal) VacancyDiffusion = prm%D0*exp(-plastic_disloUCLA_Qsd(instance)/(kB*Temperature)) if (dEq0(tau_slip_pos(j))) then DotRhoEdgeDipClimb = 0.0_pReal @@ -642,12 +633,14 @@ do j = 1_pInt, prm%totalNslip endif !* Edge dislocation density rate of change - dotState(instance)%rhoEdge(j,of) = & - DotRhoMultiplication-DotRhoDipFormation-DotRhoEdgeEdgeAnnihilation + dot%rhoEdge(j,of) = abs(dot%accshear_slip(j,of))/(prm%burgers(j)*mse%mfp(j,of)) & ! multiplication + - DotRhoDipFormation & + - DotRhoEdgeEdgeAnnihilation !* Edge dislocation dipole density rate of change - dotState(instance)%rhoEdgeDip(j,of) = & - DotRhoDipFormation-DotRhoEdgeDipAnnihilation-DotRhoEdgeDipClimb + dot%rhoEdgeDip(j,of) = DotRhoDipFormation & + - DotRhoEdgeDipAnnihilation & + - DotRhoEdgeDipClimb enddo From 91a2748131bd86baf7332bcd14e818226eac77dd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 4 Dec 2018 19:35:29 +0100 Subject: [PATCH 33/47] simplifying --- src/math.f90 | 2 +- src/plastic_disloUCLA.f90 | 108 ++++++++++++++++---------------------- 2 files changed, 45 insertions(+), 65 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index 440ee5303..75d7f4490 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -2617,7 +2617,7 @@ end function math_rotate_forward3333 !> @brief limits a scalar value to a certain range (either one or two sided) ! Will return NaN if left > right !-------------------------------------------------------------------------------------------------- -real(pReal) pure function math_clip(a, left, right) +real(pReal) pure elemental function math_clip(a, left, right) use, intrinsic :: & IEEE_arithmetic diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index a6ff87323..d3385d755 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -26,10 +26,7 @@ module plastic_disloUCLA plastic_disloUCLA_totalNslip !< total number of active slip systems for each instance real(pReal), dimension(:), allocatable, private :: & - plastic_disloUCLA_CAtomicVolume, & !< atomic volume in Bugers vector unit - plastic_disloUCLA_Qsd, & !< activation energy for dislocation climb - plastic_disloUCLA_CEdgeDipMinDistance, & !< - plastic_disloUCLA_dipoleFormationFactor !< scaling factor for dipole formation: 0: off, 1: on. other values not useful + plastic_disloUCLA_Qsd !< activation energy for dislocation climb real(pReal), dimension(:,:,:), allocatable, private :: & @@ -200,13 +197,8 @@ material_allocatePlasticState allocate(plastic_disloUCLA_totalNslip(maxNinstance), source=0_pInt) - - allocate(plastic_disloUCLA_CAtomicVolume(maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_CEdgeDipMinDistance(maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_Qsd(maxNinstance), source=0.0_pReal) - allocate(plastic_disloUCLA_dipoleFormationFactor(maxNinstance), source=1.0_pReal) !should be on by default allocate(param(maxNinstance)) allocate(state(maxNinstance)) @@ -267,9 +259,11 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%D0 = config_phase(p)%getFloat('d0') plastic_disloUCLA_Qsd(phase_plasticityInstance(p)) = config_phase(p)%getFloat('qsd') - plastic_disloUCLA_CEdgeDipMinDistance(phase_plasticityInstance(p)) = config_phase(p)%getFloat('cedgedipmindistance') - plastic_disloUCLA_CAtomicVolume(phase_plasticityInstance(p)) = config_phase(p)%getFloat('catomicvolume') - plastic_disloUCLA_dipoleFormationFactor(phase_plasticityInstance(p)) = config_phase(p)%getFloat('dipoleformationfactor') + + + prm%dipoleformation = config_phase(p)%getFloat('dipoleformationfactor') > 0.0_pReal !should be on by default + prm%atomicVolume = config_phase(p)%getFloat('catomicvolume') * prm%burgers**3.0_pReal + prm%minDipDistance = config_phase(p)%getFloat('cedgedipmindistance') * prm%burgers ! expand: family => system prm%rho0 = math_expand(prm%rho0, prm%Nslip) @@ -285,15 +279,17 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%v0 = math_expand(prm%v0, prm%Nslip) prm%B = math_expand(prm%B, prm%Nslip) prm%clambda = math_expand(prm%clambda, prm%Nslip) + prm%atomicVolume = math_expand(prm%atomicVolume, prm%Nslip) + prm%minDipDistance = math_expand(prm%minDipDistance, prm%Nslip) instance = phase_plasticityInstance(p) plastic_disloUCLA_totalNslip(instance) = prm%totalNslip !if (plastic_disloUCLA_CAtomicVolume(instance) <= 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOUCLA_label//')') - if (prm%D0 <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='D0 ('//PLASTICITY_DISLOUCLA_label//')') - if (plastic_disloUCLA_Qsd(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='Qsd ('//PLASTICITY_DISLOUCLA_label//')') + ! if (prm%D0 <= 0.0_pReal) & + ! call IO_error(211_pInt,el=instance,ext_msg='D0 ('//PLASTICITY_DISLOUCLA_label//')') + ! if (plastic_disloUCLA_Qsd(instance) <= 0.0_pReal) & + ! call IO_error(211_pInt,el=instance,ext_msg='Qsd ('//PLASTICITY_DISLOUCLA_label//')') ! if (plastic_disloUCLA_aTolRho(instance) <= 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='aTolRho ('//PLASTICITY_DISLOUCLA_label//')') @@ -564,82 +560,70 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) temperature !< temperature at integration point integer(pInt), intent(in) :: & instance, of - integer(pInt) :: ns,j + integer(pInt) :: j real(pReal) :: & - EdgeDipMinDistance,& - AtomicVolume,& VacancyDiffusion,& - EdgeDipDistance, & DotRhoEdgeDipAnnihilation, & DotRhoEdgeEdgeAnnihilation, & - ClimbVelocity, & - DotRhoEdgeDipClimb, & - DotRhoDipFormation + DotRhoEdgeDipClimb real(pReal), dimension(plastic_disloUCLA_totalNslip(instance)) :: & gdot_slip_pos, gdot_slip_neg,& tau_slip_pos,& tau_slip_neg, & - dgdot_dtauslip_neg,dgdot_dtauslip_pos + dgdot_dtauslip_neg,dgdot_dtauslip_pos,DotRhoDipFormation, ClimbVelocity, EdgeDipDistance - ns = plastic_disloUCLA_totalNslip(instance) - dotState(instance)%whole(:,of) = 0.0_pReal - associate(prm => param(instance), stt => state(instance),dot => dotState(instance), mse => microstructure(instance)) - !* Dislocation density evolution + + + associate(prm => param(instance), stt => state(instance),dot => dotState(instance), mse => microstructure(instance)) + call kinetics(Mp,Temperature,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) - dotState(instance)%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)*0.5_pReal + + dot%whole(:,of) = 0.0_pReal + dot%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)*0.5_pReal -do j = 1_pInt, prm%totalNslip - EdgeDipMinDistance = plastic_disloUCLA_CEdgeDipMinDistance(instance)*prm%burgers(j) - AtomicVolume = plastic_disloUCLA_CAtomicVolume(instance)*prm%burgers(j)**(3.0_pReal) + do j = 1_pInt, prm%totalNslip !* Dipole formation - if (dEq0(tau_slip_pos(j))) then - DotRhoDipFormation = 0.0_pReal + if (dEq0(tau_slip_pos(j)) .or. (.not. prm%dipoleformation)) then + DotRhoDipFormation(j) = 0.0_pReal + EdgeDipDistance(j)=mse%mfp(j,of) !ToDo MD@FR: correct? was not handled properly before else - EdgeDipDistance = & + EdgeDipDistance(j) = & (3.0_pReal*prm%mu*prm%burgers(j))/& (16.0_pReal*pi*abs(tau_slip_pos(j))) - if (EdgeDipDistance>mse%mfp(j,of)) EdgeDipDistance=mse%mfp(j,of) - if (EdgeDipDistancemse%mfp(j,of)) EdgeDipDistance(j)=mse%mfp(j,of) + if (EdgeDipDistance(j) Date: Tue, 4 Dec 2018 20:50:02 +0100 Subject: [PATCH 34/47] vectorized --- src/plastic_disloUCLA.f90 | 66 +++++++++++++++------------------------ 1 file changed, 25 insertions(+), 41 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index d3385d755..f205c34f2 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -551,7 +551,8 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) tol_math_check, & dEq0 use math, only: & - pi + PI, & + math_clip implicit none real(pReal), dimension(3,3), intent(in):: & @@ -559,22 +560,17 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) real(pReal), intent(in) :: & temperature !< temperature at integration point integer(pInt), intent(in) :: & - instance, of + instance, of integer(pInt) :: j real(pReal) :: & - VacancyDiffusion,& - DotRhoEdgeDipAnnihilation, & - DotRhoEdgeEdgeAnnihilation, & - DotRhoEdgeDipClimb + VacancyDiffusion real(pReal), dimension(plastic_disloUCLA_totalNslip(instance)) :: & gdot_slip_pos, gdot_slip_neg,& tau_slip_pos,& tau_slip_neg, & - dgdot_dtauslip_neg,dgdot_dtauslip_pos,DotRhoDipFormation, ClimbVelocity, EdgeDipDistance - - - + dgdot_dtauslip_neg,dgdot_dtauslip_pos,DotRhoDipFormation, ClimbVelocity, EdgeDipDistance, & + DotRhoEdgeDipClimb associate(prm => param(instance), stt => state(instance),dot => dotState(instance), mse => microstructure(instance)) @@ -584,47 +580,35 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) dot%whole(:,of) = 0.0_pReal dot%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)*0.5_pReal + VacancyDiffusion = prm%D0*exp(-plastic_disloUCLA_Qsd(instance)/(kB*Temperature)) + + where(dEq0(tau_slip_pos) .or. (.not. prm%dipoleformation)) + EdgeDipDistance = mse%mfp(:,of) !ToDo MD@FR: correct? was not handled properly before + DotRhoDipFormation = 0.0_pReal + DotRhoEdgeDipClimb = 0.0_pReal + else where + EdgeDipDistance = math_clip((3.0_pReal*prm%mu*prm%burgers)/(16.0_pReal*PI*abs(tau_slip_pos)), & + prm%minDipDistance, & ! lower limit + mse%mfp(:,of)) ! upper limit + DotRhoDipFormation = merge(((2.0_pReal*EdgeDipDistance)/prm%burgers)* stt%rhoEdge(:,of)*abs(dot%accshear_slip(:,of)), & + 0.0_pReal, & + prm%dipoleformation) + ClimbVelocity = ((3.0_pReal*prm%mu*VacancyDiffusion*prm%atomicVolume)/(2.0_pReal*pi*kB*Temperature)) & + * (1.0_pReal/(EdgeDipDistance+prm%minDipDistance)) + DotRhoEdgeDipClimb = (4.0_pReal*ClimbVelocity*stt%rhoEdgeDip(:,of))/(EdgeDipDistance-prm%minDipDistance) + end where + do j = 1_pInt, prm%totalNslip - - - !* Dipole formation - if (dEq0(tau_slip_pos(j)) .or. (.not. prm%dipoleformation)) then - DotRhoDipFormation(j) = 0.0_pReal - EdgeDipDistance(j)=mse%mfp(j,of) !ToDo MD@FR: correct? was not handled properly before - else - EdgeDipDistance(j) = & - (3.0_pReal*prm%mu*prm%burgers(j))/& - (16.0_pReal*pi*abs(tau_slip_pos(j))) - if (EdgeDipDistance(j)>mse%mfp(j,of)) EdgeDipDistance(j)=mse%mfp(j,of) - if (EdgeDipDistance(j) Date: Tue, 4 Dec 2018 21:05:34 +0100 Subject: [PATCH 35/47] simplified --- src/plastic_disloUCLA.f90 | 54 ++++++++++++++------------------------- 1 file changed, 19 insertions(+), 35 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index f205c34f2..4df9c9779 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -446,8 +446,6 @@ end subroutine plastic_disloUCLA_init !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) - use math, only: & - pi use material, only: & phase_plasticityInstance, & phaseAt, phasememberAt, & @@ -463,34 +461,27 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) integer(pInt) :: & instance, & - ns,s, & + s, & of real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - invLambdaSlip - !* Shortened notation + invLambdaSlip ! 1/mean free distance between 2 forest dislocations seen by a moving dislocation + of = phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(phaseAt(ipc,ip,el)) - ns = plastic_disloUCLA_totalNslip(instance) - associate(prm => param(instance), stt => state(instance),mse => microstructure(instance)) - !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation - forall (s = 1_pInt:ns) & - invLambdaSlip(s) = & - sqrt(dot_product((stt%rhoEdge(1_pInt:ns,of)+stt%rhoEdgeDip(1_pInt:ns,of)),& - plastic_disloUCLA_forestProjectionEdge(1:ns,s,instance)))/ & - prm%Clambda(s) - !* mean free path between 2 obstacles seen by a moving dislocation - + forall (s = 1_pInt:prm%totalNslip) & + invLambdaSlip(s) = sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), & + plastic_disloUCLA_forestProjectionEdge(:,s,instance))) & + / prm%Clambda(s) + mse%mfp(:,of) = prm%grainSize/(1.0_pReal+prm%grainSize*invLambdaSlip) - !* threshold stress for dislocation motion - forall (s = 1_pInt:ns) & - mse%threshold_stress(s,of) = & - prm%mu*prm%burgers(s)*& - sqrt(dot_product(stt%rhoEdge(1_pInt:ns,of)+stt%rhoEdgeDip(1_pInt:ns,of),& - prm%interaction_SlipSlip(s,1:ns))) + forall (s = 1_pInt:prm%totalNslip) & + mse%threshold_stress(s,of) = prm%mu*prm%burgers(s) & + * sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), & + prm%interaction_SlipSlip(s,:))) end associate @@ -518,7 +509,6 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,ipc,ip,el real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_slip_pos,gdot_slip_neg,tau_slip_pos,tau_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg - !* Shortened notation of = phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(phaseAt(ipc,ip,el)) associate(prm => param(instance)) @@ -598,20 +588,14 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) DotRhoEdgeDipClimb = (4.0_pReal*ClimbVelocity*stt%rhoEdgeDip(:,of))/(EdgeDipDistance-prm%minDipDistance) end where - do j = 1_pInt, prm%totalNslip - - dot%rhoEdge(j,of) = abs(dot%accshear_slip(j,of))/(prm%burgers(j)*mse%mfp(j,of)) & ! multiplication - - DotRhoDipFormation(j) & - - ((2.0_pReal*prm%minDipDistance(j))/prm%burgers(j))*& - stt%rhoEdge(j,of)*abs(dot%accshear_slip(j,of)) !* Spontaneous annihilation of 2 single edge dislocations - - dot%rhoEdgeDip(j,of) = DotRhoDipFormation(j) & - - ((2.0_pReal*prm%minDipDistance(j))/prm%burgers(j))*& - stt%rhoEdgeDip(j,of)*abs(dot%accshear_slip(j,of)) & !* Spontaneous annihilation of a single edge dislocation with a dipole constituent - - DotRhoEdgeDipClimb(j) + dot%rhoEdge(:,of) = abs(dot%accshear_slip(:,of))/(prm%burgers*mse%mfp(:,of)) & ! multiplication + - DotRhoDipFormation & + - ((2.0_pReal*prm%minDipDistance)/prm%burgers)*stt%rhoEdge(:,of)*abs(dot%accshear_slip(:,of)) !* Spontaneous annihilation of 2 single edge dislocations + + dot%rhoEdgeDip(:,of) = DotRhoDipFormation & + - ((2.0_pReal*prm%minDipDistance)/prm%burgers)* stt%rhoEdgeDip(:,of)*abs(dot%accshear_slip(:,of)) & !* Spontaneous annihilation of a single edge dislocation with a dipole constituent + - DotRhoEdgeDipClimb - - enddo end associate end subroutine plastic_disloUCLA_dotState From 10445606ba9a89511e01ecefdf3ef08f2ab0c1f3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 4 Dec 2018 21:33:32 +0100 Subject: [PATCH 36/47] simplified API + general polishing --- src/constitutive.f90 | 7 +- src/plastic_disloUCLA.f90 | 329 ++++++++++++++++++-------------------- 2 files changed, 161 insertions(+), 175 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index f01c82f75..d8fb42bd2 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -164,7 +164,7 @@ subroutine constitutive_init() if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT) - if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then call plastic_nonlocal_init(FILEUNIT) call plastic_nonlocal_stateInit() @@ -530,8 +530,9 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e call plastic_dislotwin_LpAndItsTangent (Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_DISLOUCLA_ID) plasticityType - call plastic_disloucla_LpAndItsTangent (Lp,dLp_dMp,Mp, & - temperature(ho)%p(tme), ipc,ip,el) + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + call plastic_disloucla_LpAndItsTangent (Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) end select plasticityType diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 4df9c9779..b61672221 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -25,9 +25,6 @@ module plastic_disloUCLA integer(pInt), dimension(:), allocatable, private :: & plastic_disloUCLA_totalNslip !< total number of active slip systems for each instance - real(pReal), dimension(:), allocatable, private :: & - plastic_disloUCLA_Qsd !< activation energy for dislocation climb - real(pReal), dimension(:,:,:), allocatable, private :: & plastic_disloUCLA_forestProjectionEdge !< matrix of forest projections of edge dislocations for each instance @@ -51,7 +48,8 @@ module plastic_disloUCLA grainSize, & SolidSolutionStrength, & !< Strength due to elements in solid solution mu, & - D0 !< prefactor for self-diffusion coefficient + D0, & !< prefactor for self-diffusion coefficient + Qsd !< activation energy for dislocation climb real(pReal), allocatable, dimension(:) :: & B, & !< friction coeff. B (kMC) rho0, & !< initial edge dislocation density per slip system for each family and instance @@ -129,7 +127,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine plastic_disloUCLA_init(fileUnit) +subroutine plastic_disloUCLA_init() #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -140,8 +138,6 @@ subroutine plastic_disloUCLA_init(fileUnit) debug_constitutive,& debug_levelBasic use math, only: & - math_Mandel3333to66, & - math_Voigt66to3333, & math_mul3x3, & math_expand use IO, only: & @@ -155,18 +151,16 @@ subroutine plastic_disloUCLA_init(fileUnit) PLASTICITY_DISLOUCLA_ID, & material_phase, & plasticState, & -material_allocatePlasticState + material_allocatePlasticState use config, only: & MATERIAL_partPhase, & config_phase use lattice implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt) :: maxNinstance,phase,maxTotalNslip,& + integer(pInt) :: maxNinstance,& f,instance,j,k,o, i, & - outputSize, & + outputSize, phase, & offset_slip, index_myFamily, index_otherFamily, & startIndex, endIndex, p integer(pInt) :: sizeState, sizeDotState @@ -197,7 +191,6 @@ material_allocatePlasticState allocate(plastic_disloUCLA_totalNslip(maxNinstance), source=0_pInt) - allocate(plastic_disloUCLA_Qsd(maxNinstance), source=0.0_pReal) allocate(param(maxNinstance)) @@ -250,7 +243,6 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%omega = config_phase(p)%getFloats('omega') prm%B = config_phase(p)%getFloats('friction_coeff') - !prm%viscosity = config_phase(p)%getFloats('viscosity') prm%SolidSolutionStrength = config_phase(p)%getFloat('solidsolutionstrength') @@ -258,7 +250,7 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%grainSize = config_phase(p)%getFloat('grainsize') prm%D0 = config_phase(p)%getFloat('d0') - plastic_disloUCLA_Qsd(phase_plasticityInstance(p)) = config_phase(p)%getFloat('qsd') + prm%Qsd= config_phase(p)%getFloat('qsd') prm%dipoleformation = config_phase(p)%getFloat('dipoleformationfactor') > 0.0_pReal !should be on by default @@ -296,7 +288,6 @@ do p = 1_pInt, size(phase_plasticityInstance) else slipActive allocate(prm%rho0(0)) allocate(prm%rhoDip0(0)) - endif slipActive @@ -491,26 +482,20 @@ end subroutine plastic_disloUCLA_microstructure !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,ipc,ip,el) - use material, only: & - material_phase, & - phase_plasticityInstance, & - phaseAt, phasememberAt +subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance,of) implicit none - integer(pInt), intent(in) :: ipc,ip,el + integer(pInt), intent(in) :: instance, of real(pReal), intent(in) :: Temperature real(pReal), dimension(3,3), intent(in) :: Mp real(pReal), dimension(3,3), intent(out) :: Lp real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp - integer(pInt) :: instance,of,i,k,l,m,n + integer(pInt) :: i,k,l,m,n - real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(param(instance)%totalNslip) :: & gdot_slip_pos,gdot_slip_neg,tau_slip_pos,tau_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg - of = phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(phaseAt(ipc,ip,el)) associate(prm => param(instance)) Lp = 0.0_pReal @@ -525,7 +510,7 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,ipc,ip,el + dgdot_dtauslip_pos(i) * prm%Schmid_slip(k,l,i) * prm%nonSchmid_pos(m,n,i) & + dgdot_dtauslip_neg(i) * prm%Schmid_slip(k,l,i) * prm%nonSchmid_neg(m,n,i) enddo slipSystems -end associate + end associate Lp = 0.5_pReal * Lp dLp_dMp = 0.5_pReal * dLp_dMp @@ -551,7 +536,6 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) temperature !< temperature at integration point integer(pInt), intent(in) :: & instance, of - integer(pInt) :: j real(pReal) :: & VacancyDiffusion @@ -570,9 +554,9 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) dot%whole(:,of) = 0.0_pReal dot%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)*0.5_pReal - VacancyDiffusion = prm%D0*exp(-plastic_disloUCLA_Qsd(instance)/(kB*Temperature)) + VacancyDiffusion = prm%D0*exp(-prm%Qsd/(kB*Temperature)) - where(dEq0(tau_slip_pos) .or. (.not. prm%dipoleformation)) + where(dEq0(tau_slip_pos)) EdgeDipDistance = mse%mfp(:,of) !ToDo MD@FR: correct? was not handled properly before DotRhoDipFormation = 0.0_pReal DotRhoEdgeDipClimb = 0.0_pReal @@ -706,7 +690,7 @@ math_mul33xx33 instance,of integer(pInt) :: & - i,j + j real(pReal) :: StressRatio_p,StressRatio_pminus1,& BoltzmannRatio,DotGamma0,stressRatio,& dvel_slip, vel_slip @@ -716,152 +700,153 @@ instance,of - gdot_slip_pos = 0.0_pReal - gdot_slip_neg = 0.0_pReal - dgdot_dtauslip_pos = 0.0_pReal - dgdot_dtauslip_neg = 0.0_pReal - do j = 1_pInt, prm%totalNslip - !* Boltzmann ratio - BoltzmannRatio = prm%H0kp(j)/(kB*Temperature) - !* Initial shear rates - DotGamma0 = stt%rhoEdge(j,of)*prm%burgers(j)*prm%v0(j) - !* Resolved shear stress on slip system - tau_slip_pos(j) = math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)) - tau_slip_neg(j) = math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j)) + gdot_slip_pos = 0.0_pReal + gdot_slip_neg = 0.0_pReal + dgdot_dtauslip_pos = 0.0_pReal + dgdot_dtauslip_neg = 0.0_pReal + do j = 1_pInt, prm%totalNslip + !* Boltzmann ratio + BoltzmannRatio = prm%H0kp(j)/(kB*Temperature) + !* Initial shear rates + DotGamma0 = stt%rhoEdge(j,of)*prm%burgers(j)*prm%v0(j) + !* Resolved shear stress on slip system + tau_slip_pos(j) = math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)) + tau_slip_neg(j) = math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j)) - significantPositiveTau: if((abs(tau_slip_pos(j))-mse%threshold_stress(j, of)) > tol_math_check) then - !* Stress ratio - stressRatio = ((abs(tau_slip_pos(j))-mse%threshold_stress(j, of))/& - (prm%solidSolutionStrength+& - prm%tau_Peierls(j))) - stressRatio_p = stressRatio** prm%p(j) - stressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal) - !* Shear rates due to slip - vel_slip = 2.0_pReal*prm%burgers(j) & - * prm%kink_height(j) * prm%omega(j) & - * ( mse%mfp(j,of) - prm%kink_width(j) ) & - * (tau_slip_pos(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & - / ( & - 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & - + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & - ) - - gdot_slip_pos(j) = DotGamma0 * sign(vel_slip,tau_slip_pos(j)) - !* Derivatives of shear rates - - dvel_slip = & - 2.0_pReal*prm%burgers(j) & - * prm%kink_height(j) * prm%omega(j) & - * ( mse%mfp(j,of) - prm%kink_width(j) ) & - * ( & - (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & - + tau_slip_pos(j) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& - *BoltzmannRatio*prm%p(j)& - *prm%q(j)/& - (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) & - ) & - * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & - + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & - ) & - - (tau_slip_pos(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & - * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & - + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& - *BoltzmannRatio*prm%p(j)& - *prm%q(j)/& - (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& - ) & - ) & - / ( & - ( & - 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & - + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & - )**2.0_pReal & - ) - - dgdot_dtauslip_pos(j) = DotGamma0 * dvel_slip - - endif significantPositiveTau - - - significantNegativeTau: if((abs(tau_slip_neg(j))-mse%threshold_stress(j, of)) > tol_math_check) then - !* Stress ratios - stressRatio = ((abs(tau_slip_neg(j))-mse%threshold_stress(j, of))/& - (prm%solidSolutionStrength+& - prm%tau_Peierls(j))) - stressRatio_p = stressRatio** prm%p(j) - stressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal) - !* Shear rates due to slip - vel_slip = 2.0_pReal*prm%burgers(j) & - * prm%kink_height(j) * prm%omega(j) & - * ( mse%mfp(j,of) - prm%kink_width(j) ) & - * (tau_slip_neg(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & - / ( & - 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & - + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & - ) + significantPositiveTau: if((abs(tau_slip_pos(j))-mse%threshold_stress(j, of)) > tol_math_check) then + !* Stress ratio + stressRatio = ((abs(tau_slip_pos(j))-mse%threshold_stress(j, of))/& + (prm%solidSolutionStrength+& + prm%tau_Peierls(j))) + stressRatio_p = stressRatio** prm%p(j) + stressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal) + !* Shear rates due to slip + vel_slip = 2.0_pReal*prm%burgers(j) & + * prm%kink_height(j) * prm%omega(j) & + * ( mse%mfp(j,of) - prm%kink_width(j) ) & + * (tau_slip_pos(j) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & + / ( & + 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + + prm%omega(j) * prm%B(j) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + ) - gdot_slip_neg(j) = DotGamma0 * sign(vel_slip,tau_slip_neg(j)) - !* Derivatives of shear rates - dvel_slip = & - 2.0_pReal*prm%burgers(j) & - * prm%kink_height(j) * prm%omega(j) & - * ( mse%mfp(j,of) - prm%kink_width(j) ) & - * ( & - (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & - + tau_slip_neg(j) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& - *BoltzmannRatio*prm%p(j)& - *prm%q(j)/& - (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) & - ) & - * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & - + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & - ) & - - (tau_slip_neg(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & - * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & - + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& - *BoltzmannRatio*prm%p(j)& - *prm%q(j)/& - (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& - ) & - ) & - / ( & - ( & - 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & - + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & - )**2.0_pReal & - ) + gdot_slip_pos(j) = DotGamma0 * sign(vel_slip,tau_slip_pos(j)) + !* Derivatives of shear rates + + dvel_slip = & + 2.0_pReal*prm%burgers(j) & + * prm%kink_height(j) * prm%omega(j) & + * ( mse%mfp(j,of) - prm%kink_width(j) ) & + * ( & + (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + + tau_slip_pos(j) & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& + *BoltzmannRatio*prm%p(j)& + *prm%q(j)/& + (prm%solidSolutionStrength+prm%tau_Peierls(j))*& + StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) & + ) & + * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + + prm%omega(j) * prm%B(j) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + ) & + - (tau_slip_pos(j) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & + * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & + + prm%omega(j) * prm%B(j) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& + *BoltzmannRatio*prm%p(j)& + *prm%q(j)/& + (prm%solidSolutionStrength+prm%tau_Peierls(j))*& + StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& + ) & + ) & + / ( & + ( & + 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + + prm%omega(j) * prm%B(j) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + )**2.0_pReal & + ) + + dgdot_dtauslip_pos(j) = DotGamma0 * dvel_slip + + endif significantPositiveTau - dgdot_dtauslip_neg(j) = DotGamma0 * dvel_slip - endif significantNegativeTau - enddo + significantNegativeTau: if((abs(tau_slip_neg(j))-mse%threshold_stress(j, of)) > tol_math_check) then + !* Stress ratios + stressRatio = ((abs(tau_slip_neg(j))-mse%threshold_stress(j, of))/& + (prm%solidSolutionStrength+& + prm%tau_Peierls(j))) + stressRatio_p = stressRatio** prm%p(j) + stressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal) + !* Shear rates due to slip + vel_slip = 2.0_pReal*prm%burgers(j) & + * prm%kink_height(j) * prm%omega(j) & + * ( mse%mfp(j,of) - prm%kink_width(j) ) & + * (tau_slip_neg(j) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & + / ( & + 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + + prm%omega(j) * prm%B(j) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + ) + + gdot_slip_neg(j) = DotGamma0 * sign(vel_slip,tau_slip_neg(j)) + !* Derivatives of shear rates + dvel_slip = & + 2.0_pReal*prm%burgers(j) & + * prm%kink_height(j) * prm%omega(j) & + * ( mse%mfp(j,of) - prm%kink_width(j) ) & + * ( & + (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + + tau_slip_neg(j) & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& + *BoltzmannRatio*prm%p(j)& + *prm%q(j)/& + (prm%solidSolutionStrength+prm%tau_Peierls(j))*& + StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) & + ) & + * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + + prm%omega(j) * prm%B(j) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + ) & + - (tau_slip_neg(j) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & + * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & + + prm%omega(j) * prm%B(j) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& + *BoltzmannRatio*prm%p(j)& + *prm%q(j)/& + (prm%solidSolutionStrength+prm%tau_Peierls(j))*& + StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& + ) & + ) & + / ( & + ( & + 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + + prm%omega(j) * prm%B(j) & + *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + )**2.0_pReal & + ) + + + dgdot_dtauslip_neg(j) = DotGamma0 * dvel_slip + endif significantNegativeTau + enddo end associate + end subroutine kinetics end module plastic_disloUCLA From a34e27cfcd164393b63e9f20a7a85c1d18b57e88 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 4 Dec 2018 21:53:22 +0100 Subject: [PATCH 37/47] dependentState is more descriptive than microstructure --- src/constitutive.f90 | 13 +++++++++---- src/plastic_disloUCLA.f90 | 24 ++++++------------------ 2 files changed, 15 insertions(+), 22 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index d8fb42bd2..e3c118bad 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -384,7 +384,9 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) use prec, only: & pReal use material, only: & + phasememberAt, & phase_plasticity, & + phase_plasticityInstance, & material_phase, & material_homogenizationAt, & temperature, & @@ -396,8 +398,8 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) plastic_nonlocal_microstructure use plastic_dislotwin, only: & plastic_dislotwin_microstructure - use plastic_disloucla, only: & - plastic_disloucla_microstructure + use plastic_disloUCLA, only: & + plastic_disloUCLA_dependentState implicit none integer(pInt), intent(in) :: & @@ -409,7 +411,8 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) Fp !< plastic deformation gradient integer(pInt) :: & ho, & !< homogenization - tme !< thermal member position + tme, & !< thermal member position + instance, of real(pReal), intent(in), dimension(:,:,:,:) :: & orientations !< crystal orientations as quaternions @@ -420,7 +423,9 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) case (PLASTICITY_DISLOTWIN_ID) plasticityType call plastic_dislotwin_microstructure(temperature(ho)%p(tme),ipc,ip,el) case (PLASTICITY_DISLOUCLA_ID) plasticityType - call plastic_disloucla_microstructure(temperature(ho)%p(tme),ipc,ip,el) + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + call plastic_disloUCLA_dependentState(temperature(ho)%p(tme),instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_microstructure (Fe,Fp,ip,el) end select plasticityType diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index b61672221..51fabe042 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -112,7 +112,7 @@ module plastic_disloUCLA public :: & plastic_disloUCLA_init, & - plastic_disloUCLA_microstructure, & + plastic_disloUCLA_dependentState, & plastic_disloUCLA_LpAndItsTangent, & plastic_disloUCLA_dotState, & plastic_disloUCLA_postResults @@ -436,30 +436,18 @@ end subroutine plastic_disloUCLA_init !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- -subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) - use material, only: & - phase_plasticityInstance, & - phaseAt, phasememberAt, & - material_phase +subroutine plastic_disloUCLA_dependentState(temperature,instance,of) implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + integer(pInt), intent(in) :: instance, of real(pReal), intent(in) :: & temperature !< temperature at IP integer(pInt) :: & - instance, & - s, & - of - real(pReal), dimension(plastic_disloUCLA_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + s + real(pReal), dimension(param(instance)%totalNslip) :: & invLambdaSlip ! 1/mean free distance between 2 forest dislocations seen by a moving dislocation - of = phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(phaseAt(ipc,ip,el)) - associate(prm => param(instance), stt => state(instance),mse => microstructure(instance)) forall (s = 1_pInt:prm%totalNslip) & @@ -476,7 +464,7 @@ subroutine plastic_disloUCLA_microstructure(temperature,ipc,ip,el) end associate -end subroutine plastic_disloUCLA_microstructure +end subroutine plastic_disloUCLA_dependentState !-------------------------------------------------------------------------------------------------- From 9caa91ee149d19fe1c3f6a61cc7edad69e3ec2fb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 4 Dec 2018 22:30:07 +0100 Subject: [PATCH 38/47] polishing --- src/constitutive.f90 | 2 +- src/plastic_disloUCLA.f90 | 396 ++++++++++++++++++-------------------- 2 files changed, 190 insertions(+), 208 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e3c118bad..8294047e7 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -425,7 +425,7 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) case (PLASTICITY_DISLOUCLA_ID) plasticityType of = phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - call plastic_disloUCLA_dependentState(temperature(ho)%p(tme),instance,of) + call plastic_disloUCLA_dependentState(instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_microstructure (Fe,Fp,ip,el) end select plasticityType diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 51fabe042..bb06618e4 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -29,7 +29,7 @@ module plastic_disloUCLA real(pReal), dimension(:,:,:), allocatable, private :: & plastic_disloUCLA_forestProjectionEdge !< matrix of forest projections of edge dislocations for each instance - enum, bind(c) + enum, bind(c) enumerator :: undefined_ID, & rho_ID, & rhoDip_ID, & @@ -59,13 +59,13 @@ module plastic_disloUCLA v0, & !< dislocation velocity prefactor [m/s] for each family and instance CLambda, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance p, & !< p-exponent in glide velocity - q, & !< q-exponent in glide velocity - !* mobility law parameters - kink_height, & !< height of the kink pair - kink_width, & !< width of the kink pair - omega, & !< attempt frequency for kink pair nucleation + q, & !< q-exponent in glide velocity + !* mobility law parameters + kink_height, & !< height of the kink pair + kink_width, & !< width of the kink pair + omega, & !< attempt frequency for kink pair nucleation viscosity, & !< friction coeff. B (kMC) - !* + !* tau_Peierls, & nonSchmidCoeff, & atomicVolume, & @@ -88,28 +88,28 @@ module plastic_disloUCLA end type !< container type for internal constitutive parameters type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) - - type, private :: tDisloUCLAState + + type, private :: tDisloUCLAState real(pReal), pointer, dimension(:,:) :: & rhoEdge, & rhoEdgeDip, & accshear_slip, & whole - end type + end type - type, private :: tDisloUCLAMicrostructure + type, private :: tDisloUCLAdependentState real(pReal), allocatable, dimension(:,:) :: & mfp, & threshold_stress - end type tDisloUCLAMicrostructure + end type tDisloUCLAdependentState type(tDisloUCLAState ), allocatable, dimension(:), private :: & state, & dotState - type(tDisloUCLAMicrostructure), allocatable, dimension(:), private :: & - microstructure - + type(tDisloUCLAdependentState), allocatable, dimension(:), private :: & + dependentState + public :: & plastic_disloUCLA_init, & plastic_disloUCLA_dependentState, & @@ -156,15 +156,15 @@ subroutine plastic_disloUCLA_init() MATERIAL_partPhase, & config_phase use lattice - + implicit none integer(pInt) :: maxNinstance,& - f,instance,j,k,o, i, & - outputSize, phase, & + f,j,k,o, i, & + outputSize, & offset_slip, index_myFamily, index_otherFamily, & - startIndex, endIndex, p - integer(pInt) :: sizeState, sizeDotState - integer(pInt) :: NofMyPhase + startIndex, endIndex, p, & + sizeState, sizeDotState, & + NofMyPhase character(len=65536) :: & structure = '' character(len=65536), dimension(:), allocatable :: outputs @@ -172,16 +172,16 @@ subroutine plastic_disloUCLA_init() integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOUCLA_label//' init -+>>>' write(6,'(/,a)') ' Cereceda et al., International Journal of Plasticity 78, 2016, 242-256' write(6,'(/,a)') ' http://dx.doi.org/10.1016/j.ijplas.2015.09.002' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - + maxNinstance = int(count(phase_plasticity == PLASTICITY_DISLOUCLA_ID),pInt) if (maxNinstance == 0_pInt) return - + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance @@ -192,19 +192,19 @@ subroutine plastic_disloUCLA_init() allocate(plastic_disloUCLA_totalNslip(maxNinstance), source=0_pInt) - + allocate(param(maxNinstance)) allocate(state(maxNinstance)) allocate(dotState(maxNinstance)) - allocate(microstructure(maxNinstance)) + allocate(dependentState(maxNinstance)) -do p = 1_pInt, size(phase_plasticityInstance) + do p = 1_pInt, size(phase_plasticityInstance) if (phase_plasticity(p) /= PLASTICITY_DISLOUCLA_ID) cycle associate(prm => param(phase_plasticityInstance(p)), & dot => dotState(phase_plasticityInstance(p)), & stt => state(phase_plasticityInstance(p)), & - mse => microstructure(phase_plasticityInstance(p))) + dst => dependentState(phase_plasticityInstance(p))) structure = config_phase(p)%getString('lattice_structure') prm%mu = lattice_mu(p) @@ -273,9 +273,8 @@ do p = 1_pInt, size(phase_plasticityInstance) prm%clambda = math_expand(prm%clambda, prm%Nslip) prm%atomicVolume = math_expand(prm%atomicVolume, prm%Nslip) prm%minDipDistance = math_expand(prm%minDipDistance, prm%Nslip) - - instance = phase_plasticityInstance(p) - plastic_disloUCLA_totalNslip(instance) = prm%totalNslip + + plastic_disloUCLA_totalNslip(phase_plasticityInstance(p)) = prm%totalNslip !if (plastic_disloUCLA_CAtomicVolume(instance) <= 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOUCLA_label//')') ! if (prm%D0 <= 0.0_pReal) & @@ -283,61 +282,10 @@ do p = 1_pInt, size(phase_plasticityInstance) ! if (plastic_disloUCLA_Qsd(instance) <= 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='Qsd ('//PLASTICITY_DISLOUCLA_label//')') ! if (plastic_disloUCLA_aTolRho(instance) <= 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='aTolRho ('//PLASTICITY_DISLOUCLA_label//')') - - else slipActive - allocate(prm%rho0(0)) - allocate(prm%rhoDip0(0)) - endif slipActive - - -#if defined(__GFORTRAN__) - outputs = ['GfortranBug86277'] - outputs = config_phase(p)%getStrings('(output)',defaultVal=outputs) - if (outputs(1) == 'GfortranBug86277') outputs = emptyStringArray -#else - outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) -#endif - allocate(prm%outputID(0)) - - do i = 1_pInt, size(outputs) - outputID = undefined_ID - outputSize = prm%totalNslip - select case(trim(outputs(i))) - case ('edge_density') - outputID = merge(rho_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('dipole_density') - outputID = merge(rhoDip_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('shear_rate','shearrate','shear_rate_slip','shearrate_slip') - outputID = merge(shearrate_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('accumulated_shear','accumulatedshear','accumulated_shear_slip') - outputID = merge(accumulatedshear_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('mfp','mfp_slip') - outputID = merge(mfp_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('resolved_stress','resolved_stress_slip') - outputID = merge(resolvedstress_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('threshold_stress','threshold_stress_slip') - outputID = merge(thresholdstress_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('edge_dipole_distance') - outputID = merge(dipoleDistance_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('stress_exponent') - outputID = merge(stressexponent_ID,undefined_ID,prm%totalNslip>0_pInt) - end select - - if (outputID /= undefined_ID) then - plastic_disloUCLA_output(i,phase_plasticityInstance(p)) = outputs(i) - plastic_disloUCLA_sizePostResult(i,phase_plasticityInstance(p)) = outputSize - prm%outputID = [prm%outputID, outputID] - endif - - enddo - - - - - !if (plastic_disloUCLA_rhoEdge0(f,instance) < 0.0_pReal) & + ! call IO_error(211_pInt,el=instance,ext_msg='aTolRho ('//PLASTICITY_DISLOUCLA_label//')') + !if (plastic_disloUCLA_rhoEdge0(f,instance) < 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='rhoEdge0 ('//PLASTICITY_DISLOUCLA_label//')') - !if (plastic_disloUCLA_rhoEdgeDip0(f,instance) < 0.0_pReal) & + !if (plastic_disloUCLA_rhoEdgeDip0(f,instance) < 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='rhoEdgeDip0 ('//PLASTICITY_DISLOUCLA_label//')') !if (plastic_disloUCLA_burgersPerSlipFamily(f,instance) <= 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='slipBurgers ('//PLASTICITY_DISLOUCLA_label//')') @@ -346,55 +294,101 @@ do p = 1_pInt, size(phase_plasticityInstance) !if (plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance) < 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='tau_peierls ('//PLASTICITY_DISLOUCLA_label//')') - phase = p - NofMyPhase=count(material_phase==phase) - instance = phase_plasticityInstance(phase) + + else slipActive + allocate(prm%rho0(0)) + allocate(prm%rhoDip0(0)) + endif slipActive + + +#if defined(__GFORTRAN__) + outputs = ['GfortranBug86277'] + outputs = config_phase(p)%getStrings('(output)',defaultVal=outputs) + if (outputs(1) == 'GfortranBug86277') outputs = emptyStringArray +#else + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) +#endif + allocate(prm%outputID(0)) + + do i = 1_pInt, size(outputs) + outputID = undefined_ID + outputSize = prm%totalNslip + select case(trim(outputs(i))) + case ('edge_density') + outputID = merge(rho_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('dipole_density') + outputID = merge(rhoDip_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('shear_rate','shearrate','shear_rate_slip','shearrate_slip') + outputID = merge(shearrate_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('accumulated_shear','accumulatedshear','accumulated_shear_slip') + outputID = merge(accumulatedshear_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('mfp','mfp_slip') + outputID = merge(mfp_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('resolved_stress','resolved_stress_slip') + outputID = merge(resolvedstress_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('threshold_stress','threshold_stress_slip') + outputID = merge(thresholdstress_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('edge_dipole_distance') + outputID = merge(dipoleDistance_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('stress_exponent') + outputID = merge(stressexponent_ID,undefined_ID,prm%totalNslip>0_pInt) + end select + + if (outputID /= undefined_ID) then + plastic_disloUCLA_output(i,phase_plasticityInstance(p)) = outputs(i) + plastic_disloUCLA_sizePostResult(i,phase_plasticityInstance(p)) = outputSize + prm%outputID = [prm%outputID, outputID] + endif + + enddo + + NofMyPhase=count(material_phase==p) !-------------------------------------------------------------------------------------------------- ! allocate state arrays - sizeDotState = int(size(['rhoEdge ','rhoEdgeDip ','accshearslip']),pInt) * prm%totalNslip - sizeState = sizeDotState + sizeDotState = int(size(['rhoEdge ','rhoEdgeDip ','accshearslip']),pInt) * prm%totalNslip + sizeState = sizeDotState - call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,0_pInt, & + call material_allocatePlasticState(p,NofMyPhase,sizeState,sizeDotState,0_pInt, & prm%totalNslip,0_pInt,0_pInt) - plasticState(phase)%sizePostResults = sum(plastic_disloUCLA_sizePostResult(:,phase_plasticityInstance(p))) + plasticState(p)%sizePostResults = sum(plastic_disloUCLA_sizePostResult(:,phase_plasticityInstance(p))) - offset_slip = 2_pInt*plasticState(phase)%nSlip - plasticState(phase)%slipRate => & - plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NofMyPhase) - plasticState(phase)%accumulatedSlip => & - plasticState(phase)%state (offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NofMyPhase) - - startIndex=1_pInt - endIndex=prm%totalNslip - stt%rhoEdge=>plasticState(phase)%state(startIndex:endIndex,:) - stt%rhoEdge= spread(prm%rho0,2,NofMyPhase) - dotState(instance)%rhoEdge=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho + offset_slip = 2_pInt*plasticState(p)%nSlip + plasticState(p)%slipRate => & + plasticState(p)%dotState(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NofMyPhase) + plasticState(p)%accumulatedSlip => & + plasticState(p)%state (offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NofMyPhase) - startIndex=endIndex+1_pInt - endIndex=endIndex+prm%totalNslip - stt%rhoEdgeDip=>plasticState(phase)%state(startIndex:endIndex,:) - stt%rhoEdgeDip= spread(prm%rhoDip0,2,NofMyPhase) - dotState(instance)%rhoEdgeDip=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho + startIndex=1_pInt + endIndex=prm%totalNslip + stt%rhoEdge=>plasticState(p)%state(startIndex:endIndex,:) + stt%rhoEdge= spread(prm%rho0,2,NofMyPhase) + dot%rhoEdge=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho - startIndex=endIndex+1_pInt - endIndex=endIndex+prm%totalNslip - stt%accshear_slip=>plasticState(phase)%state(startIndex:endIndex,:) - dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = 1e6_pReal + startIndex=endIndex+1_pInt + endIndex=endIndex+prm%totalNslip + stt%rhoEdgeDip=>plasticState(p)%state(startIndex:endIndex,:) + stt%rhoEdgeDip= spread(prm%rhoDip0,2,NofMyPhase) + dot%rhoEdgeDip=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho - dotState(instance)%whole => plasticState(phase)%dotState + startIndex=endIndex+1_pInt + endIndex=endIndex+prm%totalNslip + stt%accshear_slip=>plasticState(p)%state(startIndex:endIndex,:) + dot%accshear_slip=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = 1e6_pReal + + dot%whole => plasticState(p)%dotState - allocate(mse%mfp(prm%totalNslip,NofMyPhase),source=0.0_pReal) - allocate(mse%threshold_stress(prm%totalNslip,NofMyPhase),source=0.0_pReal) + allocate(dst%mfp(prm%totalNslip,NofMyPhase),source=0.0_pReal) + allocate(dst%threshold_stress(prm%totalNslip,NofMyPhase),source=0.0_pReal) - plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally + plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally end associate enddo @@ -404,63 +398,60 @@ do p = 1_pInt, size(phase_plasticityInstance) maxval(plastic_disloUCLA_totalNslip),maxNinstance), & source=0.0_pReal) -do p = 1_pInt, size(phase_plasticityInstance) + do p = 1_pInt, size(phase_plasticityInstance) if (phase_plasticity(p) /= PLASTICITY_DISLOUCLA_ID) cycle associate(prm => param(phase_plasticityInstance(p)), & dot => dotState(phase_plasticityInstance(p)), & stt => state(phase_plasticityInstance(p)), & - mse => microstructure(phase_plasticityInstance(p))) + dst => dependentState(phase_plasticityInstance(p))) mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) index_myFamily = sum(prm%Nslip(1:f-1_pInt)) ! index in truncated slip system list mySlipSystems: do j = 1_pInt,prm%Nslip(f) - + !* Calculation of forest projections for edge dislocations otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) otherSlipSystems: do k = 1_pInt,prm%Nslip(o) - plastic_disloUCLA_forestProjectionEdge(index_myFamily+j,index_otherFamily+k,instance) = & + plastic_disloUCLA_forestProjectionEdge(index_myFamily+j,index_otherFamily+k,phase_plasticityInstance(p)) = & abs(math_mul3x3(lattice_sn(:,sum(lattice_NslipSystem(1:f-1,p))+j,p), & lattice_st(:,sum(lattice_NslipSystem(1:o-1,p))+k,p))) enddo otherSlipSystems; enddo otherSlipFamilies - + enddo mySlipSystems enddo mySlipFamilies end associate enddo - + end subroutine plastic_disloUCLA_init !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- -subroutine plastic_disloUCLA_dependentState(temperature,instance,of) +subroutine plastic_disloUCLA_dependentState(instance,of) implicit none integer(pInt), intent(in) :: instance, of - real(pReal), intent(in) :: & - temperature !< temperature at IP integer(pInt) :: & - s + i real(pReal), dimension(param(instance)%totalNslip) :: & invLambdaSlip ! 1/mean free distance between 2 forest dislocations seen by a moving dislocation - associate(prm => param(instance), stt => state(instance),mse => microstructure(instance)) - - forall (s = 1_pInt:prm%totalNslip) & - invLambdaSlip(s) = sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), & - plastic_disloUCLA_forestProjectionEdge(:,s,instance))) & - / prm%Clambda(s) - - mse%mfp(:,of) = prm%grainSize/(1.0_pReal+prm%grainSize*invLambdaSlip) + associate(prm => param(instance), stt => state(instance),dst => dependentState(instance)) - forall (s = 1_pInt:prm%totalNslip) & - mse%threshold_stress(s,of) = prm%mu*prm%burgers(s) & + forall (i = 1_pInt:prm%totalNslip) + invLambdaSlip(i) = sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), & + plastic_disloUCLA_forestProjectionEdge(:,i,instance))) & + / prm%Clambda(i) + dst%threshold_stress(i,of) = prm%mu*prm%burgers(i) & * sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), & - prm%interaction_SlipSlip(s,:))) + prm%interaction_SlipSlip(i,:))) + end forall + + dst%mfp(:,of) = prm%grainSize/(1.0_pReal+prm%grainSize*invLambdaSlip) end associate @@ -471,7 +462,7 @@ end subroutine plastic_disloUCLA_dependentState !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance,of) - + implicit none integer(pInt), intent(in) :: instance, of real(pReal), intent(in) :: Temperature @@ -483,13 +474,13 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, real(pReal), dimension(param(instance)%totalNslip) :: & gdot_slip_pos,gdot_slip_neg,tau_slip_pos,tau_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg - + associate(prm => param(instance)) - + Lp = 0.0_pReal dLp_dMp = 0.0_pReal - - call kinetics(Mp,Temperature,instance,of, & + + call kinetics(Mp,Temperature,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) slipSystems: do i = 1_pInt, prm%totalNslip Lp = Lp + (gdot_slip_pos(i)+gdot_slip_neg(i))*prm%Schmid_slip(1:3,1:3,i) @@ -534,24 +525,24 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) dgdot_dtauslip_neg,dgdot_dtauslip_pos,DotRhoDipFormation, ClimbVelocity, EdgeDipDistance, & DotRhoEdgeDipClimb - associate(prm => param(instance), stt => state(instance),dot => dotState(instance), mse => microstructure(instance)) + associate(prm => param(instance), stt => state(instance),dot => dotState(instance), dst => dependentState(instance)) - call kinetics(Mp,Temperature,instance,of, & + call kinetics(Mp,Temperature,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) - + dot%whole(:,of) = 0.0_pReal dot%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)*0.5_pReal VacancyDiffusion = prm%D0*exp(-prm%Qsd/(kB*Temperature)) where(dEq0(tau_slip_pos)) - EdgeDipDistance = mse%mfp(:,of) !ToDo MD@FR: correct? was not handled properly before + EdgeDipDistance = dst%mfp(:,of) !ToDo MD@FR: correct? was not handled properly before DotRhoDipFormation = 0.0_pReal DotRhoEdgeDipClimb = 0.0_pReal else where EdgeDipDistance = math_clip((3.0_pReal*prm%mu*prm%burgers)/(16.0_pReal*PI*abs(tau_slip_pos)), & prm%minDipDistance, & ! lower limit - mse%mfp(:,of)) ! upper limit + dst%mfp(:,of)) ! upper limit DotRhoDipFormation = merge(((2.0_pReal*EdgeDipDistance)/prm%burgers)* stt%rhoEdge(:,of)*abs(dot%accshear_slip(:,of)), & 0.0_pReal, & prm%dipoleformation) @@ -560,7 +551,7 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) DotRhoEdgeDipClimb = (4.0_pReal*ClimbVelocity*stt%rhoEdgeDip(:,of))/(EdgeDipDistance-prm%minDipDistance) end where - dot%rhoEdge(:,of) = abs(dot%accshear_slip(:,of))/(prm%burgers*mse%mfp(:,of)) & ! multiplication + dot%rhoEdge(:,of) = abs(dot%accshear_slip(:,of))/(prm%burgers*dst%mfp(:,of)) & ! multiplication - DotRhoDipFormation & - ((2.0_pReal*prm%minDipDistance)/prm%burgers)*stt%rhoEdge(:,of)*abs(dot%accshear_slip(:,of)) !* Spontaneous annihilation of 2 single edge dislocations @@ -569,10 +560,10 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) - DotRhoEdgeDipClimb end associate - + end subroutine plastic_disloUCLA_dotState - + !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- @@ -601,7 +592,7 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos, & gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg - associate( prm => param(instance), stt => state(instance), mse => microstructure(instance)) + associate( prm => param(instance), stt => state(instance), dst => dependentState(instance)) postResults = 0.0_pReal c = 0_pInt @@ -614,7 +605,7 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe case (rhoDip_ID) postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdgeDip(1_pInt:prm%totalNslip,of) case (shearrate_ID,stressexponent_ID) - call kinetics(Mp,Temperature,instance,of, & + call kinetics(Mp,Temperature,instance,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) if (prm%outputID(o) == shearrate_ID) then @@ -631,13 +622,13 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe case (accumulatedshear_ID) postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1_pInt:prm%totalNslip, of) case (mfp_ID) - postResults(c+1_pInt:c+prm%totalNslip) = mse%mfp(1_pInt:prm%totalNslip, of) + postResults(c+1_pInt:c+prm%totalNslip) = dst%mfp(1_pInt:prm%totalNslip, of) case (resolvedstress_ID) do i = 1_pInt, prm%totalNslip postResults(c+i) =math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,i)) enddo case (thresholdstress_ID) - postResults(c+1_pInt:c+prm%totalNslip) = mse%threshold_stress(1_pInt:prm%totalNslip,of) + postResults(c+1_pInt:c+prm%totalNslip) = dst%threshold_stress(1_pInt:prm%totalNslip,of) case (dipoleDistance_ID) do i = 1_pInt, prm%totalNslip if (dNeq0(abs(math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,i))))) then @@ -646,7 +637,7 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe else postResults(c+i) = huge(1.0_pReal) endif - postResults(c+i)=min(postResults(c+i),mse%mfp(i,of)) + postResults(c+i)=min(postResults(c+i),dst%mfp(i,of)) enddo end select @@ -684,50 +675,45 @@ instance,of dvel_slip, vel_slip real(pReal), intent(out), dimension(plastic_disloUCLA_totalNslip(instance)) :: & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg - associate(prm => param(instance), stt => state(instance),mse => microstructure(instance)) - - gdot_slip_pos = 0.0_pReal gdot_slip_neg = 0.0_pReal dgdot_dtauslip_pos = 0.0_pReal dgdot_dtauslip_neg = 0.0_pReal + + associate(prm => param(instance), stt => state(instance),dst => dependentState(instance)) + + do j = 1_pInt, prm%totalNslip - !* Boltzmann ratio + BoltzmannRatio = prm%H0kp(j)/(kB*Temperature) - !* Initial shear rates DotGamma0 = stt%rhoEdge(j,of)*prm%burgers(j)*prm%v0(j) - !* Resolved shear stress on slip system + tau_slip_pos(j) = math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)) tau_slip_neg(j) = math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j)) - significantPositiveTau: if((abs(tau_slip_pos(j))-mse%threshold_stress(j, of)) > tol_math_check) then - !* Stress ratio - stressRatio = ((abs(tau_slip_pos(j))-mse%threshold_stress(j, of))/& - (prm%solidSolutionStrength+& - prm%tau_Peierls(j))) + significantPositiveTau: if((abs(tau_slip_pos(j))-dst%threshold_stress(j, of)) > tol_math_check) then + + stressRatio = ((abs(tau_slip_pos(j))-dst%threshold_stress(j, of)) & + / (prm%solidSolutionStrength+prm%tau_Peierls(j))) stressRatio_p = stressRatio** prm%p(j) stressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal) - !* Shear rates due to slip - vel_slip = 2.0_pReal*prm%burgers(j) & - * prm%kink_height(j) * prm%omega(j) & - * ( mse%mfp(j,of) - prm%kink_width(j) ) & + + vel_slip = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & + * ( dst%mfp(j,of) - prm%kink_width(j) ) & * (tau_slip_pos(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & / ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) - - gdot_slip_pos(j) = DotGamma0 * sign(vel_slip,tau_slip_pos(j)) - !* Derivatives of shear rates - dvel_slip = & - 2.0_pReal*prm%burgers(j) & - * prm%kink_height(j) * prm%omega(j) & - * ( mse%mfp(j,of) - prm%kink_width(j) ) & + gdot_slip_pos(j) = DotGamma0 * sign(vel_slip,tau_slip_pos(j)) + + dvel_slip = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & + * ( dst%mfp(j,of) - prm%kink_width(j) ) & * ( & (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + tau_slip_pos(j) & @@ -739,14 +725,14 @@ instance,of ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) & - (tau_slip_pos(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& *BoltzmannRatio*prm%p(j)& *prm%q(j)/& @@ -758,7 +744,7 @@ instance,of ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & )**2.0_pReal & ) @@ -768,63 +754,59 @@ instance,of endif significantPositiveTau - significantNegativeTau: if((abs(tau_slip_neg(j))-mse%threshold_stress(j, of)) > tol_math_check) then - !* Stress ratios - stressRatio = ((abs(tau_slip_neg(j))-mse%threshold_stress(j, of))/& - (prm%solidSolutionStrength+& - prm%tau_Peierls(j))) + significantNegativeTau: if((abs(tau_slip_neg(j))-dst%threshold_stress(j, of)) > tol_math_check) then + + stressRatio = ((abs(tau_slip_neg(j))-dst%threshold_stress(j, of)) & + / (prm%solidSolutionStrength+prm%tau_Peierls(j))) stressRatio_p = stressRatio** prm%p(j) stressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal) - !* Shear rates due to slip - vel_slip = 2.0_pReal*prm%burgers(j) & - * prm%kink_height(j) * prm%omega(j) & - * ( mse%mfp(j,of) - prm%kink_width(j) ) & + + vel_slip = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & + * ( dst%mfp(j,of) - prm%kink_width(j) ) & * (tau_slip_neg(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & / ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) - + gdot_slip_neg(j) = DotGamma0 * sign(vel_slip,tau_slip_neg(j)) - !* Derivatives of shear rates - dvel_slip = & - 2.0_pReal*prm%burgers(j) & - * prm%kink_height(j) * prm%omega(j) & - * ( mse%mfp(j,of) - prm%kink_width(j) ) & + + dvel_slip = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & + * ( dst%mfp(j,of) - prm%kink_width(j) ) & * ( & (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + tau_slip_neg(j) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& *BoltzmannRatio*prm%p(j)& *prm%q(j)/& (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) & + StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) & ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & ) & - (tau_slip_neg(j) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& + *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& *BoltzmannRatio*prm%p(j)& *prm%q(j)/& (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& + StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& ) & ) & / ( & ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + prm%omega(j) * prm%B(j) & - *(( mse%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & + *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & )**2.0_pReal & ) From 89b054e67b49edd700efc41b89197ae047034ed5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 9 Dec 2018 14:29:19 +0100 Subject: [PATCH 39/47] ordered --- src/plastic_disloUCLA.f90 | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index bb06618e4..2716e7828 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -46,32 +46,32 @@ module plastic_disloUCLA real(pReal) :: & aTolRho, & grainSize, & - SolidSolutionStrength, & !< Strength due to elements in solid solution + SolidSolutionStrength, & !< Strength due to elements in solid solution mu, & D0, & !< prefactor for self-diffusion coefficient Qsd !< activation energy for dislocation climb real(pReal), allocatable, dimension(:) :: & - B, & !< friction coeff. B (kMC) rho0, & !< initial edge dislocation density per slip system for each family and instance rhoDip0, & !< initial edge dipole density per slip system for each family and instance burgers, & !< absolute length of burgers vector [m] for each slip system and instance + nonSchmidCoeff, & + minDipDistance, & + CLambda, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance + atomicVolume, & + !* mobility law parameters H0kp, & !< activation energy for glide [J] for each slip system and instance v0, & !< dislocation velocity prefactor [m/s] for each family and instance - CLambda, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance p, & !< p-exponent in glide velocity q, & !< q-exponent in glide velocity - !* mobility law parameters + B, & !< friction coeff. B (kMC) kink_height, & !< height of the kink pair kink_width, & !< width of the kink pair - omega, & !< attempt frequency for kink pair nucleation - viscosity, & !< friction coeff. B (kMC) - !* - tau_Peierls, & - nonSchmidCoeff, & - atomicVolume, & - minDipDistance + omega, & !< attempt frequency for kink pair nucleation + tau_Peierls + real(pReal), allocatable, dimension(:,:) :: & - interaction_SlipSlip !< slip resistance from slip activity + interaction_SlipSlip, & !< slip resistance from slip activity + forestProjectionEdge real(pReal), allocatable, dimension(:,:,:) :: & Schmid_slip, & Schmid_twin, & @@ -90,11 +90,11 @@ module plastic_disloUCLA type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) type, private :: tDisloUCLAState - real(pReal), pointer, dimension(:,:) :: & - rhoEdge, & - rhoEdgeDip, & - accshear_slip, & - whole + real(pReal), pointer, dimension(:,:) :: & + rhoEdge, & + rhoEdgeDip, & + accshear_slip, & + whole end type type, private :: tDisloUCLAdependentState @@ -637,7 +637,7 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe else postResults(c+i) = huge(1.0_pReal) endif - postResults(c+i)=min(postResults(c+i),dst%mfp(i,of)) + postResults(c+i)=min(postResults(c+i),dst%mfp(i,of)) enddo end select From 331a2b9b78e5301091ce57203ce558033d76fa41 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 9 Dec 2018 14:49:08 +0100 Subject: [PATCH 40/47] simplified --- src/plastic_disloUCLA.f90 | 82 +++++++++++++++------------------------ 1 file changed, 32 insertions(+), 50 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 2716e7828..7a84f4d0a 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -26,9 +26,6 @@ module plastic_disloUCLA plastic_disloUCLA_totalNslip !< total number of active slip systems for each instance - real(pReal), dimension(:,:,:), allocatable, private :: & - plastic_disloUCLA_forestProjectionEdge !< matrix of forest projections of edge dislocations for each instance - enum, bind(c) enumerator :: undefined_ID, & rho_ID, & @@ -68,7 +65,6 @@ module plastic_disloUCLA kink_width, & !< width of the kink pair omega, & !< attempt frequency for kink pair nucleation tau_Peierls - real(pReal), allocatable, dimension(:,:) :: & interaction_SlipSlip, & !< slip resistance from slip activity forestProjectionEdge @@ -192,7 +188,6 @@ subroutine plastic_disloUCLA_init() allocate(plastic_disloUCLA_totalNslip(maxNinstance), source=0_pInt) - allocate(param(maxNinstance)) allocate(state(maxNinstance)) allocate(dotState(maxNinstance)) @@ -355,6 +350,24 @@ subroutine plastic_disloUCLA_init() plasticState(p)%sizePostResults = sum(plastic_disloUCLA_sizePostResult(:,phase_plasticityInstance(p))) + allocate(prm%forestProjectionEdge(prm%totalNslip,prm%totalNslip),source = 0.0_pReal) + + i = 0_pInt + mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) + index_myFamily = sum(prm%Nslip(1:f-1_pInt)) + + slipSystemsLoop: do j = 1_pInt,prm%Nslip(f) + i = i + 1_pInt + do o = 1_pInt, size(prm%Nslip,1) + index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) + do k = 1_pInt,prm%Nslip(o) ! loop over (active) systems in other family (slip) + prm%forestProjectionEdge(index_myFamily+j,index_otherFamily+k) = & + abs(math_mul3x3(lattice_sn(:,sum(lattice_NslipSystem(1:f-1,p))+j,p), & + lattice_st(:,sum(lattice_NslipSystem(1:o-1,p))+k,p))) + enddo; enddo + enddo slipSystemsLoop + enddo mySlipFamilies + offset_slip = 2_pInt*plasticState(p)%nSlip plasticState(p)%slipRate => & plasticState(p)%dotState(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NofMyPhase) @@ -390,40 +403,8 @@ subroutine plastic_disloUCLA_init() plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally end associate - enddo - - allocate(plastic_disloUCLA_forestProjectionEdge(maxval(plastic_disloUCLA_totalNslip),& - maxval(plastic_disloUCLA_totalNslip),maxNinstance), & - source=0.0_pReal) - - do p = 1_pInt, size(phase_plasticityInstance) - if (phase_plasticity(p) /= PLASTICITY_DISLOUCLA_ID) cycle - associate(prm => param(phase_plasticityInstance(p)), & - dot => dotState(phase_plasticityInstance(p)), & - stt => state(phase_plasticityInstance(p)), & - dst => dependentState(phase_plasticityInstance(p))) - - mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) - index_myFamily = sum(prm%Nslip(1:f-1_pInt)) ! index in truncated slip system list - mySlipSystems: do j = 1_pInt,prm%Nslip(f) - - !* Calculation of forest projections for edge dislocations - otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) - index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) - otherSlipSystems: do k = 1_pInt,prm%Nslip(o) - plastic_disloUCLA_forestProjectionEdge(index_myFamily+j,index_otherFamily+k,phase_plasticityInstance(p)) = & - abs(math_mul3x3(lattice_sn(:,sum(lattice_NslipSystem(1:f-1,p))+j,p), & - lattice_st(:,sum(lattice_NslipSystem(1:o-1,p))+k,p))) - enddo otherSlipSystems; enddo otherSlipFamilies - - enddo mySlipSystems - enddo mySlipFamilies - end associate - -enddo - end subroutine plastic_disloUCLA_init @@ -444,7 +425,7 @@ subroutine plastic_disloUCLA_dependentState(instance,of) forall (i = 1_pInt:prm%totalNslip) invLambdaSlip(i) = sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), & - plastic_disloUCLA_forestProjectionEdge(:,i,instance))) & + prm%forestProjectionEdge(:,i))) & / prm%Clambda(i) dst%threshold_stress(i,of) = prm%mu*prm%burgers(i) & * sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), & @@ -480,8 +461,8 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, Lp = 0.0_pReal dLp_dMp = 0.0_pReal - call kinetics(Mp,Temperature,instance,of, & - gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) + call kinetics(prm,stt,dst,Mp,Temperature,of, & + gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) slipSystems: do i = 1_pInt, prm%totalNslip Lp = Lp + (gdot_slip_pos(i)+gdot_slip_neg(i))*prm%Schmid_slip(1:3,1:3,i) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & @@ -527,7 +508,7 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) associate(prm => param(instance), stt => state(instance),dot => dotState(instance), dst => dependentState(instance)) - call kinetics(Mp,Temperature,instance,of, & + call kinetics(prm,stt,dst,Mp,Temperature,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) dot%whole(:,of) = 0.0_pReal @@ -546,17 +527,17 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) DotRhoDipFormation = merge(((2.0_pReal*EdgeDipDistance)/prm%burgers)* stt%rhoEdge(:,of)*abs(dot%accshear_slip(:,of)), & 0.0_pReal, & prm%dipoleformation) - ClimbVelocity = ((3.0_pReal*prm%mu*VacancyDiffusion*prm%atomicVolume)/(2.0_pReal*pi*kB*Temperature)) & + ClimbVelocity = (3.0_pReal*prm%mu*VacancyDiffusion*prm%atomicVolume/(2.0_pReal*pi*kB*Temperature)) & * (1.0_pReal/(EdgeDipDistance+prm%minDipDistance)) DotRhoEdgeDipClimb = (4.0_pReal*ClimbVelocity*stt%rhoEdgeDip(:,of))/(EdgeDipDistance-prm%minDipDistance) end where dot%rhoEdge(:,of) = abs(dot%accshear_slip(:,of))/(prm%burgers*dst%mfp(:,of)) & ! multiplication - DotRhoDipFormation & - - ((2.0_pReal*prm%minDipDistance)/prm%burgers)*stt%rhoEdge(:,of)*abs(dot%accshear_slip(:,of)) !* Spontaneous annihilation of 2 single edge dislocations + - (2.0_pReal*prm%minDipDistance)/prm%burgers*stt%rhoEdge(:,of)*abs(dot%accshear_slip(:,of)) !* Spontaneous annihilation of 2 single edge dislocations dot%rhoEdgeDip(:,of) = DotRhoDipFormation & - - ((2.0_pReal*prm%minDipDistance)/prm%burgers)* stt%rhoEdgeDip(:,of)*abs(dot%accshear_slip(:,of)) & !* Spontaneous annihilation of a single edge dislocation with a dipole constituent + - (2.0_pReal*prm%minDipDistance)/prm%burgers* stt%rhoEdgeDip(:,of)*abs(dot%accshear_slip(:,of)) & !* Spontaneous annihilation of a single edge dislocation with a dipole constituent - DotRhoEdgeDipClimb end associate @@ -592,7 +573,7 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos, & gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg - associate( prm => param(instance), stt => state(instance), dst => dependentState(instance)) + associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) postResults = 0.0_pReal c = 0_pInt @@ -605,7 +586,7 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe case (rhoDip_ID) postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdgeDip(1_pInt:prm%totalNslip,of) case (shearrate_ID,stressexponent_ID) - call kinetics(Mp,Temperature,instance,of, & + call kinetics(prm,stt,dst,Mp,Temperature,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) if (prm%outputID(o) == shearrate_ID) then @@ -685,12 +666,13 @@ instance,of do j = 1_pInt, prm%totalNslip - - BoltzmannRatio = prm%H0kp(j)/(kB*Temperature) - DotGamma0 = stt%rhoEdge(j,of)*prm%burgers(j)*prm%v0(j) - tau_slip_pos(j) = math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)) tau_slip_neg(j) = math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j)) + enddo + + do j = 1_pInt, prm%totalNslip + BoltzmannRatio = prm%H0kp(j)/(kB*Temperature) + DotGamma0 = stt%rhoEdge(j,of)*prm%burgers(j)*prm%v0(j) significantPositiveTau: if((abs(tau_slip_pos(j))-dst%threshold_stress(j, of)) > tol_math_check) then From a0b389776d968f5d5a59f186f2ecdc1ab79f478c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 9 Dec 2018 15:00:37 +0100 Subject: [PATCH 41/47] same structure as for dislotwin --- src/plastic_disloUCLA.f90 | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 7a84f4d0a..9a5997a34 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -456,7 +456,7 @@ subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, real(pReal), dimension(param(instance)%totalNslip) :: & gdot_slip_pos,gdot_slip_neg,tau_slip_pos,tau_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg - associate(prm => param(instance)) + associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) Lp = 0.0_pReal dLp_dMp = 0.0_pReal @@ -632,7 +632,7 @@ end function plastic_disloUCLA_postResults !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -subroutine kinetics(Mp,Temperature,instance,of, & +subroutine kinetics(prm,stt,dst,Mp,Temperature,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) use prec, only: & tol_math_check, & @@ -642,19 +642,25 @@ subroutine kinetics(Mp,Temperature,instance,of, & math_mul33xx33 implicit none + type(tParameters), intent(in) :: & + prm + type(tDisloUCLAState), intent(in) :: & + stt + type(tDisloUCLAdependentState), intent(in) :: & + dst real(pReal), dimension(3,3), intent(in) :: & Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation real(pReal), intent(in) :: & temperature !< temperature at integration point integer(pInt), intent(in) :: & -instance,of + of integer(pInt) :: & j real(pReal) :: StressRatio_p,StressRatio_pminus1,& BoltzmannRatio,DotGamma0,stressRatio,& dvel_slip, vel_slip - real(pReal), intent(out), dimension(plastic_disloUCLA_totalNslip(instance)) :: & + real(pReal), intent(out), dimension(prm%totalNslip) :: & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg gdot_slip_pos = 0.0_pReal @@ -662,9 +668,6 @@ instance,of dgdot_dtauslip_pos = 0.0_pReal dgdot_dtauslip_neg = 0.0_pReal - associate(prm => param(instance), stt => state(instance),dst => dependentState(instance)) - - do j = 1_pInt, prm%totalNslip tau_slip_pos(j) = math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)) tau_slip_neg(j) = math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j)) @@ -797,7 +800,6 @@ instance,of dgdot_dtauslip_neg(j) = DotGamma0 * dvel_slip endif significantNegativeTau enddo - end associate end subroutine kinetics From e0cd88d98a8b7d9538f763c7ac0af7258d257497 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 9 Dec 2018 15:25:54 +0100 Subject: [PATCH 42/47] preparing for vectorization --- src/plastic_disloUCLA.f90 | 81 ++++++++++++++++++++------------------- 1 file changed, 42 insertions(+), 39 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 9a5997a34..840114e22 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -657,11 +657,13 @@ math_mul33xx33 integer(pInt) :: & j - real(pReal) :: StressRatio_p,StressRatio_pminus1,& - BoltzmannRatio,DotGamma0,stressRatio,& - dvel_slip, vel_slip + real(pReal) :: dvel_slip, vel_slip real(pReal), intent(out), dimension(prm%totalNslip) :: & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg + real(pReal), dimension(prm%totalNslip) :: & + StressRatio, BoltzmannRatio, & + StressRatio_p,StressRatio_pminus1, & + DotGamma0 gdot_slip_pos = 0.0_pReal gdot_slip_neg = 0.0_pReal @@ -673,56 +675,57 @@ math_mul33xx33 tau_slip_neg(j) = math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j)) enddo + BoltzmannRatio = prm%H0kp/(kB*Temperature) + DotGamma0 = stt%rhoEdge(:,of)*prm%burgers*prm%v0 + do j = 1_pInt, prm%totalNslip - BoltzmannRatio = prm%H0kp(j)/(kB*Temperature) - DotGamma0 = stt%rhoEdge(j,of)*prm%burgers(j)*prm%v0(j) significantPositiveTau: if((abs(tau_slip_pos(j))-dst%threshold_stress(j, of)) > tol_math_check) then - stressRatio = ((abs(tau_slip_pos(j))-dst%threshold_stress(j, of)) & + StressRatio(j) = ((abs(tau_slip_pos(j))-dst%threshold_stress(j, of)) & / (prm%solidSolutionStrength+prm%tau_Peierls(j))) - stressRatio_p = stressRatio** prm%p(j) - stressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal) + StressRatio_p(j) = StressRatio(j)** prm%p(j) + StressRatio_pminus1(j) = StressRatio(j)**(prm%p(j)-1.0_pReal) vel_slip = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & * ( dst%mfp(j,of) - prm%kink_width(j) ) & * (tau_slip_pos(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & + * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) ) & / ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + prm%omega(j) * prm%B(j) & *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & ) - gdot_slip_pos(j) = DotGamma0 * sign(vel_slip,tau_slip_pos(j)) + gdot_slip_pos(j) = DotGamma0(j) * sign(vel_slip,tau_slip_pos(j)) dvel_slip = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & * ( dst%mfp(j,of) - prm%kink_width(j) ) & * ( & - (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + (exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & + tau_slip_pos(j) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& - *BoltzmannRatio*prm%p(j)& + * (abs(exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)))& + *BoltzmannRatio(j)*prm%p(j)& *prm%q(j)/& (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) & + StressRatio_pminus1(j)*(1-StressRatio_p(j))**(prm%q(j)-1.0_pReal) ) & ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + prm%omega(j) * prm%B(j) & *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & ) & - (tau_slip_pos(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & + * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & + prm%omega(j) * prm%B(j) & *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& - *BoltzmannRatio*prm%p(j)& + * (abs(exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)))& + *BoltzmannRatio(j)*prm%p(j)& *prm%q(j)/& (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& + StressRatio_pminus1(j)*(1-StressRatio_p(j))**(prm%q(j)-1.0_pReal) )& ) & ) & / ( & @@ -730,61 +733,61 @@ math_mul33xx33 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & + prm%omega(j) * prm%B(j) & *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & )**2.0_pReal & ) - dgdot_dtauslip_pos(j) = DotGamma0 * dvel_slip + dgdot_dtauslip_pos(j) = DotGamma0(j) * dvel_slip endif significantPositiveTau significantNegativeTau: if((abs(tau_slip_neg(j))-dst%threshold_stress(j, of)) > tol_math_check) then - stressRatio = ((abs(tau_slip_neg(j))-dst%threshold_stress(j, of)) & + StressRatio(j) = ((abs(tau_slip_neg(j))-dst%threshold_stress(j, of)) & / (prm%solidSolutionStrength+prm%tau_Peierls(j))) - stressRatio_p = stressRatio** prm%p(j) - stressRatio_pminus1 = stressRatio**(prm%p(j)-1.0_pReal) + StressRatio_p(j) = StressRatio(j)** prm%p(j) + StressRatio_pminus1(j) = StressRatio(j)**(prm%p(j)-1.0_pReal) vel_slip = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & * ( dst%mfp(j,of) - prm%kink_width(j) ) & * (tau_slip_neg(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & + * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) ) & / ( & 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + prm%omega(j) * prm%B(j) & *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & ) - gdot_slip_neg(j) = DotGamma0 * sign(vel_slip,tau_slip_neg(j)) + gdot_slip_neg(j) = DotGamma0(j) * sign(vel_slip,tau_slip_neg(j)) dvel_slip = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & * ( dst%mfp(j,of) - prm%kink_width(j) ) & * ( & - (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + (exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & + tau_slip_neg(j) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& - *BoltzmannRatio*prm%p(j)& + * (abs(exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)))& + *BoltzmannRatio(j)*prm%p(j)& *prm%q(j)/& (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) ) & + StressRatio_pminus1(j)*(1-StressRatio_p(j))**(prm%q(j)-1.0_pReal) ) & ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + prm%omega(j) * prm%B(j) & *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & ) & - (tau_slip_neg(j) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) ) & + * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) ) & * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & + prm%omega(j) * prm%B(j) & *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)))& - *BoltzmannRatio*prm%p(j)& + * (abs(exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)))& + *BoltzmannRatio(j)*prm%p(j)& *prm%q(j)/& (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) )& + StressRatio_pminus1(j)*(1-StressRatio_p(j))**(prm%q(j)-1.0_pReal) )& ) & ) & / ( & @@ -792,12 +795,12 @@ math_mul33xx33 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & + prm%omega(j) * prm%B(j) & *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q(j)) & + * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & )**2.0_pReal & ) - dgdot_dtauslip_neg(j) = DotGamma0 * dvel_slip + dgdot_dtauslip_neg(j) = DotGamma0(j) * dvel_slip endif significantNegativeTau enddo From accd39b27f7ec255636b0cacb2362f9bd25fd9c8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 9 Dec 2018 15:58:51 +0100 Subject: [PATCH 43/47] structuring --- src/plastic_disloUCLA.f90 | 45 ++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 24 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 840114e22..86c1dd887 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -224,33 +224,30 @@ subroutine plastic_disloUCLA_init() prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & config_phase(p)%getFloats('interaction_slipslip'), & structure(1:3)) - prm%rho0 = config_phase(p)%getFloats('rhoedge0') - prm%rhoDip0 = config_phase(p)%getFloats('rhoedgedip0') - prm%burgers = config_phase(p)%getFloats('slipburgers') - prm%H0kp = config_phase(p)%getFloats('qedge') - prm%v0 = config_phase(p)%getFloats('v0') - prm%clambda = config_phase(p)%getFloats('clambdaslip') - prm%tau_Peierls = config_phase(p)%getFloats('tau_peierls') - prm%p = config_phase(p)%getFloats('p_slip',defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%q = config_phase(p)%getFloats('q_slip',defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%kink_height = config_phase(p)%getFloats('kink_height') - prm%kink_width = config_phase(p)%getFloats('kink_width') - prm%omega = config_phase(p)%getFloats('omega') - - prm%B = config_phase(p)%getFloats('friction_coeff') - + prm%rho0 = config_phase(p)%getFloats('rhoedge0', requiredShape=shape(prm%Nslip)) + prm%rhoDip0 = config_phase(p)%getFloats('rhoedgedip0', requiredShape=shape(prm%Nslip)) + prm%burgers = config_phase(p)%getFloats('slipburgers', requiredShape=shape(prm%Nslip)) + prm%H0kp = config_phase(p)%getFloats('qedge', requiredShape=shape(prm%Nslip)) + prm%v0 = config_phase(p)%getFloats('v0', requiredShape=shape(prm%Nslip)) + prm%clambda = config_phase(p)%getFloats('clambdaslip', requiredShape=shape(prm%Nslip)) + prm%tau_Peierls = config_phase(p)%getFloats('tau_peierls', requiredShape=shape(prm%Nslip)) + prm%p = config_phase(p)%getFloats('p_slip', requiredShape=shape(prm%Nslip), & + defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) + prm%q = config_phase(p)%getFloats('q_slip', requiredShape=shape(prm%Nslip), & + defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) + prm%kink_height = config_phase(p)%getFloats('kink_height', requiredShape=shape(prm%Nslip)) + prm%kink_width = config_phase(p)%getFloats('kink_width', requiredShape=shape(prm%Nslip)) + prm%omega = config_phase(p)%getFloats('omega', requiredShape=shape(prm%Nslip)) + prm%B = config_phase(p)%getFloats('friction_coeff', requiredShape=shape(prm%Nslip)) prm%SolidSolutionStrength = config_phase(p)%getFloat('solidsolutionstrength') + prm%grainSize = config_phase(p)%getFloat('grainsize') + prm%D0 = config_phase(p)%getFloat('d0') + prm%Qsd = config_phase(p)%getFloat('qsd') + prm%atomicVolume = config_phase(p)%getFloat('catomicvolume') * prm%burgers**3.0_pReal + prm%minDipDistance = config_phase(p)%getFloat('cedgedipmindistance') * prm%burgers + prm%dipoleformation = config_phase(p)%getFloat('dipoleformationfactor') > 0.0_pReal !should be on by default - prm%grainSize = config_phase(p)%getFloat('grainsize') - - prm%D0 = config_phase(p)%getFloat('d0') - prm%Qsd= config_phase(p)%getFloat('qsd') - - - prm%dipoleformation = config_phase(p)%getFloat('dipoleformationfactor') > 0.0_pReal !should be on by default - prm%atomicVolume = config_phase(p)%getFloat('catomicvolume') * prm%burgers**3.0_pReal - prm%minDipDistance = config_phase(p)%getFloat('cedgedipmindistance') * prm%burgers ! expand: family => system prm%rho0 = math_expand(prm%rho0, prm%Nslip) From ddecacb1727e3906f45f84ebced466e774430b03 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 9 Dec 2018 16:35:28 +0100 Subject: [PATCH 44/47] ready for vectorization --- src/plastic_disloUCLA.f90 | 35 +++++++++++++++-------------------- 1 file changed, 15 insertions(+), 20 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 86c1dd887..010e383a1 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -654,13 +654,12 @@ math_mul33xx33 integer(pInt) :: & j - real(pReal) :: dvel_slip, vel_slip real(pReal), intent(out), dimension(prm%totalNslip) :: & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg real(pReal), dimension(prm%totalNslip) :: & StressRatio, BoltzmannRatio, & StressRatio_p,StressRatio_pminus1, & - DotGamma0 + DotGamma0, dvel_slip, vel_slip gdot_slip_pos = 0.0_pReal gdot_slip_neg = 0.0_pReal @@ -676,15 +675,13 @@ math_mul33xx33 DotGamma0 = stt%rhoEdge(:,of)*prm%burgers*prm%v0 do j = 1_pInt, prm%totalNslip - - significantPositiveTau: if((abs(tau_slip_pos(j))-dst%threshold_stress(j, of)) > tol_math_check) then - - StressRatio(j) = ((abs(tau_slip_pos(j))-dst%threshold_stress(j, of)) & - / (prm%solidSolutionStrength+prm%tau_Peierls(j))) + significantPositiveTau: if(abs(tau_slip_pos(j))-dst%threshold_stress(j,of) > tol_math_check) then + StressRatio(j) = (abs(tau_slip_pos(j))-dst%threshold_stress(j,of)) & + / (prm%solidSolutionStrength+prm%tau_Peierls(j)) StressRatio_p(j) = StressRatio(j)** prm%p(j) StressRatio_pminus1(j) = StressRatio(j)**(prm%p(j)-1.0_pReal) - vel_slip = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & + vel_slip(j) = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & * ( dst%mfp(j,of) - prm%kink_width(j) ) & * (tau_slip_pos(j) & * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) ) & @@ -695,9 +692,9 @@ math_mul33xx33 * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & ) - gdot_slip_pos(j) = DotGamma0(j) * sign(vel_slip,tau_slip_pos(j)) + gdot_slip_pos(j) = DotGamma0(j) * sign(vel_slip(j),tau_slip_pos(j)) - dvel_slip = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & + dvel_slip(j) = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & * ( dst%mfp(j,of) - prm%kink_width(j) ) & * ( & (exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & @@ -734,19 +731,17 @@ math_mul33xx33 )**2.0_pReal & ) - dgdot_dtauslip_pos(j) = DotGamma0(j) * dvel_slip + dgdot_dtauslip_pos(j) = DotGamma0(j) * dvel_slip(j) endif significantPositiveTau - - significantNegativeTau: if((abs(tau_slip_neg(j))-dst%threshold_stress(j, of)) > tol_math_check) then - - StressRatio(j) = ((abs(tau_slip_neg(j))-dst%threshold_stress(j, of)) & - / (prm%solidSolutionStrength+prm%tau_Peierls(j))) + significantNegativeTau: if(abs(tau_slip_neg(j))-dst%threshold_stress(j,of) > tol_math_check) then + StressRatio(j) = (abs(tau_slip_neg(j))-dst%threshold_stress(j,of)) & + / (prm%solidSolutionStrength+prm%tau_Peierls(j)) StressRatio_p(j) = StressRatio(j)** prm%p(j) StressRatio_pminus1(j) = StressRatio(j)**(prm%p(j)-1.0_pReal) - vel_slip = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & + vel_slip(j) = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & * ( dst%mfp(j,of) - prm%kink_width(j) ) & * (tau_slip_neg(j) & * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) ) & @@ -757,9 +752,9 @@ math_mul33xx33 * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & ) - gdot_slip_neg(j) = DotGamma0(j) * sign(vel_slip,tau_slip_neg(j)) + gdot_slip_neg(j) = DotGamma0(j) * sign(vel_slip(j),tau_slip_neg(j)) - dvel_slip = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & + dvel_slip(j) = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & * ( dst%mfp(j,of) - prm%kink_width(j) ) & * ( & (exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & @@ -797,7 +792,7 @@ math_mul33xx33 ) - dgdot_dtauslip_neg(j) = DotGamma0(j) * dvel_slip + dgdot_dtauslip_neg(j) = DotGamma0(j) * dvel_slip(j) endif significantNegativeTau enddo From 9e03aae3bf57fce6095523dd4581f9dc2db68d6b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 9 Dec 2018 17:35:48 +0100 Subject: [PATCH 45/47] vectorized --- src/plastic_disloUCLA.f90 | 232 ++++++++++++++++++-------------------- 1 file changed, 111 insertions(+), 121 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 010e383a1..a10121318 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -22,10 +22,6 @@ module plastic_disloUCLA real(pReal), parameter, private :: & kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin - integer(pInt), dimension(:), allocatable, private :: & - plastic_disloUCLA_totalNslip !< total number of active slip systems for each instance - - enum, bind(c) enumerator :: undefined_ID, & rho_ID, & @@ -185,9 +181,6 @@ subroutine plastic_disloUCLA_init() allocate(plastic_disloUCLA_output(maxval(phase_Noutput),maxNinstance)) plastic_disloUCLA_output = '' - - allocate(plastic_disloUCLA_totalNslip(maxNinstance), source=0_pInt) - allocate(param(maxNinstance)) allocate(state(maxNinstance)) allocate(dotState(maxNinstance)) @@ -248,25 +241,23 @@ subroutine plastic_disloUCLA_init() prm%minDipDistance = config_phase(p)%getFloat('cedgedipmindistance') * prm%burgers prm%dipoleformation = config_phase(p)%getFloat('dipoleformationfactor') > 0.0_pReal !should be on by default - ! expand: family => system - prm%rho0 = math_expand(prm%rho0, prm%Nslip) - prm%rhoDip0 = math_expand(prm%rhoDip0, prm%Nslip) - prm%q = math_expand(prm%q, prm%Nslip) - prm%p = math_expand(prm%p, prm%Nslip) - prm%H0kp = math_expand(prm%H0kp, prm%Nslip) - prm%burgers = math_expand(prm%burgers, prm%Nslip) - prm%kink_height = math_expand(prm%kink_height, prm%Nslip) - prm%kink_width = math_expand(prm%kink_width, prm%Nslip) - prm%omega = math_expand(prm%omega, prm%Nslip) - prm%tau_Peierls = math_expand(prm%tau_Peierls, prm%Nslip) - prm%v0 = math_expand(prm%v0, prm%Nslip) - prm%B = math_expand(prm%B, prm%Nslip) - prm%clambda = math_expand(prm%clambda, prm%Nslip) - prm%atomicVolume = math_expand(prm%atomicVolume, prm%Nslip) - prm%minDipDistance = math_expand(prm%minDipDistance, prm%Nslip) + prm%rho0 = math_expand(prm%rho0, prm%Nslip) + prm%rhoDip0 = math_expand(prm%rhoDip0, prm%Nslip) + prm%q = math_expand(prm%q, prm%Nslip) + prm%p = math_expand(prm%p, prm%Nslip) + prm%H0kp = math_expand(prm%H0kp, prm%Nslip) + prm%burgers = math_expand(prm%burgers, prm%Nslip) + prm%kink_height = math_expand(prm%kink_height, prm%Nslip) + prm%kink_width = math_expand(prm%kink_width, prm%Nslip) + prm%omega = math_expand(prm%omega, prm%Nslip) + prm%tau_Peierls = math_expand(prm%tau_Peierls, prm%Nslip) + prm%v0 = math_expand(prm%v0, prm%Nslip) + prm%B = math_expand(prm%B, prm%Nslip) + prm%clambda = math_expand(prm%clambda, prm%Nslip) + prm%atomicVolume = math_expand(prm%atomicVolume, prm%Nslip) + prm%minDipDistance = math_expand(prm%minDipDistance, prm%Nslip) - plastic_disloUCLA_totalNslip(phase_plasticityInstance(p)) = prm%totalNslip !if (plastic_disloUCLA_CAtomicVolume(instance) <= 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOUCLA_label//')') ! if (prm%D0 <= 0.0_pReal) & @@ -439,7 +430,7 @@ end subroutine plastic_disloUCLA_dependentState !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance,of) +pure subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance,of) implicit none integer(pInt), intent(in) :: instance, of @@ -496,7 +487,7 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) real(pReal) :: & VacancyDiffusion - real(pReal), dimension(plastic_disloUCLA_totalNslip(instance)) :: & + real(pReal), dimension(param(instance)%totalNslip) :: & gdot_slip_pos, gdot_slip_neg,& tau_slip_pos,& tau_slip_neg, & @@ -629,7 +620,7 @@ end function plastic_disloUCLA_postResults !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -subroutine kinetics(prm,stt,dst,Mp,Temperature,of, & +pure subroutine kinetics(prm,stt,dst,Mp,Temperature,of, & gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) use prec, only: & tol_math_check, & @@ -661,11 +652,6 @@ math_mul33xx33 StressRatio_p,StressRatio_pminus1, & DotGamma0, dvel_slip, vel_slip - gdot_slip_pos = 0.0_pReal - gdot_slip_neg = 0.0_pReal - dgdot_dtauslip_pos = 0.0_pReal - dgdot_dtauslip_neg = 0.0_pReal - do j = 1_pInt, prm%totalNslip tau_slip_pos(j) = math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)) tau_slip_neg(j) = math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j)) @@ -674,127 +660,131 @@ math_mul33xx33 BoltzmannRatio = prm%H0kp/(kB*Temperature) DotGamma0 = stt%rhoEdge(:,of)*prm%burgers*prm%v0 - do j = 1_pInt, prm%totalNslip - significantPositiveTau: if(abs(tau_slip_pos(j))-dst%threshold_stress(j,of) > tol_math_check) then - StressRatio(j) = (abs(tau_slip_pos(j))-dst%threshold_stress(j,of)) & - / (prm%solidSolutionStrength+prm%tau_Peierls(j)) - StressRatio_p(j) = StressRatio(j)** prm%p(j) - StressRatio_pminus1(j) = StressRatio(j)**(prm%p(j)-1.0_pReal) + significantPositiveTau: where(abs(tau_slip_pos)-dst%threshold_stress(:,of) > tol_math_check) + StressRatio = (abs(tau_slip_pos)-dst%threshold_stress(:,of)) & + / (prm%solidSolutionStrength+prm%tau_Peierls) + StressRatio_p = StressRatio** prm%p + StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal) - vel_slip(j) = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & - * ( dst%mfp(j,of) - prm%kink_width(j) ) & - * (tau_slip_pos(j) & - * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) ) & + vel_slip = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega & + * ( dst%mfp(:,of) - prm%kink_width ) & + * (tau_slip_pos & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) ) & / ( & - 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & - + prm%omega(j) * prm%B(j) & - *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & + 2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_pos & + + prm%omega * prm%B & + *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & ) - gdot_slip_pos(j) = DotGamma0(j) * sign(vel_slip(j),tau_slip_pos(j)) + gdot_slip_pos = DotGamma0 * sign(vel_slip,tau_slip_pos) - dvel_slip(j) = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & - * ( dst%mfp(j,of) - prm%kink_width(j) ) & + dvel_slip = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega & + * ( dst%mfp(:,of) - prm%kink_width ) & * ( & - (exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & - + tau_slip_pos(j) & - * (abs(exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)))& - *BoltzmannRatio(j)*prm%p(j)& - *prm%q(j)/& - (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1(j)*(1-StressRatio_p(j))**(prm%q(j)-1.0_pReal) ) & + (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & + + tau_slip_pos & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q))& + *BoltzmannRatio*prm%p& + *prm%q/& + (prm%solidSolutionStrength+prm%tau_Peierls)*& + StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) ) & ) & - * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & - + prm%omega(j) * prm%B(j) & - *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & + * (2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_pos & + + prm%omega * prm%B & + *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & ) & - - (tau_slip_pos(j) & - * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) ) & - * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & - + prm%omega(j) * prm%B(j) & - *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * (abs(exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)))& - *BoltzmannRatio(j)*prm%p(j)& - *prm%q(j)/& - (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1(j)*(1-StressRatio_p(j))**(prm%q(j)-1.0_pReal) )& + - (tau_slip_pos & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) ) & + * (2.0_pReal*(prm%burgers**2.0_pReal) & + + prm%omega * prm%B & + *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q))& + *BoltzmannRatio*prm%p& + *prm%q/& + (prm%solidSolutionStrength+prm%tau_Peierls)*& + StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) )& ) & ) & / ( & ( & - 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_pos(j) & - + prm%omega(j) * prm%B(j) & - *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & + 2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_pos & + + prm%omega * prm%B & + *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & )**2.0_pReal & ) - dgdot_dtauslip_pos(j) = DotGamma0(j) * dvel_slip(j) + dgdot_dtauslip_pos = DotGamma0 * dvel_slip +else where significantPositiveTau + gdot_slip_pos = 0.0_pReal + dgdot_dtauslip_pos = 0.0_pReal +end where significantPositiveTau - endif significantPositiveTau + significantNegativeTau: where(abs(tau_slip_neg)-dst%threshold_stress(:,of) > tol_math_check) + StressRatio = (abs(tau_slip_neg)-dst%threshold_stress(:,of)) & + / (prm%solidSolutionStrength+prm%tau_Peierls) + StressRatio_p = StressRatio** prm%p + StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal) - significantNegativeTau: if(abs(tau_slip_neg(j))-dst%threshold_stress(j,of) > tol_math_check) then - StressRatio(j) = (abs(tau_slip_neg(j))-dst%threshold_stress(j,of)) & - / (prm%solidSolutionStrength+prm%tau_Peierls(j)) - StressRatio_p(j) = StressRatio(j)** prm%p(j) - StressRatio_pminus1(j) = StressRatio(j)**(prm%p(j)-1.0_pReal) - - vel_slip(j) = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & - * ( dst%mfp(j,of) - prm%kink_width(j) ) & - * (tau_slip_neg(j) & - * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) ) & + vel_slip = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega & + * ( dst%mfp(:,of) - prm%kink_width ) & + * (tau_slip_neg & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) ) & / ( & - 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & - + prm%omega(j) * prm%B(j) & - *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & + 2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_neg & + + prm%omega * prm%B & + *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & ) - gdot_slip_neg(j) = DotGamma0(j) * sign(vel_slip(j),tau_slip_neg(j)) + gdot_slip_neg = DotGamma0 * sign(vel_slip,tau_slip_neg) - dvel_slip(j) = 2.0_pReal*prm%burgers(j) * prm%kink_height(j) * prm%omega(j) & - * ( dst%mfp(j,of) - prm%kink_width(j) ) & + dvel_slip = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega & + * ( dst%mfp(:,of) - prm%kink_width ) & * ( & - (exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & - + tau_slip_neg(j) & - * (abs(exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)))& - *BoltzmannRatio(j)*prm%p(j)& - *prm%q(j)/& - (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1(j)*(1-StressRatio_p(j))**(prm%q(j)-1.0_pReal) ) & + (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & + + tau_slip_neg & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q))& + *BoltzmannRatio*prm%p& + *prm%q/& + (prm%solidSolutionStrength+prm%tau_Peierls)*& + StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) ) & ) & - * (2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & - + prm%omega(j) * prm%B(j) & - *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & + * (2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_neg & + + prm%omega * prm%B & + *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & ) & - - (tau_slip_neg(j) & - * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) ) & - * (2.0_pReal*(prm%burgers(j)**2.0_pReal) & - + prm%omega(j) * prm%B(j) & - *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * (abs(exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)))& - *BoltzmannRatio(j)*prm%p(j)& - *prm%q(j)/& - (prm%solidSolutionStrength+prm%tau_Peierls(j))*& - StressRatio_pminus1(j)*(1-StressRatio_p(j))**(prm%q(j)-1.0_pReal) )& + - (tau_slip_neg & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) ) & + * (2.0_pReal*(prm%burgers**2.0_pReal) & + + prm%omega * prm%B & + *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & + * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q))& + *BoltzmannRatio*prm%p& + *prm%q/& + (prm%solidSolutionStrength+prm%tau_Peierls)*& + StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) )& ) & ) & / ( & ( & - 2.0_pReal*(prm%burgers(j)**2.0_pReal)*tau_slip_neg(j) & - + prm%omega(j) * prm%B(j) & - *(( dst%mfp(j,of) - prm%kink_width(j) )**2.0_pReal) & - * exp(-BoltzmannRatio(j)*(1-StressRatio_p(j)) ** prm%q(j)) & + 2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_neg & + + prm%omega * prm%B & + *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & + * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & )**2.0_pReal & ) - dgdot_dtauslip_neg(j) = DotGamma0(j) * dvel_slip(j) - endif significantNegativeTau - enddo + dgdot_dtauslip_neg = DotGamma0 * dvel_slip +else where significantNegativeTau + gdot_slip_neg = 0.0_pReal + dgdot_dtauslip_neg = 0.0_pReal +end where significantNegativeTau + end subroutine kinetics From aa9cacdcb087c3fcde9aa8c0aacf6ea95942c1b9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 9 Dec 2018 17:36:01 +0100 Subject: [PATCH 46/47] naming as in dislotwin+phenopowerlaw --- src/plastic_disloUCLA.f90 | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index a10121318..b58e9320b 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -150,13 +150,13 @@ subroutine plastic_disloUCLA_init() use lattice implicit none - integer(pInt) :: maxNinstance,& + integer(pInt) :: Ninstance,& f,j,k,o, i, & outputSize, & offset_slip, index_myFamily, index_otherFamily, & startIndex, endIndex, p, & sizeState, sizeDotState, & - NofMyPhase + NipcMyPhase character(len=65536) :: & structure = '' character(len=65536), dimension(:), allocatable :: outputs @@ -171,20 +171,20 @@ subroutine plastic_disloUCLA_init() write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_plasticity == PLASTICITY_DISLOUCLA_ID),pInt) - if (maxNinstance == 0_pInt) return + Ninstance = int(count(phase_plasticity == PLASTICITY_DISLOUCLA_ID),pInt) + if (Ninstance == 0_pInt) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - allocate(plastic_disloUCLA_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(plastic_disloUCLA_output(maxval(phase_Noutput),maxNinstance)) + allocate(plastic_disloUCLA_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(plastic_disloUCLA_output(maxval(phase_Noutput),Ninstance)) plastic_disloUCLA_output = '' - allocate(param(maxNinstance)) - allocate(state(maxNinstance)) - allocate(dotState(maxNinstance)) - allocate(dependentState(maxNinstance)) + allocate(param(Ninstance)) + allocate(state(Ninstance)) + allocate(dotState(Ninstance)) + allocate(dependentState(Ninstance)) do p = 1_pInt, size(phase_plasticityInstance) @@ -325,7 +325,7 @@ subroutine plastic_disloUCLA_init() enddo - NofMyPhase=count(material_phase==p) + NipcMyPhase=count(material_phase==p) !-------------------------------------------------------------------------------------------------- ! allocate state arrays @@ -333,7 +333,7 @@ subroutine plastic_disloUCLA_init() sizeDotState = int(size(['rhoEdge ','rhoEdgeDip ','accshearslip']),pInt) * prm%totalNslip sizeState = sizeDotState - call material_allocatePlasticState(p,NofMyPhase,sizeState,sizeDotState,0_pInt, & + call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,0_pInt, & prm%totalNslip,0_pInt,0_pInt) plasticState(p)%sizePostResults = sum(plastic_disloUCLA_sizePostResult(:,phase_plasticityInstance(p))) @@ -358,21 +358,21 @@ subroutine plastic_disloUCLA_init() offset_slip = 2_pInt*plasticState(p)%nSlip plasticState(p)%slipRate => & - plasticState(p)%dotState(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NofMyPhase) + plasticState(p)%dotState(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) plasticState(p)%accumulatedSlip => & - plasticState(p)%state (offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NofMyPhase) + plasticState(p)%state (offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) startIndex=1_pInt endIndex=prm%totalNslip stt%rhoEdge=>plasticState(p)%state(startIndex:endIndex,:) - stt%rhoEdge= spread(prm%rho0,2,NofMyPhase) + stt%rhoEdge= spread(prm%rho0,2,NipcMyPhase) dot%rhoEdge=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho startIndex=endIndex+1_pInt endIndex=endIndex+prm%totalNslip stt%rhoEdgeDip=>plasticState(p)%state(startIndex:endIndex,:) - stt%rhoEdgeDip= spread(prm%rhoDip0,2,NofMyPhase) + stt%rhoEdgeDip= spread(prm%rhoDip0,2,NipcMyPhase) dot%rhoEdgeDip=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho @@ -385,8 +385,8 @@ subroutine plastic_disloUCLA_init() dot%whole => plasticState(p)%dotState - allocate(dst%mfp(prm%totalNslip,NofMyPhase),source=0.0_pReal) - allocate(dst%threshold_stress(prm%totalNslip,NofMyPhase),source=0.0_pReal) + allocate(dst%mfp(prm%totalNslip,NipcMyPhase),source=0.0_pReal) + allocate(dst%threshold_stress(prm%totalNslip,NipcMyPhase),source=0.0_pReal) plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally From 6256de8785697a20435c9d99bffc29a0a33adcd3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 9 Dec 2018 17:53:20 +0100 Subject: [PATCH 47/47] re-implemented sanity checks --- src/plastic_disloUCLA.f90 | 49 ++++++++++++++++++++------------------- 1 file changed, 25 insertions(+), 24 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index b58e9320b..9006b092d 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -125,6 +125,8 @@ subroutine plastic_disloUCLA_init() compiler_version, & compiler_options #endif + use prec, only: & + pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -157,8 +159,9 @@ subroutine plastic_disloUCLA_init() startIndex, endIndex, p, & sizeState, sizeDotState, & NipcMyPhase - character(len=65536) :: & - structure = '' + character(len=pStringLen) :: & + structure = '',& + extmsg = '' character(len=65536), dimension(:), allocatable :: outputs integer(kind(undefined_ID)) :: outputID integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] @@ -218,11 +221,12 @@ subroutine plastic_disloUCLA_init() config_phase(p)%getFloats('interaction_slipslip'), & structure(1:3)) prm%rho0 = config_phase(p)%getFloats('rhoedge0', requiredShape=shape(prm%Nslip)) - prm%rhoDip0 = config_phase(p)%getFloats('rhoedgedip0', requiredShape=shape(prm%Nslip)) - prm%burgers = config_phase(p)%getFloats('slipburgers', requiredShape=shape(prm%Nslip)) - prm%H0kp = config_phase(p)%getFloats('qedge', requiredShape=shape(prm%Nslip)) - prm%v0 = config_phase(p)%getFloats('v0', requiredShape=shape(prm%Nslip)) - prm%clambda = config_phase(p)%getFloats('clambdaslip', requiredShape=shape(prm%Nslip)) + prm%rhoDip0 = config_phase(p)%getFloats('rhoedgedip0', requiredShape=shape(prm%Nslip)) + prm%v0 = config_phase(p)%getFloats('v0', requiredShape=shape(prm%Nslip)) + prm%burgers = config_phase(p)%getFloats('slipburgers', requiredShape=shape(prm%Nslip)) + prm%H0kp = config_phase(p)%getFloats('qedge', requiredShape=shape(prm%Nslip)) + + prm%clambda = config_phase(p)%getFloats('clambdaslip', requiredShape=shape(prm%Nslip)) prm%tau_Peierls = config_phase(p)%getFloats('tau_peierls', requiredShape=shape(prm%Nslip)) prm%p = config_phase(p)%getFloats('p_slip', requiredShape=shape(prm%Nslip), & defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) @@ -258,25 +262,22 @@ subroutine plastic_disloUCLA_init() prm%atomicVolume = math_expand(prm%atomicVolume, prm%Nslip) prm%minDipDistance = math_expand(prm%minDipDistance, prm%Nslip) - !if (plastic_disloUCLA_CAtomicVolume(instance) <= 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOUCLA_label//')') - ! if (prm%D0 <= 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='D0 ('//PLASTICITY_DISLOUCLA_label//')') - ! if (plastic_disloUCLA_Qsd(instance) <= 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='Qsd ('//PLASTICITY_DISLOUCLA_label//')') + ! sanity checks + if (any(prm%rho0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoedge0' + if (any(prm%rhoDip0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoedgedip0' + if (any(prm%v0 < 0.0_pReal)) extmsg = trim(extmsg)//' v0' + if (any(prm%burgers <= 0.0_pReal)) extmsg = trim(extmsg)//' slipburgers' + if (any(prm%H0kp <= 0.0_pReal)) extmsg = trim(extmsg)//' qedge' + if (any(prm%tau_peierls < 0.0_pReal)) extmsg = trim(extmsg)//' tau_peierls' + + if ( prm%D0 <= 0.0_pReal) extmsg = trim(extmsg)//' d0' + if ( prm%Qsd <= 0.0_pReal) extmsg = trim(extmsg)//' qsd' + + !if (plastic_disloUCLA_CAtomicVolume(instance) <= 0.0_pReal) & + ! call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOUCLA_label//')') + ! if (plastic_disloUCLA_aTolRho(instance) <= 0.0_pReal) & ! call IO_error(211_pInt,el=instance,ext_msg='aTolRho ('//PLASTICITY_DISLOUCLA_label//')') - !if (plastic_disloUCLA_rhoEdge0(f,instance) < 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='rhoEdge0 ('//PLASTICITY_DISLOUCLA_label//')') - !if (plastic_disloUCLA_rhoEdgeDip0(f,instance) < 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='rhoEdgeDip0 ('//PLASTICITY_DISLOUCLA_label//')') - !if (plastic_disloUCLA_burgersPerSlipFamily(f,instance) <= 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='slipBurgers ('//PLASTICITY_DISLOUCLA_label//')') - !if (plastic_disloUCLA_v0PerSlipFamily(f,instance) <= 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='v0 ('//PLASTICITY_DISLOUCLA_label//')') - !if (plastic_disloUCLA_tau_peierlsPerSlipFamily(f,instance) < 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='tau_peierls ('//PLASTICITY_DISLOUCLA_label//')') - else slipActive allocate(prm%rho0(0))